diff --git a/app/Spago.hs b/app/Spago.hs index 4cf184673..62ab29d52 100644 --- a/app/Spago.hs +++ b/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 diff --git a/appveyor.yml b/appveyor.yml index 1efc4d463..58279b82e 100644 --- a/appveyor.yml +++ b/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,10 +35,6 @@ 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 @@ -42,12 +42,19 @@ build_script: - 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 diff --git a/package.yaml b/package.yaml index e2d97bd57..a2ba26df9 100644 --- a/package.yaml +++ b/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: diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index dc6047bf3..47e23e9d1 100644 --- a/src/Spago/Build.hs +++ b/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 ] diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs index f4950830b..935637a8f 100644 --- a/src/Spago/Prelude.hs +++ b/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 diff --git a/src/Spago/Purs.hs b/src/Spago/Purs.hs index 17902eb27..cb71c1ef2 100644 --- a/src/Spago/Purs.hs +++ b/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'" diff --git a/src/Spago/Watch.hs b/src/Spago/Watch.hs index 0c535cf18..7d9c3c783 100644 --- a/src/Spago/Watch.hs +++ b/src/Spago/Watch.hs @@ -1,7 +1,7 @@ {-# 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) @@ -9,7 +9,8 @@ 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 @@ -17,9 +18,9 @@ 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 diff --git a/stack.yaml b/stack.yaml index 4ce331d50..13f33007d 100644 --- a/stack.yaml +++ b/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 diff --git a/stack.yaml.lock b/stack.yaml.lock index ec2d30757..106f7ddd0 100644 --- a/stack.yaml.lock +++ b/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: