ghc-mod 2.1.1 → 2.1.2

raw patch · 14 files changed

+114/−66 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog +10/−0
• Language/Haskell/GhcMod.hs +1/−0
• Language/Haskell/GhcMod/Check.hs +12/−5
• Language/Haskell/GhcMod/Debug.hs +1/−1
• Language/Haskell/GhcMod/ErrMsg.hs +28/−20
• Language/Haskell/GhcMod/GHCApi.hs +9/−7
• Language/Haskell/GhcMod/Info.hs +1/−1
• Language/Haskell/GhcMod/Internal.hs +1/−1
• Language/Haskell/GhcMod/Lint.hs +2/−1
• Language/Haskell/GhcMod/Types.hs +18/−14
• ghc-mod.cabal +1/−1
• src/GHCMod.hs +25/−10
• test/CabalApiSpec.hs +1/−1
• test/CheckSpec.hs +4/−4

@@ -1,3 +1,13 @@+2013-09-04 v2.1.2+	* Supporting multiple target files. (@nh2)++2013-09-03 v2.1.1+	* A bug fix for library dependency.++2013-09-03 v2.1.0+	* Exporting Language.Haskell.GhcMod.Internal. (@alanz)+	* Supporting GHC 7.7. (@co-dan)+ 2013-05-30 v2.0.3 	* Using finalizePackageDescription to enable "if else" in a cabal 	file.

@@ -9,6 +9,7 @@   , getGHCVersion   -- * Options   , Options(..)+  , LineSeparator(..)   , OutputStyle(..)   , defaultOptions   -- * Types

@@ -16,9 +16,14 @@ --   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,16 +31,18 @@ --   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+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     options       | expandSplice opt = "-w:"   : ghcOpts opt       | otherwise        = "-Wall" : ghcOpts opt+    ls = lineSeparator opt

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

@@ -15,6 +15,7 @@ import GHC import HscTypes import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)+import Language.Haskell.GhcMod.Types (LineSeparator(..)) import qualified Language.Haskell.GhcMod.Gap as Gap import Outputable import System.FilePath (normalise)@@ -26,42 +27,42 @@  ---------------------------------------------------------------- -setLogger :: Bool -> DynFlags -> IO (DynFlags, LogReader)-setLogger False df = return (newdf, undefined)+setLogger :: Bool -> DynFlags -> LineSeparator -> IO (DynFlags, LogReader)+setLogger False df _ = return (newdf, undefined)   where     newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return ()-setLogger True  df = do+setLogger True  df ls = do     ref <- newIORef [] :: IO (IORef [String])     let newdf = Gap.setLogAction df $ appendLog ref     return (newdf, reverse <$> readIORef ref)   where     appendLog ref _ sev src _ msg = do-        let !l = ppMsg src sev df msg-        modifyIORef ref (\ls -> l : ls)+        let !l = ppMsg src sev df ls msg+        modifyIORef ref (l:)  ---------------------------------------------------------------- -handleErrMsg :: SourceError -> Ghc [String]-handleErrMsg err = do+handleErrMsg :: LineSeparator -> SourceError -> Ghc [String]+handleErrMsg ls err = do     dflag <- getSessionDynFlags-    return . errBagToStrList dflag . srcErrorMessages $ err+    return . errBagToStrList dflag ls . srcErrorMessages $ err -errBagToStrList :: DynFlags -> Bag ErrMsg -> [String]-errBagToStrList dflag = map (ppErrMsg dflag) . reverse . bagToList+errBagToStrList :: DynFlags -> LineSeparator -> Bag ErrMsg -> [String]+errBagToStrList dflag ls = map (ppErrMsg dflag ls) . reverse . bagToList  ---------------------------------------------------------------- -ppErrMsg :: DynFlags -> ErrMsg -> String-ppErrMsg dflag err = ppMsg spn SevError dflag msg ++ ext+ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String+ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext    where      spn = head (errMsgSpans err)      msg = errMsgShortDoc err-     ext = showMsg dflag (errMsgExtraInfo err)+     ext = showMsg dflag ls (errMsgExtraInfo err) -ppMsg :: SrcSpan -> Severity-> DynFlags -> SDoc -> String-ppMsg spn sev dflag msg = prefix ++ cts ++ "\0"+ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String+ppMsg spn sev dflag ls@(LineSeparator lsep) msg = prefix ++ cts ++ lsep   where-    cts  = showMsg dflag msg+    cts  = showMsg dflag ls msg     defaultPrefix       | dopt Opt_D_dump_splices dflag = ""       | otherwise                     = "Dummy:0:0:"@@ -73,8 +74,15 @@  ---------------------------------------------------------------- -showMsg :: DynFlags -> SDoc -> String-showMsg dflag sdoc = map toNull $ showUnqualifiedPage dflag sdoc+showMsg :: DynFlags -> LineSeparator -> SDoc -> String+showMsg dflag (LineSeparator [s]) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc   where-    toNull '\n' = '\0'-    toNull x = x+    replaceNull :: String -> String+    replaceNull []        = []+    replaceNull ('\n':xs) = s : replaceNull xs+    replaceNull (x:xs)    = x : replaceNull xs+showMsg dflag (LineSeparator lsep) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc+  where+    replaceNull []        = []+    replaceNull ('\n':xs) = lsep ++ replaceNull xs+    replaceNull (x:xs)    = x : replaceNull xs

