Skip to content
This repository was archived by the owner on Apr 25, 2020. It is now read-only.
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 11 additions & 5 deletions Language/Haskell/GhcMod/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Language/Haskell/GhcMod/Debug.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
13 changes: 7 additions & 6 deletions Language/Haskell/GhcMod/GHCApi.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.GHCApi (
, withGHCDummyFile
, initializeFlags
, initializeFlagsWithCradle
, setTargetFile
, setTargetFiles
, getDynamicFlags
, setSlowDynFlags
, checkSlowAndSet
Expand Down Expand Up @@ -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

----------------------------------------------------------------

Expand Down
2 changes: 1 addition & 1 deletion Language/Haskell/GhcMod/Info.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Language/Haskell/GhcMod/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.Internal (
LogReader
, GHCOption
, initializeFlagsWithCradle
, setTargetFile
, setTargetFiles
, checkSlowAndSet
, getDynamicFlags
) where
Expand Down
32 changes: 22 additions & 10 deletions src/GHCMod.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)

----------------------------------------------------------------
Expand All @@ -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"
Expand Down Expand Up @@ -70,6 +72,7 @@ parseArgs spec argv
----------------------------------------------------------------

data GHCModError = SafeList
| TooManyArguments String
| NoSuchCommand String
| CmdArg [String]
| FileNotExist String deriving (Show, Typeable)
Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/CabalApiSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions test/CheckSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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`)