Fix encoding issues: use with-utf8 library and other tricks

app/Spago.hs

@@ -4,11 +4,11 @@ import           Spago.Prelude
 
 import qualified Data.Text           as Text
 import           Data.Version        (showVersion)
-import qualified GHC.IO.Encoding
 import qualified Options.Applicative as Opts
 import qualified Paths_spago         as Pcli
 import qualified System.Environment  as Env
 import qualified Turtle              as CLI
+import           Main.Utf8           (withUtf8)
 
 import           Spago.Build         (BuildOptions (..), DepsOnly (..), ExtraArg (..),
                                       ModuleName (..), NoBuild (..), NoInstall (..), NoSearch (..),
@@ -416,9 +416,7 @@ runWithEnv GlobalOptions{..} app = do
     runRIO env app
 
 main :: IO ()
-main = do
-  -- We always want to run in UTF8 anyways
-  GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
+main = withUtf8 $ do
   -- Stop `git` from asking for input, not gonna happen
   -- We just fail instead. Source:
   -- https://serverfault.com/questions/544156

appveyor.yml

@@ -16,6 +16,10 @@ environment:
   matrix:
     - STACK_YAML: stack.yaml
 
+cache:
+  - '%STACK_ROOT% -> %STACK_YAML%, appveyor.yml'
+  - '.stack-work -> %STACK_YAML%, appveyor.yml'
+
 install:
   # http://help.appveyor.com/discussions/problems/6312-curl-command-not-found
   - set PATH=C:\Program Files\Git\mingw64\bin;%PATH%
@@ -31,23 +35,26 @@ install:
   - tar -xvf purescript.tar.gz
   - chmod a+x purescript
 
-cache:
-  - '%STACK_ROOT% -> %STACK_YAML%, appveyor.yml'
-  - '.stack-work -> %STACK_YAML%, appveyor.yml'
-
 build_script:
   - stack build
   - stack install --local-bin-path bin
   - cp bin\spago.exe spago.exe
   - tar -zcvf windows.tar.gz spago.exe
 
 test_script:
-  - set PATH=C:\projects\spago\bin;C:\projects\spago\purescript;%PATH%
-  - set XDG_CACHE_HOME=C:\cache
-  - stack test
+  # We run the Windows CI with Japanese encoding,
+  # so we can figure out any encoding problems
+  # https://en.wikipedia.org/wiki/Code_page_932_(Microsoft_Windows)
+  - ps: Set-WinSystemLocale ja-JP
+  - ps: Start-Sleep -s 5
+  - ps: Restart-Computer
+  - ps: Start-Sleep -s 5
+  - cmd: set PATH=C:\projects\spago\bin;C:\projects\spago\purescript;%PATH%
+  - cmd: set XDG_CACHE_HOME=C:\cache
+  - cmd: stack test
   # We install psa and rerun the tests that exercise it
-  - npm install -g purescript-psa
-  - stack test --ta "--match \"/Spago/spago run\""
+  - cmd: npm install -g purescript-psa
+  - cmd: stack test --ta "--match \"/Spago/spago run\""
 
 artifacts:
   - path: windows.tar.gz

package.yaml

@@ -92,6 +92,7 @@ library:
   - unordered-containers
   - vector
   - versions
+  - with-utf8
   - zlib
 
 executables:
@@ -123,6 +124,7 @@ executables:
     - spago
     - text < 1.3
     - turtle
+    - with-utf8
 
 tests:
   spec:

src/Spago/Build.hs

@@ -36,6 +36,7 @@ import           System.FilePath      (splitDirectories)
 import qualified System.FilePath.Glob as Glob
 import qualified System.IO            as Sys
 import qualified System.IO.Temp       as Temp
+import qualified System.IO.Utf8       as Utf8
 import qualified Turtle
 import qualified System.Process       as Process
 import qualified Web.Browser          as Browser
@@ -299,7 +300,7 @@ bundleModule maybeModuleName maybeTargetPath noBuild buildOpts = do
         -- Here we append the CommonJS export line at the end of the bundle
         try (with
               (appendonly $ pathFromText $ Purs.unTargetPath targetPath)
-              (flip hPutStrLn jsExport))
+              (\fileHandle -> Utf8.withHandle fileHandle (Sys.hPutStrLn fileHandle jsExport)))
           >>= \case
             Right _ -> logInfo $ display $ "Make module succeeded and output file to " <> Purs.unTargetPath targetPath
             Left (n :: SomeException) -> die [ "Make module failed: " <> repr n ]

