Windows: use hIsTerminalDevice or isMinTTYHandle

mpilgrem · mpilgrem · commit aab89cd0a065 · 2018-05-19T00:58:04.000+01:00
'mintty' is a terminal emulator for 'Cygwin', 'MSYS' or 'MSYS2', and dervied projects, and for 'WSL' (Windows Subsystem for Linux). `hIsTerminalDevice` does not recognise handles to 'mintty' terminals, but `isMinTTYHandle` does. Currently, `stack` relies on `hIsTerminalDevice` in three places to detect handles to terminals and does not use `isMinTTYHandle`.

`isMinTTYHandle` was first added to package `Win32-2.5.0.0` and then made robust to an upstream (ntdll-related) bug from `Win32-2.5.3.0`. The latter constraint is added to `package.yaml`.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -11,6 +11,8 @@ Behavior changes:
 
 Other enhancements:
 
+* On Windows, recognise a 'mintty' (false) terminal as a terminal, by default
+
 Bug fixes:
 
 * `~/.stack/config.yaml` and `stack.yaml` terminating by newline
diff --git a/package.yaml b/package.yaml
@@ -121,7 +121,7 @@ when:
   then:
     cpp-options: -DWINDOWS
     dependencies:
-    - Win32
+    - Win32 >= 2.5.3.0
   else:
     build-tools:
     - hsc2hs
diff --git a/src/Stack/Docker.hs b/src/Stack/Docker.hs
@@ -243,8 +243,8 @@ runContainerAndExit getCmdArgs
      (env,isStdinTerminal,isStderrTerminal,homeDir) <- liftIO $
        (,,,)
        <$> getEnvironment
-       <*> hIsTerminalDevice stdin
-       <*> hIsTerminalDevice stderr
+       <*> hIsTerminalDeviceOrMinTTY stdin
+       <*> hIsTerminalDeviceOrMinTTY stderr
        <*> (parseAbsDir =<< getHomeDirectory)
      isStdoutTerminal <- view terminalL
      let dockerHost = lookup "DOCKER_HOST" env
diff --git a/src/Stack/FileWatch.hs b/src/Stack/FileWatch.hs
@@ -35,7 +35,7 @@ fileWatchConf :: WatchConfig
               -> IO ()
 fileWatchConf cfg out inner = withManagerConf cfg $ \manager -> do
     let putLn = hPutStrLn out
-    outputIsTerminal <- hIsTerminalDevice out
+    outputIsTerminal <- hIsTerminalDeviceOrMinTTY out
     let withColor color str = putLn $ do
             if outputIsTerminal
             then concat [color, str, reset]
diff --git a/src/Stack/Prelude.hs b/src/Stack/Prelude.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE NoImplicitPrelude          #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
@@ -13,6 +14,7 @@ module Stack.Prelude
   , readProcessNull
   , withProcessContext
   , stripCR
+  , hIsTerminalDeviceOrMinTTY
   , module X
   ) where
 
@@ -30,6 +32,10 @@ import qualified System.Directory as Dir
 import qualified System.FilePath as FP
 import           System.IO.Error (isDoesNotExistError)
 
+#ifdef WINDOWS
+import           System.Win32 (isMinTTYHandle, withHandleToHANDLE)
+#endif
+
 import           Data.Conduit.Binary (sourceHandle, sinkHandle)
 import qualified Data.Conduit.Binary as CB
 import qualified Data.Conduit.List as CL
@@ -151,3 +157,16 @@ withProcessContext pcNew inner = do
 -- | Remove a trailing carriage return if present
 stripCR :: Text -> Text
 stripCR = T.dropSuffix "\r"
+
+-- | hIsTerminaDevice does not recognise handles to mintty terminals as terminal
+-- devices, but isMinTTYHandle does.
+hIsTerminalDeviceOrMinTTY :: MonadIO m => Handle -> m Bool
+#ifdef WINDOWS
+hIsTerminalDeviceOrMinTTY h = do
+  isTD <- hIsTerminalDevice h
+  if isTD
+    then return True
+    else liftIO $ withHandleToHANDLE h isMinTTYHandle
+#else
+hIsTerminalDeviceOrMinTTY = hIsTerminalDevice
+#endif
diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -167,7 +167,7 @@ main = do
   hSetTranslit stderr
   args <- getArgs
   progName <- getProgName
-  isTerminal <- hIsTerminalDevice stdout
+  isTerminal <- hIsTerminalDeviceOrMinTTY stdout
   execExtraHelp args
                 Docker.dockerHelpOptName
                 (dockerOptsParser False)
