diff --git a/Language/Haskell/GhcMod/FileMapping.hs b/Language/Haskell/GhcMod/FileMapping.hs index 5d95868..baca49b 100644 --- a/Language/Haskell/GhcMod/FileMapping.hs +++ b/Language/Haskell/GhcMod/FileMapping.hs @@ -1,6 +1,5 @@ module Language.Haskell.GhcMod.FileMapping ( loadMappedFile - , loadMappedFiles , unloadMappedFile , mapFile , fileModSummaryWithMapping @@ -17,11 +16,6 @@ import Data.Time import Control.Monad.Trans.Maybe import GHC -loadMappedFiles :: IOish m => GhcModT m () -loadMappedFiles = do - Options {fileMappings} <- options - mapM_ (uncurry loadMappedFile) fileMappings - loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m () loadMappedFile from fm = getCanonicalFileNameSafe from >>= (`addMMappedFile` fm) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 8389c18..57fc650 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -113,7 +113,7 @@ errBagToStrList env errs = let dflags = hsc_dflags env pu = icPrintUnqual dflags (hsc_IC env) st = mkUserStyle pu AllTheWay - in runReader (errsToStr (bagToList errs)) GmPprEnv{rsDynFlags=dflags, rsPprStyle=st} + in runReader (errsToStr (bagToList errs)) GmPprEnv{gpeDynFlags=dflags, gpePprStyle=st} ---------------------------------------------------------------- diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 1c21738..c7f5030 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -359,9 +359,17 @@ main = do progMain :: (Options,[String]) -> IO () progMain (globalOptions,cmdArgs) = hndle $ runGhcModT globalOptions $ handler $ do + let + loadMMappedFiles from (MemoryMapping Nothing) = do + src <- liftIO getFileSourceFromStdin + return (from, MemoryMapping $ Just src) + loadMMappedFiles from x = return (from, x) + fileMappings' <- forM (reverse $ fileMappings globalOptions) $ uncurry loadMMappedFiles case globalCommands cmdArgs of Just s -> gmPutStr s - Nothing -> ghcCommands cmdArgs + Nothing -> do + mapM_ (uncurry loadMappedFile) fileMappings' + ghcCommands cmdArgs where hndle action = do (e, _l) <- action @@ -468,9 +476,7 @@ getFileSourceFromStdin = do ghcCommands :: IOish m => [String] -> GhcModT m () ghcCommands [] = fatalError "No command given (try --help)" -ghcCommands (cmd:args) = do - loadMappedFiles - gmPutStr =<< action args +ghcCommands (cmd:args) = gmPutStr =<< action args where action = case cmd of _ | cmd == "list" || cmd == "modules" -> modulesCmd diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index ccd39be..18c583a 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -6,7 +6,6 @@ import Test.Hspec import TestUtils import qualified Data.Map as M import Dir -import Data.Maybe import Language.Haskell.GhcMod @@ -44,21 +43,6 @@ spec = do getMMappedFiles show mappedFiles `shouldBe` show (M.fromList ([] :: [(FilePath, FileMapping)])) - describe "loadMappedFiles" $ do - it "loads all file mappings passed as Options" $ do - let fm = [("File.hs", RedirectedMapping "File_Redir.hs"), ("File2.hs", MemoryMapping Nothing)] - mappedFiles <- run defaultOptions { fileMappings = fm } $ - loadMappedFiles >> getMMappedFiles - dir <- getCurrentDirectory - M.lookup (dir "File.hs") mappedFiles `shouldSatisfy` isJust - M.lookup (dir "File2.hs") mappedFiles `shouldSatisfy` isJust - it "prioritizes latter occurence of the same file" $ do - let fm = [("File.hs", RedirectedMapping "File_Redir.hs"), ("File.hs", MemoryMapping Nothing)] - mappedFiles <- run defaultOptions { fileMappings = fm } $ - loadMappedFiles >> getMMappedFiles - dir <- getCurrentDirectory - show (M.lookup (dir "File.hs") mappedFiles) `shouldBe` show (Just (MemoryMapping Nothing)) - describe "withMappedFile" $ do it "checks if there is a redirected file and calls and action with its FilePath" $ do withDirectory_ "test/data/file-mapping" $ do @@ -85,15 +69,15 @@ spec = do it "checks redirected file if one is specified and outputs original filename" $ do withDirectory_ "test/data/file-mapping" $ do let fm = [("File.hs", RedirectedMapping "File_Redir.hs")] - res <- run defaultOptions {fileMappings = fm} $ do - loadMappedFiles + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm checkSyntax ["File.hs"] res `shouldBe` "File.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" it "checks in-memory file if one is specified and outputs original filename" $ do withDirectory_ "test/data/file-mapping" $ do let fm = [("File.hs", MemoryMapping $ Just "main = putStrLn \"Hello World!\"\n")] - res <- run defaultOptions {fileMappings = fm} $ do - loadMappedFiles + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm checkSyntax ["File.hs"] res `shouldBe` "File.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" it "lints redirected file if one is specified and outputs original filename" $ do