@@ -5,7 +5,7 @@   , withGHCDummyFile   , initializeFlags   , initializeFlagsWithCradle-  , setTargetFile+  , setTargetFiles   , getDynamicFlags   , setSlowDynFlags   , checkSlowAndSet@@ -87,11 +87,12 @@     _ <- setSessionDynFlags dflags1     return readLog   where+    ls = lineSeparator opt     setupDynamicFlags df0 = do         df1 <- modifyFlagsWithOpts df0 cmdOpts         let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt) build         df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt-        liftIO $ setLogger logging df3+        liftIO $ setLogger logging df3 ls  ---------------------------------------------------------------- @@ -153,11 +154,12 @@  ---------------------------------------------------------------- --- | 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  ---------------------------------------------------------------- 

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

@@ -5,7 +5,7 @@     LogReader   , GHCOption   , initializeFlagsWithCradle-  , setTargetFile+  , setTargetFiles   , checkSlowAndSet   , getDynamicFlags   ) where

@@ -12,7 +12,8 @@            -> IO String lintSyntax opt file = pack <$> lint opt file   where-    pack = unlines . map (intercalate "\0" . lines)+    LineSeparator lsep = lineSeparator opt+    pack = unlines . map (intercalate lsep . lines)  lint :: Options      -> FilePath    -- ^ A target file.

@@ -6,29 +6,33 @@ data OutputStyle = LispStyle  -- ^ S expression style                  | PlainStyle -- ^ Plain textstyle +newtype LineSeparator = LineSeparator String+ data Options = Options {-    outputStyle  :: OutputStyle-  , hlintOpts    :: [String]-  , ghcOpts      :: [String]-  , operators    :: Bool+    outputStyle   :: OutputStyle+  , hlintOpts     :: [String]+  , ghcOpts       :: [String]+  , operators     :: Bool   -- | If 'True', 'browse' also returns types.-  , detailed     :: Bool+  , detailed      :: Bool   -- | Whether or not Template Haskell should be expanded.-  , expandSplice :: Bool+  , expandSplice  :: Bool   -- | The sandbox directory.-  , sandbox      :: Maybe FilePath+  , sandbox       :: Maybe FilePath+  , lineSeparator :: LineSeparator   }  -- | A default 'Options'. defaultOptions :: Options defaultOptions = Options {-    outputStyle  = PlainStyle-  , hlintOpts    = []-  , ghcOpts      = []-  , operators    = False-  , detailed     = False-  , expandSplice = False-  , sandbox      = Nothing+    outputStyle   = PlainStyle+  , hlintOpts     = []+  , ghcOpts       = []+  , operators     = False+  , detailed      = False+  , expandSplice  = False+  , sandbox       = Nothing+  , lineSeparator = LineSeparator "\0"   }  ----------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                2.1.1+Version:                2.1.2 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3

@@ -4,6 +4,7 @@  import Control.Applicative import Control.Exception+import Control.Monad import Data.Typeable import Data.Version import Language.Haskell.GhcMod@@ -12,6 +13,7 @@ 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 @@         ++ "\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"@@ -56,6 +58,9 @@           , Option "s" ["sandbox"]             (ReqArg (\s opts -> opts { sandbox = Just s }) "path")             "specify cabal-dev sandbox (default 'cabal-dev`)"+          , Option "b" ["boundary"]+            (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep")+            "specify line separator (default is Nul string)"           ]  parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])@@ -67,6 +72,7 @@ ----------------------------------------------------------------  data GHCModError = SafeList+                 | TooManyArguments String                  | NoSuchCommand String                  | CmdArg [String]                  | FileNotExist String deriving (Show, Typeable)@@ -90,15 +96,19 @@         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@@ -107,14 +117,19 @@          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

@@ -11,7 +11,7 @@ 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

@@ -14,24 +14,24 @@             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`)