[GHC] #12958: Properly detect if GHCi is running in MinTTY

[GHC]

#12958: Properly detect if GHCi is running in MinTTY
-------------------------------------+-------------------------------------
           Reporter:  RyanGlScott    |             Owner:
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.2.1
          Component:  GHCi           |           Version:  8.0.1
           Keywords:                 |  Operating System:  Windows
       Architecture:                 |   Type of failure:  Poor/confusing
  Unknown/Multiple                   |  error message
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 Since the user experience of GHCi is known to be rather poor when run in
 MinTTY (e.g., see #12720), GHCi emits a warning when it thinks it's being
 run in a terminal that uses MinTTY (such as Cygwin or MSYS2).
 [http://git.haskell.org/ghc.git/blob/17ac9b19438d5e8f6de33f99828e8c0e7c8c1129:/driver/ghci/ghci.c#l18
 Here] is the code that checks for this in `ghci.c`:

 {{{#!c
 if (getenv("_")) {
     printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells
 (cygwin-bash, in particular)\n");
     printf("         doesn't handle Ctrl-C well; use the 'ghcii.sh' shell
 wrapper instead\n");
     fflush(stdout);
 }
 }}}

 This is a rather shoddy way to detect MinTTY's presence, however. It's
 quite easy to define an environmental variable named `_` in terminals that
 don't use MinTTY (e.g., ConEmu).

 After seeing Phab:D2809, I learned of a much more reliable way to detect
 for MinTTY's presence:

 {{{#!hs
 queryCygwinTerminal :: Win32.HANDLE -> IO Bool
 queryCygwinTerminal h = do
     fileType <- Win32.getFileType h
     if fileType /= Win32.fILE_TYPE_PIPE
       then pure False
       else do
         fn <- getFileNameByHandle h
         pure (("\\cygwin-" `isPrefixOf` fn || "\\msys-" `isPrefixOf` fn)
 &&
               "-pty" `isInfixOf` fn &&
               "-master" `isSuffixOf` fn)
   `catch` \ (_ :: IOError) ->
     pure False

 getFileNameByHandle :: Win32.HANDLE -> IO String
 getFileNameByHandle h = do
   let sizeOfDWORD = sizeOf (undefined :: Win32.DWORD)
   let sizeOfWchar = sizeOf (undefined :: CWchar)
   -- note: implicitly assuming that DWORD has stronger alignment than
 wchar_t
   let bufSize = sizeOfDWORD + mAX_PATH * sizeOfWchar
   allocaBytes bufSize $ \ buf -> do
     getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize)
     len :: Win32.DWORD <- peek buf
     let len' = fromIntegral len `div` sizeOfWchar
     peekCWStringLen (buf `plusPtr` sizeOfDWORD, min len' mAX_PATH)

 getFileInformationByHandleEx
   :: Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO ()
 getFileInformationByHandleEx h cls buf bufSize = do
   lib <- Win32.getModuleHandle (Just "kernel32.dll")
   ptr <- Win32.getProcAddress lib "GetFileInformationByHandleEx"
   let c_GetFileInformationByHandleEx =
         mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr)
   Win32.failIfFalse_ "getFileInformationByHandleEx"
     (c_GetFileInformationByHandleEx h cls buf bufSize)

 type F_GetFileInformationByHandleEx a =
   Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO Win32.BOOL

 foreign import WINAPI "dynamic"
   mk_GetFileInformationByHandleEx
   :: FunPtr (F_GetFileInformationByHandleEx a)
   -> F_GetFileInformationByHandleEx a
 }}}

 We should port this to C and use this in `ghci.c` instead of what we have
 now.

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12958>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler