hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #137 from nh2/multiple-files

Browse Source 
Multiple files
This commit is contained in:
Kazu Yamamoto 2013-09-03 18:11:56 -07:00
commit 496f53a378
8 changed files with 48 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Language/Haskell/GhcMod/Check.hs
View File

@ -16,9 +16,14 @@ import Prelude
-- Warnings and errors are returned.
checkSyntax :: Options
-> Cradle
-> FilePath -- ^ A target file
-> [FilePath] -- ^ The target files
-> IO String
checkSyntax opt cradle file = unlines <$> withGHC file (check opt cradle file)
checkSyntax _ _ [] = error "ghc-mod: checkSyntax: No files given"
checkSyntax opt cradle files = unlines <$> withGHC sessionName (check opt cradle files)
where
sessionName = case files of
[file] -> file
_ -> "MultipleFiles"
----------------------------------------------------------------
@ -26,13 +31,14 @@ checkSyntax opt cradle file = unlines <$> withGHC file (check opt cradle file)
-- Warnings and errors are returned.
check :: Options
-> Cradle
-> FilePath -- ^ A target file
-> [FilePath] -- ^ The target files
-> Ghc [String]
check opt cradle fileName = checkIt `gcatch` handleErrMsg ls
check _ _ [] = error "ghc-mod: check: No files given"
check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls
where
checkIt = do
readLog <- initializeFlagsWithCradle opt cradle options True
setTargetFile fileName
setTargetFiles fileNames
checkSlowAndSet
void $ load LoadAllTargets
liftIO readLog

2
Language/Haskell/GhcMod/Debug.hs
View File

@ -36,7 +36,7 @@ debug opt cradle ver fileName = do
return (ghcOpts opt, [], [])
[fast] <- do
void $ initializeFlagsWithCradle opt cradle gopts True
setTargetFile fileName
setTargetFiles [fileName]
pure . canCheckFast <$> depanal [] False
return [
"GHC version: " ++ ver

13
Language/Haskell/GhcMod/GHCApi.hs
View File

@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.GHCApi (
, withGHCDummyFile
, initializeFlags
, initializeFlagsWithCradle
, setTargetFile
, setTargetFiles
, getDynamicFlags
, setSlowDynFlags
, checkSlowAndSet
@ -154,11 +154,12 @@ modifyFlagsWithOpts dflags cmdOpts =
----------------------------------------------------------------
-- | Set the file that GHC will load / compile
setTargetFile :: (GhcMonad m) => String -> m ()
setTargetFile file = do
target <- guessTarget file Nothing
setTargets [target]
-- | Set the files that GHC will load / compile
setTargetFiles :: (GhcMonad m) => [String] -> m ()
setTargetFiles [] = error "ghc-mod: setTargetFiles: No target files given"
setTargetFiles files = do
targets <- forM files $ \file -> guessTarget file Nothing
setTargets targets
----------------------------------------------------------------

2
Language/Haskell/GhcMod/Info.hs
View File

@ -148,7 +148,7 @@ inModuleContext cmd opt cradle file modstr action errmsg =
valid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False
when (cmd == Info) setSlowDynFlags
setTargetFile file
setTargetFiles [file]
checkSlowAndSet
void $ load LoadAllTargets
doif setContextFromTarget action

2
Language/Haskell/GhcMod/Internal.hs
View File

@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.Internal (
LogReader
, GHCOption
, initializeFlagsWithCradle
, setTargetFile
, setTargetFiles
, checkSlowAndSet
, getDynamicFlags
) where

32
src/GHCMod.hs
View File

@ -4,6 +4,7 @@ module Main where
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Typeable
import Data.Version
import Language.Haskell.GhcMod
@ -12,6 +13,7 @@ import Prelude
import System.Console.GetOpt
import System.Directory
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)
----------------------------------------------------------------
@ -26,8 +28,8 @@ usage = "ghc-mod version " ++ showVersion version ++ "\n"
++ "\t ghc-mod lang [-l]\n"
++ "\t ghc-mod flag [-l]\n"
++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] <module> [<module> ...]\n"
++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFile>\n"
++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFile>\n"
++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n"
++ "\t ghc-mod info" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
@ -70,6 +72,7 @@ parseArgs spec argv
----------------------------------------------------------------
data GHCModError = SafeList
| TooManyArguments String
| NoSuchCommand String
| CmdArg [String]
| FileNotExist String deriving (Show, Typeable)
@ -93,15 +96,19 @@ main = flip catches handlers $ do
cmdArg2 = cmdArg !. 2
cmdArg3 = cmdArg !. 3
cmdArg4 = cmdArg !. 4
remainingArgs = tail cmdArg
nArgs n f = if length remainingArgs == n
then f
else throw (TooManyArguments cmdArg0)
res <- case cmdArg0 of
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
"browse" -> concat <$> mapM (browseModule opt) remainingArgs
"list" -> listModules opt
"check" -> checkSyntax opt cradle cmdArg1
"expand" -> checkSyntax opt { expandSplice = True } cradle cmdArg1
"debug" -> debugInfo opt cradle strVer cmdArg1
"type" -> typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)
"info" -> infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3
"lint" -> withFile (lintSyntax opt) cmdArg1
"check" -> checkSyntax opt cradle remainingArgs
"expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs
"debug" -> nArgs 1 $ debugInfo opt cradle strVer cmdArg1
"type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)
"info" -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3
"lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1
"lang" -> listLanguages opt
"flag" -> listFlags opt
"boot" -> do
@ -110,14 +117,19 @@ main = flip catches handlers $ do
flags <- listFlags opt
pre <- concat <$> mapM (browseModule opt) preBrowsedModules
return $ mods ++ langs ++ flags ++ pre
"help" -> return $ usageInfo usage argspec
cmd -> throw (NoSuchCommand cmd)
putStr res
where
handlers = [Handler handler1, Handler handler2]
handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]
handleThenExit handler = \e -> handler e >> exitFailure
handler1 :: ErrorCall -> IO ()
handler1 = print -- for debug
handler2 :: GHCModError -> IO ()
handler2 SafeList = printUsage
handler2 (TooManyArguments cmd) = do
hPutStrLn stderr $ "\"" ++ cmd ++ "\": Too many arguments"
printUsage
handler2 (NoSuchCommand cmd) = do
hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"
printUsage

