From 8105f14f2cd08f146f4e978ae05226199ec473a9 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 9 Feb 2016 12:37:56 +0300 Subject: [PATCH 1/4] Add option for stdio encoding, set stdin encoding --- Language/Haskell/GhcMod/Types.hs | 2 ++ src/GHCMod.hs | 10 ++++++---- src/GHCMod/Options.hs | 6 ++++++ 3 files changed, 14 insertions(+), 4 deletions(-) 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 fdade72..531f7de 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/src/GHCMod/Options.hs b/src/GHCMod/Options.hs index 0a2a73e..40c8fdd 100644 --- a/src/GHCMod/Options.hs +++ b/src/GHCMod/Options.hs @@ -174,6 +174,12 @@ globalArgSpec = Options <=> metavar "OPT" <=> help "Option to be passed to GHC" <*> many fileMappingSpec + <*> strOption + $$ long "encoding" + <=> short 'e' + <=> value "UTF-8" + <=> showDefault + <=> help "I/O encoding" where fileMappingSpec = getFileMapping . splitOn '=' <$> strOption From 98b2e4dac265086447ba20f381f6d97cc1c4db46 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 9 Feb 2016 12:42:47 +0300 Subject: [PATCH 2/4] Since a backend option, remove encoding short opt --- src/GHCMod/Options.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/GHCMod/Options.hs b/src/GHCMod/Options.hs index 40c8fdd..e654c7e 100644 --- a/src/GHCMod/Options.hs +++ b/src/GHCMod/Options.hs @@ -176,7 +176,6 @@ globalArgSpec = Options <*> many fileMappingSpec <*> strOption $$ long "encoding" - <=> short 'e' <=> value "UTF-8" <=> showDefault <=> help "I/O encoding" From 1c668f20ba195da58692e0308f3cfa963a7b02b3 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 9 Feb 2016 12:51:28 +0300 Subject: [PATCH 3/4] [Tests] HLint changed some Errors to Warnings --- test/FileMappingSpec.hs | 8 ++++---- test/LintSpec.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) 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 From 69727f24faf9a3c487d92e3d1ad0d17d70ce1791 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 9 Feb 2016 16:25:30 +0300 Subject: [PATCH 4/4] Fix output encoding in loadMappedFileSource --- Language/Haskell/GhcMod/FileMapping.hs | 2 ++ 1 file changed, 2 insertions(+) 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