Merge pull request #739 from commercialhaskell/738-windows-code-page

Set code page to UTF-8 (65001) on Windows #738

Author: borsboom

src/Stack/Build/Execute.hs

@@ -602,7 +602,13 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} msuffix inne
                 cp = cp0
                     { cwd = Just $ toFilePath pkgDir
                     , Process.env = envHelper menv
-                    , std_in = CreatePipe
+                    -- Ideally we'd create a new pipe here and then close it
+                    -- below to avoid the child process from taking from our
+                    -- stdin. However, if we do this, the child process won't
+                    -- be able to get the codepage on Windows that we want.
+                    -- See:
+                    -- https://github.com/commercialhaskell/stack/issues/738
+                    -- , std_in = CreatePipe
                     , std_out =
                         case mlogFile of
                                 Nothing -> CreatePipe
@@ -615,8 +621,7 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} msuffix inne
             $logProcessRun (toFilePath exeName) fullArgs
 
             -- Use createProcess_ to avoid the log file being closed afterwards
-            (Just inH, moutH, merrH, ph) <- liftIO $ createProcess_ "singleBuild" cp
-            liftIO $ hClose inH
+            (Nothing, moutH, merrH, ph) <- liftIO $ createProcess_ "singleBuild" cp
 
             let makeAbsolute = stripTHLoading -- If users want control, we should add a config option for this
 

src/main/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -73,10 +74,61 @@ import           System.FilePath (dropTrailingPathSeparator)
 import           System.IO (hIsTerminalDevice, stderr, stdin, stdout, hSetBuffering, BufferMode(..))
 import           System.Process.Read
 
+#if WINDOWS
+import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP)
+import System.IO (hSetEncoding, utf8, hPutStrLn)
+#endif
+
+-- | Set the code page for this process as necessary. Only applies to Windows.
+-- See: https://github.com/commercialhaskell/stack/issues/738
+fixCodePage :: IO a -> IO a
+#if WINDOWS
+fixCodePage inner = do
+    origCPI <- getConsoleCP
+    origCPO <- getConsoleOutputCP
+
+    let setInput = origCPI /= expected
+        setOutput = origCPO /= expected
+        fixInput
+            | setInput = bracket_
+                (do
+                    setConsoleCP expected
+                    hSetEncoding stdin utf8
+                    )
+                (setConsoleCP origCPI)
+            | otherwise = id
+        fixOutput
+            | setInput = bracket_
+                (do
+                    setConsoleOutputCP expected
+                    hSetEncoding stdout utf8
+                    hSetEncoding stderr utf8
+                    )
+                (setConsoleOutputCP origCPO)
+            | otherwise = id
+
+    case (setInput, setOutput) of
+        (False, False) -> return ()
+        (True, True) -> warn ""
+        (True, False) -> warn " input"
+        (False, True) -> warn " output"
+
+    fixInput $ fixOutput inner
+  where
+    expected = 65001 -- UTF-8
+    warn typ = hPutStrLn stderr $ concat
+        [ "Setting"
+        , typ
+        , " codepage to UTF-8 (65001) to ensure correct output from GHC"
+        ]
+#else
+fixCodePage = id
+#endif
+
 -- | Commandline dispatcher.
 main :: IO ()
-main = withInterpreterArgs stackProgName $ \args isInterpreter ->
-  do -- Line buffer the output by default, particularly for non-terminal runs.
+main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $ do
+     -- Line buffer the output by default, particularly for non-terminal runs.
      -- See https://github.com/commercialhaskell/stack/pull/360
      hSetBuffering stdout LineBuffering
      hSetBuffering stdin  LineBuffering

stack.cabal

@@ -208,6 +208,9 @@ executable stack
                 , transformers
                 , http-client
   default-language:    Haskell2010
+  if os(windows)
+    build-depends:   Win32
+    cpp-options:     -DWINDOWS
 
 test-suite stack-test
   type:           exitcode-stdio-1.0