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 module Language.Haskell.GhcMod.FileMapping
( loadMappedFile ( loadMappedFile
, loadMappedFiles
, unloadMappedFile , unloadMappedFile
, mapFile , mapFile
, fileModSummaryWithMapping , fileModSummaryWithMapping
@ -17,11 +16,6 @@ import Data.Time
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import GHC import GHC
loadMappedFiles :: IOish m => GhcModT m ()
loadMappedFiles = do
Options {fileMappings} <- options
mapM_ (uncurry loadMappedFile) fileMappings
loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m () loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m ()
loadMappedFile from fm = loadMappedFile from fm =
getCanonicalFileNameSafe from >>= (`addMMappedFile` fm) getCanonicalFileNameSafe from >>= (`addMMappedFile` fm)

View File

@ -113,7 +113,7 @@ errBagToStrList env errs = let
dflags = hsc_dflags env dflags = hsc_dflags env
pu = icPrintUnqual dflags (hsc_IC env) pu = icPrintUnqual dflags (hsc_IC env)
st = mkUserStyle pu AllTheWay 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 :: (Options,[String]) -> IO ()
progMain (globalOptions,cmdArgs) = hndle $ runGhcModT globalOptions $ handler $ do 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 case globalCommands cmdArgs of
Just s -> gmPutStr s Just s -> gmPutStr s
Nothing -> ghcCommands cmdArgs Nothing -> do
mapM_ (uncurry loadMappedFile) fileMappings'
ghcCommands cmdArgs
where where
hndle action = do hndle action = do
(e, _l) <- action (e, _l) <- action
@ -468,9 +476,7 @@ getFileSourceFromStdin = do
ghcCommands :: IOish m => [String] -> GhcModT m () ghcCommands :: IOish m => [String] -> GhcModT m ()
ghcCommands [] = fatalError "No command given (try --help)" ghcCommands [] = fatalError "No command given (try --help)"
ghcCommands (cmd:args) = do ghcCommands (cmd:args) = gmPutStr =<< action args
loadMappedFiles
gmPutStr =<< action args
where where
action = case cmd of action = case cmd of
_ | cmd == "list" || cmd == "modules" -> modulesCmd _ | cmd == "list" || cmd == "modules" -> modulesCmd

View File

@ -6,7 +6,6 @@ import Test.Hspec
import TestUtils import TestUtils
import qualified Data.Map as M import qualified Data.Map as M
import Dir import Dir
import Data.Maybe
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
@ -44,21 +43,6 @@ spec = do
getMMappedFiles getMMappedFiles
show mappedFiles `shouldBe` show (M.fromList ([] :: [(FilePath, FileMapping)])) 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 describe "withMappedFile" $ do
it "checks if there is a redirected file and calls and action with its FilePath" $ do it "checks if there is a redirected file and calls and action with its FilePath" $ do
withDirectory_ "test/data/file-mapping" $ 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 it "checks redirected file if one is specified and outputs original filename" $ do
withDirectory_ "test/data/file-mapping" $ do withDirectory_ "test/data/file-mapping" $ do
let fm = [("File.hs", RedirectedMapping "File_Redir.hs")] let fm = [("File.hs", RedirectedMapping "File_Redir.hs")]
res <- run defaultOptions {fileMappings = fm} $ do res <- run defaultOptions $ do
loadMappedFiles mapM_ (uncurry loadMappedFile) fm
checkSyntax ["File.hs"] checkSyntax ["File.hs"]
res `shouldBe` "File.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" 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 it "checks in-memory file if one is specified and outputs original filename" $ do
withDirectory_ "test/data/file-mapping" $ do withDirectory_ "test/data/file-mapping" $ do
let fm = [("File.hs", MemoryMapping $ Just "main = putStrLn \"Hello World!\"\n")] let fm = [("File.hs", MemoryMapping $ Just "main = putStrLn \"Hello World!\"\n")]
res <- run defaultOptions {fileMappings = fm} $ do res <- run defaultOptions $ do
loadMappedFiles mapM_ (uncurry loadMappedFile) fm
checkSyntax ["File.hs"] checkSyntax ["File.hs"]
res `shouldBe` "File.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" 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 it "lints redirected file if one is specified and outputs original filename" $ do