Drop loadMappedFiles and move all loading code to progMain

This commit is contained in:
Nikolay Yakimov 2015-08-12 18:01:01 +03:00
parent a9b98e7128
commit c96abfc422
4 changed files with 15 additions and 31 deletions

View File

@ -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)

View File

@ -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}
----------------------------------------------------------------

View File

@ -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

View File

@ -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