|
| 1 | +{-# LANGUAGE CPP #-} |
1 | 2 | {-# LANGUAGE OverloadedStrings #-}
|
2 | 3 | {-# LANGUAGE ScopedTypeVariables #-}
|
3 | 4 | {-# LANGUAGE FlexibleContexts #-}
|
@@ -73,10 +74,61 @@ import System.FilePath (dropTrailingPathSeparator)
|
73 | 74 | import System.IO (hIsTerminalDevice, stderr, stdin, stdout, hSetBuffering, BufferMode(..))
|
74 | 75 | import System.Process.Read
|
75 | 76 |
|
| 77 | +#if WINDOWS |
| 78 | +import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) |
| 79 | +import System.IO (hSetEncoding, utf8, hPutStrLn) |
| 80 | +#endif |
| 81 | + |
| 82 | +-- | Set the code page for this process as necessary. Only applies to Windows. |
| 83 | +-- See: https://github.com/commercialhaskell/stack/issues/738 |
| 84 | +fixCodePage :: IO a -> IO a |
| 85 | +#if WINDOWS |
| 86 | +fixCodePage inner = do |
| 87 | + origCPI <- getConsoleCP |
| 88 | + origCPO <- getConsoleOutputCP |
| 89 | + |
| 90 | + let setInput = origCPI /= expected |
| 91 | + setOutput = origCPO /= expected |
| 92 | + fixInput |
| 93 | + | setInput = bracket_ |
| 94 | + (do |
| 95 | + setConsoleCP expected |
| 96 | + hSetEncoding stdin utf8 |
| 97 | + ) |
| 98 | + (setConsoleCP origCPI) |
| 99 | + | otherwise = id |
| 100 | + fixOutput |
| 101 | + | setInput = bracket_ |
| 102 | + (do |
| 103 | + setConsoleOutputCP expected |
| 104 | + hSetEncoding stdout utf8 |
| 105 | + hSetEncoding stderr utf8 |
| 106 | + ) |
| 107 | + (setConsoleOutputCP origCPO) |
| 108 | + | otherwise = id |
| 109 | + |
| 110 | + case (setInput, setOutput) of |
| 111 | + (False, False) -> return () |
| 112 | + (True, True) -> warn "" |
| 113 | + (True, False) -> warn " input" |
| 114 | + (False, True) -> warn " output" |
| 115 | + |
| 116 | + fixInput $ fixOutput inner |
| 117 | + where |
| 118 | + expected = 65001 -- UTF-8 |
| 119 | + warn typ = hPutStrLn stderr $ concat |
| 120 | + [ "Setting" |
| 121 | + , typ |
| 122 | + , " codepage to UTF-8 (65001) to ensure correct output from GHC" |
| 123 | + ] |
| 124 | +#else |
| 125 | +fixCodePage = id |
| 126 | +#endif |
| 127 | + |
76 | 128 | -- | Commandline dispatcher.
|
77 | 129 | main :: IO ()
|
78 |
| -main = withInterpreterArgs stackProgName $ \args isInterpreter -> |
79 |
| - do -- Line buffer the output by default, particularly for non-terminal runs. |
| 130 | +main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $ do |
| 131 | + -- Line buffer the output by default, particularly for non-terminal runs. |
80 | 132 | -- See https://github.com/commercialhaskell/stack/pull/360
|
81 | 133 | hSetBuffering stdout LineBuffering
|
82 | 134 | hSetBuffering stdin LineBuffering
|
|
0 commit comments