diff --git a/Language/Haskell/GhcMod/FileMapping.hs b/Language/Haskell/GhcMod/FileMapping.hs index 1806017..a3f2f97 100644 --- a/Language/Haskell/GhcMod/FileMapping.hs +++ b/Language/Haskell/GhcMod/FileMapping.hs @@ -46,8 +46,10 @@ loadMappedFileSource :: IOish m -> GhcModT m () loadMappedFileSource from src = do tmpdir <- cradleTempDir `fmap` cradle + enc <- liftIO . mkTextEncoding . optEncoding =<< options to <- liftIO $ do (fn, h) <- openTempFile tmpdir (takeFileName from) + hSetEncoding h enc hPutStr h src hClose h return fn diff --git a/Language/Haskell/GhcMod/Options/Options.hs b/Language/Haskell/GhcMod/Options/Options.hs index 82bbda8..72cbe69 100644 --- a/Language/Haskell/GhcMod/Options/Options.hs +++ b/Language/Haskell/GhcMod/Options/Options.hs @@ -175,6 +175,11 @@ globalArgSpec = Options <=> metavar "OPT" <=> help "Option to be passed to GHC" <*> many fileMappingSpec + <*> strOption + $$ long "encoding" + <=> value "UTF-8" + <=> showDefault + <=> help "I/O encoding" where fileMappingSpec = getFileMapping . splitOn '=' <$> strOption diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 779c5c9..42dac13 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -105,6 +105,7 @@ data Options = Options { -- | GHC command line options set on the @ghc-mod@ command line , optGhcUserOptions :: [GHCOption] , optFileMappings :: [(FilePath, Maybe FilePath)] + , optEncoding :: String } deriving (Show) -- | A default 'Options'. @@ -124,6 +125,7 @@ defaultOptions = Options { } , optGhcUserOptions = [] , optFileMappings = [] + , optEncoding = "UTF-8" } ---------------------------------------------------------------- diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 23e40d4..4a71f61 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -34,9 +34,12 @@ handler = flip gcatches ] main :: IO () -main = do - hSetEncoding stdout utf8 - parseArgs >>= \res@(globalOptions, _) -> +main = + parseArgs >>= \res@(globalOptions, _) -> do + enc <- mkTextEncoding $ optEncoding globalOptions + hSetEncoding stdout enc + hSetEncoding stderr enc + hSetEncoding stdin enc catches (progMain res) [ Handler $ \(e :: GhcModError) -> runGmOutT globalOptions $ exitError $ renderStyle ghcModStyle (gmeDoc e) @@ -107,7 +110,6 @@ getFileSourceFromStdin = do then fmap (x:) readStdin' else return [] --- Someone please already rewrite the cmdline parsing code *weep* :'( wrapGhcCommands :: (IOish m, GmOut m) => Options -> GhcModCommands -> m () wrapGhcCommands _opts CmdRoot = gmPutStr =<< rootInfo wrapGhcCommands opts cmd = diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index 943465a..d6ba1bb 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -123,13 +123,13 @@ spec = do res <- runD $ do loadMappedFile "File.hs" "File_Redir_Lint.hs" lint defaultLintOpts "File.hs" - res `shouldBe` "File.hs:4:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + res `shouldBe` "File.hs:4:1: Warning: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" it "lints in-memory file if one is specified and outputs original filename" $ do withDirectory_ "test/data/file-mapping" $ do res <- runD $ do loadMappedFileSource "File.hs" "func a b = (++) a b\n" lint defaultLintOpts "File.hs" - res `shouldBe` "File.hs:1:1: Error: Eta reduce\NULFound:\NUL func a b = (++) a b\NULWhy not:\NUL func = (++)\n" + res `shouldBe` "File.hs:1:1: Warning: Eta reduce\NULFound:\NUL func a b = (++) a b\NULWhy not:\NUL func = (++)\n" it "shows types of the expression for redirected files" $ do let tdir = "test/data/file-mapping" res <- runD' tdir $ do @@ -184,14 +184,14 @@ spec = do res <- runD $ do loadMappedFile "File.hs" "File_Redir_Lint.hs" lint defaultLintOpts "File.hs" - res `shouldBe` "File.hs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + res `shouldBe` "File.hs:6:1: Warning: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" it "lints in-memory file if one is specified and outputs original filename" $ do withDirectory_ "test/data/file-mapping/preprocessor" $ do src <- readFile "File_Redir_Lint.hs" res <- runD $ do loadMappedFileSource "File.hs" src lint defaultLintOpts "File.hs" - res `shouldBe` "File.hs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + res `shouldBe` "File.hs:6:1: Warning: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" describe "literate haskell tests" $ do it "checks redirected file if one is specified and outputs original filename" $ do withDirectory_ "test/data/file-mapping/lhs" $ do diff --git a/test/LintSpec.hs b/test/LintSpec.hs index 00876dd..db668ae 100644 --- a/test/LintSpec.hs +++ b/test/LintSpec.hs @@ -9,7 +9,7 @@ spec = do describe "lint" $ do it "can detect a redundant import" $ do res <- runD $ lint defaultLintOpts "test/data/hlint/hlint.hs" - res `shouldBe` "test/data/hlint/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n" + res `shouldBe` "test/data/hlint/hlint.hs:4:8: Warning: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n" context "when no suggestions are given" $ do it "doesn't output an empty line" $ do