From 41de7a54a2f6672302ce6edb4ad228f45287672c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= Date: Fri, 23 Aug 2013 11:12:17 +0900 Subject: [PATCH 1/5] Fix warning --- test/CabalApiSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index df6dde4..f4da0be 100644 --- a/test/CabalApiSpec.hs +++ b/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 From 35f40b3ce9c5761cd23ead8b5478cc38f1cca339 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= Date: Fri, 23 Aug 2013 11:30:07 +0900 Subject: [PATCH 2/5] Exit with status 1 on error --- src/GHCMod.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 275bd73..e6ef000 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -12,6 +12,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) ---------------------------------------------------------------- @@ -113,7 +114,8 @@ main = flip catches handlers $ do 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 () From 7fd7b3636391e7b8b4da6a8cfc49d02a5766d916 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= Date: Fri, 23 Aug 2013 11:30:25 +0900 Subject: [PATCH 3/5] Implement help command as advertised in usage --- src/GHCMod.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GHCMod.hs b/src/GHCMod.hs index e6ef000..80bcdf3 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -111,6 +111,7 @@ 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 From e7d746f11511e1c5263a03c187e867cad2ac163a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= Date: Wed, 21 Aug 2013 17:34:41 +0900 Subject: [PATCH 4/5] Don't silently ignore superfluous command line arguments --- src/GHCMod.hs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 80bcdf3..b50f17e 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -71,6 +71,7 @@ parseArgs spec argv ---------------------------------------------------------------- data GHCModError = SafeList + | TooManyArguments String | NoSuchCommand String | CmdArg [String] | FileNotExist String deriving (Show, Typeable) @@ -94,15 +95,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" -> nArgs 1 $ checkSyntax opt cradle cmdArg1 + "expand" -> nArgs 1 $ checkSyntax opt { expandSplice = True } cradle cmdArg1 + "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 @@ -121,6 +126,9 @@ main = flip catches handlers $ do 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 From 4758a6043cda04e8d6a6e040abc33ea711a1528d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= Date: Wed, 21 Aug 2013 17:21:49 +0900 Subject: [PATCH 5/5] check + expand: Allow passing in multiple files --- Language/Haskell/GhcMod/Check.hs | 16 +++++++++++----- Language/Haskell/GhcMod/Debug.hs | 2 +- Language/Haskell/GhcMod/GHCApi.hs | 13 +++++++------ Language/Haskell/GhcMod/Info.hs | 2 +- Language/Haskell/GhcMod/Internal.hs | 2 +- src/GHCMod.hs | 9 +++++---- test/CheckSpec.hs | 8 ++++---- 7 files changed, 30 insertions(+), 22 deletions(-) diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index 223123e..57057a7 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 9bab277..a560238 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index 4fac7a8..8ef1d99 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/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 ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 1bfbd4d..968ca09 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs index b709495..151035a 100644 --- a/Language/Haskell/GhcMod/Internal.hs +++ b/Language/Haskell/GhcMod/Internal.hs @@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.Internal ( LogReader , GHCOption , initializeFlagsWithCradle - , setTargetFile + , setTargetFiles , checkSlowAndSet , getDynamicFlags ) where diff --git a/src/GHCMod.hs b/src/GHCMod.hs index b50f17e..f2642f1 100644 --- a/src/GHCMod.hs +++ b/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 @@ -27,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] [ ...]\n" - ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" - ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod info" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" @@ -102,8 +103,8 @@ main = flip catches handlers $ do res <- case cmdArg0 of "browse" -> concat <$> mapM (browseModule opt) remainingArgs "list" -> listModules opt - "check" -> nArgs 1 $ checkSyntax opt cradle cmdArg1 - "expand" -> nArgs 1 $ checkSyntax opt { expandSplice = True } cradle 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 diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs index 02e0378..a2f57f8 100644 --- a/test/CheckSpec.hs +++ b/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`)