src/Spago/Prelude.hs

@@ -42,7 +42,6 @@ module Spago.Prelude
   , lastMay
   , shouldRefreshFile
   , makeAbsolute
-  , hPutStrLn
   , empty
   , callCommand
   , shell
@@ -70,6 +69,7 @@ module Spago.Prelude
 
 
 import qualified Control.Concurrent.Async.Pool         as Async
+import           Control.Monad.Catch                   (MonadMask)
 import qualified Data.Text                             as Text
 import qualified Data.Text.Prettyprint.Doc             as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Text as PrettyText
@@ -94,13 +94,13 @@ import           Data.List.NonEmpty                    (NonEmpty (..))
 import           Data.Maybe                            as X
 import           Data.Sequence                         (Seq (..))
 import           Data.Text.Prettyprint.Doc             (Pretty)
+import           Data.Text.IO.Utf8                     (readFile, writeFile)
 import           Dhall.Optics                          (transformMOf)
 import           Lens.Family                           ((^..))
 import           RIO                                   as X hiding (FilePath, first, force, second)
 import           RIO.Orphans                           as X
 import           Safe                                  (headMay, lastMay)
 import           System.FilePath                       (isAbsolute, pathSeparator, (</>))
-import           System.IO                             (hPutStrLn)
 import           Turtle                                (ExitCode (..), FilePath, appendonly, chmod,
                                                         executable, mktree, repr, shell,
                                                         shellStrict, shellStrictWithErr,
@@ -143,11 +143,11 @@ testfile :: MonadIO m => Text -> m Bool
 testfile = Turtle.testfile . pathFromText
 
 readTextFile :: MonadIO m => Turtle.FilePath -> m Text
-readTextFile = liftIO . Turtle.readTextFile
+readTextFile = readFile . Turtle.encodeString
 
 
-writeTextFile :: MonadIO m => Text -> Text -> m ()
-writeTextFile path text = liftIO $ Turtle.writeTextFile (Turtle.fromText path) text
+writeTextFile :: (MonadIO m, MonadMask m) => Text -> Text -> m ()
+writeTextFile path text = writeFile (Text.unpack path) text
 
 
 with :: MonadIO m => Turtle.Managed a -> (a -> IO r) -> m r

src/Spago/Purs.hs

@@ -17,11 +17,13 @@ module Spago.Purs
 import           Spago.Prelude
 
 import qualified Data.Text      as Text
+import qualified Data.Text.Encoding as Text.Encoding
+import Data.Text.Encoding.Error (lenientDecode)
 import qualified Data.Versions  as Version
 import qualified Spago.Dhall    as Dhall
 
 import qualified Spago.Messages as Messages
-
+import qualified Turtle.Bytes
 
 newtype ModuleName = ModuleName { unModuleName :: Text }
 newtype TargetPath = TargetPath { unTargetPath :: Text }
@@ -125,13 +127,13 @@ version    = versionImpl "purs"
 psaVersion = versionImpl "psa"
 
 versionImpl :: Text -> Spago (Either Text Version.SemVer)
-versionImpl purs = shellStrictWithErr (purs <> " --version") empty >>= \case
+versionImpl purs = Turtle.Bytes.shellStrictWithErr (purs <> " --version") empty >>= \case
   (ExitSuccess, out, _err) -> do
-    let versionText = headMay $ Text.split (== ' ') out
+    let versionText = headMay $ Text.split (== ' ') (Text.Encoding.decodeUtf8With lenientDecode out)
         parsed = versionText >>= (hush . Version.semver)
 
     pure $ case parsed of
-      Nothing -> Left $ Messages.failedToParseCommandOutput (purs <> " --version") out
+      Nothing -> Left $ Messages.failedToParseCommandOutput (purs <> " --version") (Text.Encoding.decodeUtf8With lenientDecode out)
       Just p -> Right p
   (_, _out, _err) -> pure $ Left $ "Failed to run '" <> purs <> " --version'"
 

src/Spago/Watch.hs

@@ -1,25 +1,26 @@
 {-# LANGUAGE TupleSections #-}
 module Spago.Watch (watch, globToParent, ClearScreen (..)) where
 
--- This code basically comes straight from
+-- This code is derived from:
 -- https://github.com/commercialhaskell/stack/blob/0740444175f41e6ea5ed236cd2c53681e4730003/src/Stack/FileWatch.hs
 
 import           Spago.Prelude          hiding (FilePath)
 
 import           Control.Concurrent.STM (check)
 import qualified Data.Map.Strict        as Map
 import qualified Data.Set               as Set
-import           Data.Text              (pack, toLower, unpack)
+import qualified Data.Text              as Text
+import qualified Data.Text.IO           as Text.IO
 import           Data.Time.Clock        (NominalDiffTime, diffUTCTime, getCurrentTime)
 import           GHC.IO                 (FilePath)
 import           GHC.IO.Exception
 import           System.Console.ANSI    (clearScreen, setCursorPosition)
 import           System.FilePath        (splitDirectories)
 import qualified System.FilePath.Glob   as Glob
 import qualified System.FSNotify        as Watch
-import           System.IO              (getLine)
+import qualified System.IO.Utf8         as Utf8
 import qualified UnliftIO
-import           UnliftIO.Async         (race_)
+import qualified UnliftIO.Async         as Async
 
 -- Should we clear the screen on rebuild?
 data ClearScreen = DoClear | NoClear
@@ -135,8 +136,7 @@ fileWatchConf watchConfig shouldClear inner = withManagerConf watchConfig $ \man
 
     let watchInput :: Spago ()
         watchInput = do
-          -- env <- ask
-          line <- liftIO $ unpack . toLower . pack <$> getLine
+          line <- Utf8.withHandle stdin (liftIO $ Text.toLower <$> Text.IO.hGetLine stdin)
           if line == "quit" then logInfo "Leaving watch mode."
           else do
             case line of
@@ -163,7 +163,7 @@ fileWatchConf watchConfig shouldClear inner = withManagerConf watchConfig $ \man
                      ]
             watchInput
 
-    race_ watchInput $ forever $ do
+    Async.race_ watchInput $ forever $ do
       liftIO $ atomically $ do
         dirty <- readTVar dirtyVar
         check dirty

stack.yaml

@@ -6,6 +6,7 @@ extra-deps:
 - atomic-write-0.2.0.7
 - prettyprinter-1.5.1
 - github-0.24
+- with-utf8-1.0.0.0
 - async-pool-0.9.0.2@sha256:3aca5861a7b839d02a3f5c52ad6d1ce368631003f68c3d9cb6d711c29e9618db,1599
 - binary-instances-1@sha256:cdef50410f2797de38f021d328d38c32b2f4abeaab86bfaf78e0657150863090,2613
 - directory-1.3.4.0@sha256:500019f04494324d1df16cf83eefeb3f809b2b20b32a32ccd755ee0439c18bfd,2829

stack.yaml.lock

@@ -32,6 +32,13 @@ packages:
       sha256: e0f84d7a3cdd76c6bd5395c8c72d24a1dda9616f857291820b08947c8290f042
   original:
     hackage: github-0.24
+- completed:
+    hackage: with-utf8-1.0.0.0@sha256:686e47588986d8080451b4e617118b579487dd4e085bba7bb36fac4198c90ae6,2480
+    pantry-tree:
+      size: 905
+      sha256: 39176872f0dde9f9e09c9cb9496e2b7b10fa17cb9a6eca8d40ca4b2dcaaacc11
+  original:
+    hackage: with-utf8-1.0.0.0
 - completed:
     hackage: async-pool-0.9.0.2@sha256:3aca5861a7b839d02a3f5c52ad6d1ce368631003f68c3d9cb6d711c29e9618db,1599
     pantry-tree: