Drop loadMappedFiles and move all loading code to progMain
This commit is contained in:
parent
a9b98e7128
commit
c96abfc422
@ -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)
|
||||
|
@ -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}
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user