Merge pull request #137 from nh2/multiple-files

Multiple files

Author: kazu-yamamoto

Language/Haskell/GhcMod/Check.hs

@@ -16,23 +16,29 @@ 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"
 
 ----------------------------------------------------------------
 
 -- | Checking syntax of a target file using GHC.
 --   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

Language/Haskell/GhcMod/Debug.hs

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

Language/Haskell/GhcMod/GHCApi.hs

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

Language/Haskell/GhcMod/Info.hs

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

Language/Haskell/GhcMod/Internal.hs

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

src/GHCMod.hs

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

test/CabalApiSpec.hs

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

test/CheckSpec.hs

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