2
test/CabalApiSpec.hs
View File

@ -11,7 +11,7 @@ spec :: Spec
spec = do
describe "parseCabalFile" $ do
it "throws an exception if the cabal file is broken" $ do
parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(e::IOException) -> True)
parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(_::IOException) -> True)
describe "cabalAllDependPackages" $ do
it "extracts dependent packages" $ do

8
test/CheckSpec.hs
View File

@ -14,24 +14,24 @@ spec = do
withDirectory_ "test/data/ghc-mod-check" $ do
(strVer,_) <- getGHCVersion
cradle <- findCradle Nothing strVer
res <- checkSyntax defaultOptions cradle "main.hs"
res <- checkSyntax defaultOptions cradle ["main.hs"]
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n"
it "can check even if a test module imports another test module located at different directory" $ do
withDirectory_ "test/data/check-test-subdir" $ do
cradle <- getGHCVersion >>= findCradle Nothing . fst
res <- checkSyntax defaultOptions cradle "test/Bar/Baz.hs"
res <- checkSyntax defaultOptions cradle ["test/Bar/Baz.hs"]
res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\NUL\n") `isSuffixOf`)
it "can detect mutually imported modules" $ do
withDirectory_ "test/data" $ do
(strVer,_) <- getGHCVersion
cradle <- findCradle Nothing strVer
res <- checkSyntax defaultOptions cradle "Mutual1.hs"
res <- checkSyntax defaultOptions cradle ["Mutual1.hs"]
res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
it "can check a module using QuasiQuotes" $ do
withDirectory_ "test/data" $ do
cradle <- getGHCVersion >>= findCradle Nothing . fst
res <- checkSyntax defaultOptions cradle "Baz.hs"
res <- checkSyntax defaultOptions cradle ["Baz.hs"]
res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)