check + expand: Allow passing in multiple files

Author: nh2

Check.hs

@@ -12,17 +12,18 @@ import Types
 
 ----------------------------------------------------------------
 
-checkSyntax :: Options -> Cradle -> String -> IO String
-checkSyntax opt cradle file = unlines <$> check opt cradle file
+checkSyntax :: Options -> Cradle -> [String] -> IO String
+checkSyntax opt cradle files = unlines <$> check opt cradle files
 
 ----------------------------------------------------------------
 
-check :: Options -> Cradle -> String -> IO [String]
-check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg
+check :: Options -> Cradle -> [String] -> IO [String]
+check _   _      []        = error "ghc-mod: check: No files given"
+check opt cradle fileNames = withGHC (concat fileNames) $ checkIt `gcatch` handleErrMsg
   where
     checkIt = do
         readLog <- initializeFlagsWithCradle opt cradle options True
-        setTargetFile fileName
+        setTargetFiles fileNames
         checkSlowAndSet
         void $ load LoadAllTargets
         liftIO readLog

Debug.hs

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

GHCApi.hs

@@ -3,7 +3,7 @@ module GHCApi (
   , withGHCDummyFile
   , initializeFlags
   , initializeFlagsWithCradle
-  , setTargetFile
+  , setTargetFiles
   , getDynamicFlags
   , setSlowDynFlags
   , checkSlowAndSet
@@ -150,10 +150,11 @@ modifyFlagsWithOpts dflags cmdOpts =
 
 ----------------------------------------------------------------
 
-setTargetFile :: (GhcMonad m) => String -> m ()
-setTargetFile file = do
-    target <- guessTarget file Nothing
-    setTargets [target]
+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
 
 ----------------------------------------------------------------
 

GHCMod.hs

@@ -7,6 +7,7 @@ import CabalApi
 import Check
 import Control.Applicative
 import Control.Exception
+import Control.Monad
 import Cradle
 import Data.Typeable
 import Data.Version
@@ -108,8 +109,8 @@ main = flip catches handlers $ do
     res <- case cmdArg0 of
       "browse" -> concat <$> mapM (browseModule opt) remainingArgs
       "list"   -> listModules opt
-      "check"  -> nArgs 1 $ withFile (checkSyntax opt cradle) cmdArg1
-      "expand" -> nArgs 1 $ withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
+      "check"  -> withFiles (checkSyntax opt cradle) remainingArgs
+      "expand" -> withFiles (checkSyntax opt { expandSplice = True } cradle) remainingArgs
       "debug"  -> nArgs 1 $ withFile (debugInfo opt cradle strVer) cmdArg1
       "type"   -> nArgs 4 $ withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
       "info"   -> nArgs 3 $ withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
@@ -148,6 +149,11 @@ main = flip catches handlers $ do
         if exist
             then cmd file
             else throw (FileNotExist file)
+    withFiles cmd files = do
+        missing <- findM ((not <$>) . doesFileExist) files
+        case missing of
+            Just file -> throw (FileNotExist file)
+            Nothing   -> cmd files
     xs !. idx
       | length xs <= idx = throw SafeList
       | otherwise = xs !! idx
@@ -159,6 +165,21 @@ main = flip catches handlers $ do
       where
         mPkgConf = cradlePackageConf cradle
 
+-- | Returns the first Just produced, if any.
+findJust :: (Monad m) => [m (Maybe a)] -> m (Maybe a)
+findJust []         = return Nothing
+findJust (mma:mmas) = do
+  m <- mma
+  case m of Nothing -> findJust mmas
+            just    -> return just
+
+-- | Returns the first result that fulfills the check.
+findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+findM f xs = findJust $ map justIfTrue xs
+  where
+    justIfTrue x = (\b -> if b then Just x else Nothing) `liftM` f x
+
+
 ----------------------------------------------------------------
 
 preBrowsedModules :: [String]

Info.hs

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