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
|
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)
|
||||||
|
@ -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}
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user