Migrate the remaining parts of the exposed API to GhcMod a
This commit is contained in:
parent
dc5ba6d00d
commit
4b6a687bc1
@ -12,23 +12,25 @@ module Language.Haskell.GhcMod (
|
|||||||
-- * Types
|
-- * Types
|
||||||
, ModuleString
|
, ModuleString
|
||||||
, Expression
|
, Expression
|
||||||
-- * 'IO' utilities
|
, GhcPkgDb
|
||||||
, bootInfo
|
-- * 'GhcMod' utilities
|
||||||
|
, boot
|
||||||
, browse
|
, browse
|
||||||
|
, check
|
||||||
, checkSyntax
|
, checkSyntax
|
||||||
, lintSyntax
|
|
||||||
, expandTemplate
|
|
||||||
, infoExpr
|
|
||||||
, typeExpr
|
|
||||||
, fillSig
|
|
||||||
, listModules
|
|
||||||
, listLanguages
|
|
||||||
, listFlags
|
|
||||||
, debugInfo
|
, debugInfo
|
||||||
, rootInfo
|
, expandTemplate
|
||||||
, packageDoc
|
|
||||||
, findSymbol
|
, findSymbol
|
||||||
, splitVar
|
, info
|
||||||
|
, lint
|
||||||
|
, pkgDoc
|
||||||
|
, rootInfo
|
||||||
|
, types
|
||||||
|
, splits
|
||||||
|
, sig
|
||||||
|
, modules
|
||||||
|
, languages
|
||||||
|
, flags
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Language.Haskell.GhcMod.Boot
|
import Language.Haskell.GhcMod.Boot
|
||||||
|
@ -1,27 +1,16 @@
|
|||||||
module Language.Haskell.GhcMod.Boot where
|
module Language.Haskell.GhcMod.Boot where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative
|
||||||
import CoreMonad (liftIO, liftIO)
|
|
||||||
import Language.Haskell.GhcMod.Browse
|
import Language.Haskell.GhcMod.Browse
|
||||||
import Language.Haskell.GhcMod.Flag
|
import Language.Haskell.GhcMod.Flag
|
||||||
import Language.Haskell.GhcMod.Lang
|
import Language.Haskell.GhcMod.Lang
|
||||||
import Language.Haskell.GhcMod.List
|
import Language.Haskell.GhcMod.List
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
|
||||||
|
|
||||||
-- | Printing necessary information for front-end booting.
|
|
||||||
bootInfo :: Options -> IO String
|
|
||||||
bootInfo opt = runGhcMod opt $ boot
|
|
||||||
|
|
||||||
-- | Printing necessary information for front-end booting.
|
-- | Printing necessary information for front-end booting.
|
||||||
boot :: GhcMod String
|
boot :: GhcMod String
|
||||||
boot = do
|
boot = concat <$> sequence [modules, languages, flags,
|
||||||
opt <- options
|
concat <$> mapM browse preBrowsedModules]
|
||||||
mods <- modules
|
|
||||||
langs <- liftIO $ listLanguages opt
|
|
||||||
flags <- liftIO $ listFlags opt
|
|
||||||
pre <- concat <$> mapM browse preBrowsedModules
|
|
||||||
return $ mods ++ langs ++ flags ++ pre
|
|
||||||
|
|
||||||
preBrowsedModules :: [String]
|
preBrowsedModules :: [String]
|
||||||
preBrowsedModules = [
|
preBrowsedModules = [
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module Language.Haskell.GhcMod.CaseSplit (
|
module Language.Haskell.GhcMod.CaseSplit (
|
||||||
splitVar
|
splits
|
||||||
, splits
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List (find, intercalate)
|
import Data.List (find, intercalate)
|
||||||
@ -11,12 +10,10 @@ import qualified Data.Text.IO as T (readFile)
|
|||||||
import Exception (ghandle, SomeException(..))
|
import Exception (ghandle, SomeException(..))
|
||||||
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
|
||||||
import Language.Haskell.GhcMod.Gap (HasType(..))
|
import Language.Haskell.GhcMod.Gap (HasType(..))
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.SrcUtils
|
import Language.Haskell.GhcMod.SrcUtils
|
||||||
import Language.Haskell.GhcMod.Types
|
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
import MonadUtils (liftIO)
|
import MonadUtils (liftIO)
|
||||||
import Outputable (PprStyle)
|
import Outputable (PprStyle)
|
||||||
@ -35,17 +32,6 @@ data SplitToTextInfo = SplitToTextInfo { sVarName :: String
|
|||||||
, sTycons :: [String]
|
, sTycons :: [String]
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Splitting a variable in a equation.
|
|
||||||
splitVar :: Options
|
|
||||||
-> Cradle
|
|
||||||
-> FilePath -- ^ A target file.
|
|
||||||
-> Int -- ^ Line number.
|
|
||||||
-> Int -- ^ Column number.
|
|
||||||
-> IO String
|
|
||||||
splitVar opt cradle file lineNo colNo = runGhcMod opt $ do
|
|
||||||
initializeFlagsWithCradle opt cradle
|
|
||||||
splits file lineNo colNo
|
|
||||||
|
|
||||||
-- | Splitting a variable in a equation.
|
-- | Splitting a variable in a equation.
|
||||||
splits :: FilePath -- ^ A target file.
|
splits :: FilePath -- ^ A target file.
|
||||||
-> Int -- ^ Line number.
|
-> Int -- ^ Line number.
|
||||||
|
@ -1,55 +1,44 @@
|
|||||||
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where
|
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception.IOChoice ((||>))
|
|
||||||
import CoreMonad (liftIO)
|
import CoreMonad (liftIO)
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import Data.Maybe (fromMaybe, isJust, fromJust)
|
import Data.Maybe (isJust, fromJust)
|
||||||
import Language.Haskell.GhcMod.CabalApi
|
import Language.Haskell.GhcMod.CabalApi
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
import Language.Haskell.GhcMod.GHCApi
|
||||||
|
import Language.Haskell.GhcMod.GHCChoice ((||>))
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining debug information.
|
-- | Obtaining debug information.
|
||||||
debugInfo :: Options
|
debugInfo :: GhcMod String
|
||||||
-> Cradle
|
debugInfo = cradle >>= \c -> convert' =<< do
|
||||||
-> IO String
|
|
||||||
debugInfo opt cradle = convert opt <$> do
|
|
||||||
CompilerOptions gopts incDir pkgs <-
|
CompilerOptions gopts incDir pkgs <-
|
||||||
if cabal then
|
if isJust $ cradleCabalFile c then
|
||||||
liftIO (fromCabalFile ||> return simpleCompilerOption)
|
(fromCabalFile c ||> simpleCompilerOption)
|
||||||
else
|
else
|
||||||
return simpleCompilerOption
|
simpleCompilerOption
|
||||||
mglibdir <- liftIO getSystemLibDir
|
|
||||||
return [
|
return [
|
||||||
"Root directory: " ++ rootDir
|
"Root directory: " ++ cradleRootDir c
|
||||||
, "Current directory: " ++ currentDir
|
, "Current directory: " ++ cradleCurrentDir c
|
||||||
, "Cabal file: " ++ cabalFile
|
, "Cabal file: " ++ show (cradleCabalFile c)
|
||||||
, "GHC options: " ++ unwords gopts
|
, "GHC options: " ++ unwords gopts
|
||||||
, "Include directories: " ++ unwords incDir
|
, "Include directories: " ++ unwords incDir
|
||||||
, "Dependent packages: " ++ intercalate ", " (map showPkg pkgs)
|
, "Dependent packages: " ++ intercalate ", " (map showPkg pkgs)
|
||||||
, "System libraries: " ++ fromMaybe "" mglibdir
|
, "System libraries: " ++ systemLibDir
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
currentDir = cradleCurrentDir cradle
|
simpleCompilerOption = options >>= \op ->
|
||||||
mCabalFile = cradleCabalFile cradle
|
return $ CompilerOptions (ghcOpts op) [] []
|
||||||
rootDir = cradleRootDir cradle
|
fromCabalFile c = options >>= \opts -> liftIO $ do
|
||||||
cabal = isJust mCabalFile
|
pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c
|
||||||
cabalFile = fromMaybe "" mCabalFile
|
getCompilerOptions (ghcOpts opts) c pkgDesc
|
||||||
origGopts = ghcOpts opt
|
|
||||||
simpleCompilerOption = CompilerOptions origGopts [] []
|
|
||||||
fromCabalFile = do
|
|
||||||
pkgDesc <- parseCabalFile file
|
|
||||||
getCompilerOptions origGopts cradle pkgDesc
|
|
||||||
where
|
|
||||||
file = fromJust mCabalFile
|
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining root information.
|
-- | Obtaining root information.
|
||||||
rootInfo :: Options
|
rootInfo :: GhcMod String
|
||||||
-> Cradle
|
rootInfo = convert' =<< cradleRootDir <$> cradle
|
||||||
-> IO String
|
|
||||||
rootInfo opt cradle = return $ convert opt $ cradleRootDir cradle
|
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}
|
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}
|
||||||
|
|
||||||
module Language.Haskell.GhcMod.FillSig (
|
module Language.Haskell.GhcMod.FillSig (
|
||||||
fillSig
|
sig
|
||||||
, sig
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Char (isSymbol)
|
import Data.Char (isSymbol)
|
||||||
@ -10,12 +9,10 @@ import Data.List (find, intercalate)
|
|||||||
import Exception (ghandle, SomeException(..))
|
import Exception (ghandle, SomeException(..))
|
||||||
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.SrcUtils
|
import Language.Haskell.GhcMod.SrcUtils
|
||||||
import Language.Haskell.GhcMod.Types
|
|
||||||
import MonadUtils (liftIO)
|
import MonadUtils (liftIO)
|
||||||
import Outputable (PprStyle)
|
import Outputable (PprStyle)
|
||||||
import qualified Type as Ty
|
import qualified Type as Ty
|
||||||
@ -40,17 +37,6 @@ data SigInfo = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName)
|
|||||||
-- Signature for fallback operation via haskell-src-exts
|
-- Signature for fallback operation via haskell-src-exts
|
||||||
data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo)
|
data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo)
|
||||||
|
|
||||||
-- | Create a initial body from a signature.
|
|
||||||
fillSig :: Options
|
|
||||||
-> Cradle
|
|
||||||
-> FilePath -- ^ A target file.
|
|
||||||
-> Int -- ^ Line number.
|
|
||||||
-> Int -- ^ Column number.
|
|
||||||
-> IO String
|
|
||||||
fillSig opt cradle file lineNo colNo = runGhcMod opt $ do
|
|
||||||
initializeFlagsWithCradle opt cradle
|
|
||||||
sig file lineNo colNo
|
|
||||||
|
|
||||||
-- | Create a initial body from a signature.
|
-- | Create a initial body from a signature.
|
||||||
sig :: FilePath -- ^ A target file.
|
sig :: FilePath -- ^ A target file.
|
||||||
-> Int -- ^ Line number.
|
-> Int -- ^ Line number.
|
||||||
|
@ -2,12 +2,12 @@ module Language.Haskell.GhcMod.Flag where
|
|||||||
|
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Monad
|
||||||
|
|
||||||
-- | Listing GHC flags. (e.g -fno-warn-orphans)
|
-- | Listing GHC flags. (e.g -fno-warn-orphans)
|
||||||
|
|
||||||
listFlags :: Options -> IO String
|
flags :: GhcMod String
|
||||||
listFlags opt = return $ convert opt [ "-f" ++ prefix ++ option
|
flags = convert' [ "-f" ++ prefix ++ option
|
||||||
| option <- Gap.fOptions
|
| option <- Gap.fOptions
|
||||||
, prefix <- ["","no-"]
|
, prefix <- ["","no-"]
|
||||||
]
|
]
|
||||||
|
@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.GHCApi (
|
|||||||
, initializeFlagsWithCradle
|
, initializeFlagsWithCradle
|
||||||
, setTargetFiles
|
, setTargetFiles
|
||||||
, getDynamicFlags
|
, getDynamicFlags
|
||||||
, getSystemLibDir
|
, systemLibDir
|
||||||
, withDynFlags
|
, withDynFlags
|
||||||
, withCmdFlags
|
, withCmdFlags
|
||||||
, setNoWaringFlags
|
, setNoWaringFlags
|
||||||
@ -16,6 +16,8 @@ module Language.Haskell.GhcMod.GHCApi (
|
|||||||
import Language.Haskell.GhcMod.CabalApi
|
import Language.Haskell.GhcMod.CabalApi
|
||||||
import Language.Haskell.GhcMod.GHCChoice
|
import Language.Haskell.GhcMod.GHCChoice
|
||||||
import Language.Haskell.GhcMod.GhcPkg
|
import Language.Haskell.GhcMod.GhcPkg
|
||||||
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
|
import Language.Haskell.GhcMod.Types
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Monad (forM, void)
|
import Control.Monad (forM, void)
|
||||||
@ -25,8 +27,6 @@ import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
|
|||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import GhcMonad
|
import GhcMonad
|
||||||
import GHC.Paths (libdir)
|
import GHC.Paths (libdir)
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
|
||||||
import Language.Haskell.GhcMod.Types
|
|
||||||
import System.Exit (exitSuccess)
|
import System.Exit (exitSuccess)
|
||||||
import System.IO (hPutStr, hPrint, stderr)
|
import System.IO (hPutStr, hPrint, stderr)
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
@ -34,8 +34,8 @@ import System.IO.Unsafe (unsafePerformIO)
|
|||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining the directory for system libraries.
|
-- | Obtaining the directory for system libraries.
|
||||||
getSystemLibDir :: IO (Maybe FilePath)
|
systemLibDir :: FilePath
|
||||||
getSystemLibDir = return $ Just libdir
|
systemLibDir = libdir
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
@ -53,8 +53,7 @@ withGHC file body = ghandle ignore $ withGHC' body
|
|||||||
|
|
||||||
withGHC' :: Ghc a -> IO a
|
withGHC' :: Ghc a -> IO a
|
||||||
withGHC' body = do
|
withGHC' body = do
|
||||||
mlibdir <- getSystemLibDir
|
G.runGhc (Just systemLibDir) $ do
|
||||||
G.runGhc mlibdir $ do
|
|
||||||
dflags <- G.getSessionDynFlags
|
dflags <- G.getSessionDynFlags
|
||||||
G.defaultCleanupHandler dflags body
|
G.defaultCleanupHandler dflags body
|
||||||
|
|
||||||
@ -161,8 +160,7 @@ setTargetFiles files = do
|
|||||||
-- | Return the 'DynFlags' currently in use in the GHC session.
|
-- | Return the 'DynFlags' currently in use in the GHC session.
|
||||||
getDynamicFlags :: IO DynFlags
|
getDynamicFlags :: IO DynFlags
|
||||||
getDynamicFlags = do
|
getDynamicFlags = do
|
||||||
mlibdir <- getSystemLibDir
|
G.runGhc (Just systemLibDir) G.getSessionDynFlags
|
||||||
G.runGhc mlibdir G.getSessionDynFlags
|
|
||||||
|
|
||||||
withDynFlags :: GhcMonad m
|
withDynFlags :: GhcMonad m
|
||||||
=> (DynFlags -> DynFlags)
|
=> (DynFlags -> DynFlags)
|
||||||
@ -197,8 +195,7 @@ setAllWaringFlags df = df { warningFlags = allWarningFlags }
|
|||||||
|
|
||||||
allWarningFlags :: Gap.WarnFlags
|
allWarningFlags :: Gap.WarnFlags
|
||||||
allWarningFlags = unsafePerformIO $ do
|
allWarningFlags = unsafePerformIO $ do
|
||||||
mlibdir <- getSystemLibDir
|
G.runGhc (Just systemLibDir) $ do
|
||||||
G.runGhc mlibdir $ do
|
|
||||||
df <- G.getSessionDynFlags
|
df <- G.getSessionDynFlags
|
||||||
df' <- addCmdOpts ["-Wall"] df
|
df' <- addCmdOpts ["-Wall"] df
|
||||||
return $ G.warningFlags df'
|
return $ G.warningFlags df'
|
||||||
|
@ -2,15 +2,6 @@ module Language.Haskell.GhcMod.Ghc (
|
|||||||
-- * Converting the 'Ghc' monad to the 'IO' monad
|
-- * Converting the 'Ghc' monad to the 'IO' monad
|
||||||
withGHC
|
withGHC
|
||||||
, withGHC'
|
, withGHC'
|
||||||
-- * 'Ghc' utilities
|
|
||||||
, boot
|
|
||||||
, browse
|
|
||||||
, check
|
|
||||||
, info
|
|
||||||
, types
|
|
||||||
, splits
|
|
||||||
, sig
|
|
||||||
, modules
|
|
||||||
-- * 'SymMdlDb'
|
-- * 'SymMdlDb'
|
||||||
, Symbol
|
, Symbol
|
||||||
, SymMdlDb
|
, SymMdlDb
|
||||||
@ -19,12 +10,5 @@ module Language.Haskell.GhcMod.Ghc (
|
|||||||
, lookupSym'
|
, lookupSym'
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Language.Haskell.GhcMod.Boot
|
|
||||||
import Language.Haskell.GhcMod.Browse
|
|
||||||
import Language.Haskell.GhcMod.Check
|
|
||||||
import Language.Haskell.GhcMod.Find
|
import Language.Haskell.GhcMod.Find
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
import Language.Haskell.GhcMod.GHCApi
|
||||||
import Language.Haskell.GhcMod.Info
|
|
||||||
import Language.Haskell.GhcMod.List
|
|
||||||
import Language.Haskell.GhcMod.FillSig
|
|
||||||
import Language.Haskell.GhcMod.CaseSplit
|
|
||||||
|
@ -1,7 +1,5 @@
|
|||||||
module Language.Haskell.GhcMod.Info (
|
module Language.Haskell.GhcMod.Info (
|
||||||
infoExpr
|
info
|
||||||
, info
|
|
||||||
, typeExpr
|
|
||||||
, types
|
, types
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -13,7 +11,6 @@ import Exception (ghandle, SomeException(..))
|
|||||||
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
|
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod.Doc (showPage)
|
import Language.Haskell.GhcMod.Doc (showPage)
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
|
||||||
import Language.Haskell.GhcMod.Gap (HasType(..))
|
import Language.Haskell.GhcMod.Gap (HasType(..))
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
@ -23,16 +20,6 @@ import Language.Haskell.GhcMod.Convert
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
|
||||||
infoExpr :: Options
|
|
||||||
-> Cradle
|
|
||||||
-> FilePath -- ^ A target file.
|
|
||||||
-> Expression -- ^ A Haskell expression.
|
|
||||||
-> IO String
|
|
||||||
infoExpr opt cradle file expr = runGhcMod opt $ do
|
|
||||||
initializeFlagsWithCradle opt cradle
|
|
||||||
info file expr
|
|
||||||
|
|
||||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
-- | Obtaining information of a target expression. (GHCi's info:)
|
||||||
info :: FilePath -- ^ A target file.
|
info :: FilePath -- ^ A target file.
|
||||||
-> Expression -- ^ A Haskell expression.
|
-> Expression -- ^ A Haskell expression.
|
||||||
@ -48,17 +35,6 @@ info file expr = do
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
|
||||||
typeExpr :: Options
|
|
||||||
-> Cradle
|
|
||||||
-> FilePath -- ^ A target file.
|
|
||||||
-> Int -- ^ Line number.
|
|
||||||
-> Int -- ^ Column number.
|
|
||||||
-> IO String
|
|
||||||
typeExpr opt cradle file lineNo colNo = runGhcMod opt $ do
|
|
||||||
initializeFlagsWithCradle opt cradle
|
|
||||||
types file lineNo colNo
|
|
||||||
|
|
||||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
-- | Obtaining type of a target expression. (GHCi's type:)
|
||||||
types :: FilePath -- ^ A target file.
|
types :: FilePath -- ^ A target file.
|
||||||
-> Int -- ^ Line number.
|
-> Int -- ^ Line number.
|
||||||
@ -85,4 +61,3 @@ getSrcSpanType modSum lineNo colNo = do
|
|||||||
ets <- mapM (getType tcm) es
|
ets <- mapM (getType tcm) es
|
||||||
pts <- mapM (getType tcm) ps
|
pts <- mapM (getType tcm) ps
|
||||||
return $ catMaybes $ concat [ets, bts, pts]
|
return $ catMaybes $ concat [ets, bts, pts]
|
||||||
|
|
||||||
|
@ -16,8 +16,9 @@ module Language.Haskell.GhcMod.Internal (
|
|||||||
, cabalDependPackages
|
, cabalDependPackages
|
||||||
, cabalSourceDirs
|
, cabalSourceDirs
|
||||||
, cabalAllTargets
|
, cabalAllTargets
|
||||||
|
-- * GHC.Paths
|
||||||
|
, systemLibDir
|
||||||
-- * IO
|
-- * IO
|
||||||
, getSystemLibDir
|
|
||||||
, getDynamicFlags
|
, getDynamicFlags
|
||||||
-- * Initializing 'DynFlags'
|
-- * Initializing 'DynFlags'
|
||||||
, initializeFlagsWithCradle
|
, initializeFlagsWithCradle
|
||||||
|
@ -1,10 +1,10 @@
|
|||||||
module Language.Haskell.GhcMod.Lang where
|
module Language.Haskell.GhcMod.Lang where
|
||||||
|
|
||||||
import DynFlags (supportedLanguagesAndExtensions)
|
import DynFlags (supportedLanguagesAndExtensions)
|
||||||
import Language.Haskell.GhcMod.Types
|
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
|
import Language.Haskell.GhcMod.Monad
|
||||||
|
|
||||||
-- | Listing language extensions.
|
-- | Listing language extensions.
|
||||||
|
|
||||||
listLanguages :: Options -> IO String
|
languages :: GhcMod String
|
||||||
listLanguages opt = return $ convert opt supportedLanguagesAndExtensions
|
languages = convert' supportedLanguagesAndExtensions
|
||||||
|
@ -1,19 +1,21 @@
|
|||||||
module Language.Haskell.GhcMod.Lint where
|
module Language.Haskell.GhcMod.Lint where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Exception (ghandle)
|
||||||
import Control.Exception (handle, SomeException(..))
|
import Control.Exception (SomeException(..))
|
||||||
|
import Control.Monad.Trans (liftIO)
|
||||||
import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
|
import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Language.Haskell.HLint (hlint)
|
import Language.Haskell.HLint (hlint)
|
||||||
|
|
||||||
-- | Checking syntax of a target file using hlint.
|
-- | Checking syntax of a target file using hlint.
|
||||||
-- Warnings and errors are returned.
|
-- Warnings and errors are returned.
|
||||||
lintSyntax :: Options
|
lint :: FilePath -- ^ A target file.
|
||||||
-> FilePath -- ^ A target file.
|
-> GhcMod String
|
||||||
-> IO String
|
lint file = do
|
||||||
lintSyntax opt file = handle handler $ pack <$> hlint (file : "--quiet" : hopts)
|
opt <- options
|
||||||
where
|
ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
|
||||||
pack = convert opt . map (init . show) -- init drops the last \n.
|
where
|
||||||
hopts = hlintOpts opt
|
pack = convert' . map (init . show) -- init drops the last \n.
|
||||||
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"
|
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
module Language.Haskell.GhcMod.List (listModules, modules) where
|
module Language.Haskell.GhcMod.List (modules) where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception (SomeException(..))
|
import Control.Exception (SomeException(..))
|
||||||
@ -12,10 +12,6 @@ import UniqFM (eltsUFM)
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Listing installed modules.
|
|
||||||
listModules :: Options -> Cradle -> IO String
|
|
||||||
listModules opt _ = runGhcMod opt $ modules
|
|
||||||
|
|
||||||
-- | Listing installed modules.
|
-- | Listing installed modules.
|
||||||
modules :: GhcMod String
|
modules :: GhcMod String
|
||||||
modules = do
|
modules = do
|
||||||
|
@ -13,6 +13,7 @@ module Language.Haskell.GhcMod.Monad (
|
|||||||
, withErrorHandler
|
, withErrorHandler
|
||||||
, toGhcMod
|
, toGhcMod
|
||||||
, options
|
, options
|
||||||
|
, cradle
|
||||||
, module Control.Monad.Reader.Class
|
, module Control.Monad.Reader.Class
|
||||||
, module Control.Monad.Writer.Class
|
, module Control.Monad.Writer.Class
|
||||||
, module Control.Monad.State.Class
|
, module Control.Monad.State.Class
|
||||||
@ -103,11 +104,11 @@ runGhcMod' r s a = do
|
|||||||
newGhcModEnv :: Options -> FilePath -> IO GhcModEnv
|
newGhcModEnv :: Options -> FilePath -> IO GhcModEnv
|
||||||
newGhcModEnv opt dir = do
|
newGhcModEnv opt dir = do
|
||||||
session <- newIORef (error "empty session")
|
session <- newIORef (error "empty session")
|
||||||
cradle <- findCradle' dir
|
c <- findCradle' dir
|
||||||
return GhcModEnv {
|
return GhcModEnv {
|
||||||
gmGhcSession = session
|
gmGhcSession = session
|
||||||
, gmOptions = opt
|
, gmOptions = opt
|
||||||
, gmCradle = cradle
|
, gmCradle = c
|
||||||
}
|
}
|
||||||
|
|
||||||
runGhcMod :: Options -> GhcMod a -> IO a
|
runGhcMod :: Options -> GhcMod a -> IO a
|
||||||
@ -142,6 +143,9 @@ toGhcMod a = do
|
|||||||
options :: GhcMod Options
|
options :: GhcMod Options
|
||||||
options = gmOptions <$> ask
|
options = gmOptions <$> ask
|
||||||
|
|
||||||
|
cradle :: GhcMod Cradle
|
||||||
|
cradle = gmCradle <$> ask
|
||||||
|
|
||||||
instance MonadBase IO GhcMod where
|
instance MonadBase IO GhcMod where
|
||||||
liftBase = GhcMod . liftBase
|
liftBase = GhcMod . liftBase
|
||||||
|
|
||||||
|
@ -1,30 +1,26 @@
|
|||||||
module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
|
module Language.Haskell.GhcMod.PkgDoc (pkgDoc) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans (liftIO)
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Language.Haskell.GhcMod.GhcPkg
|
import Language.Haskell.GhcMod.GhcPkg
|
||||||
|
import Language.Haskell.GhcMod.Monad
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import System.Process (readProcess)
|
import System.Process (readProcess)
|
||||||
|
|
||||||
-- | Obtaining the package name and the doc path of a module.
|
-- | Obtaining the package name and the doc path of a module.
|
||||||
packageDoc :: Options
|
pkgDoc :: String -> GhcMod String
|
||||||
-> Cradle
|
pkgDoc mdl = cradle >>= \c -> liftIO $ do
|
||||||
-> ModuleString
|
pkg <- trim <$> readProcess "ghc-pkg" (toModuleOpts c) []
|
||||||
-> IO String
|
|
||||||
packageDoc _ cradle mdl = pkgDoc cradle mdl
|
|
||||||
|
|
||||||
pkgDoc :: Cradle -> String -> IO String
|
|
||||||
pkgDoc cradle mdl = do
|
|
||||||
pkg <- trim <$> readProcess "ghc-pkg" toModuleOpts []
|
|
||||||
if pkg == "" then
|
if pkg == "" then
|
||||||
return "\n"
|
return "\n"
|
||||||
else do
|
else do
|
||||||
htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg) []
|
htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg c) []
|
||||||
let ret = pkg ++ " " ++ drop 14 htmlpath
|
let ret = pkg ++ " " ++ drop 14 htmlpath
|
||||||
return ret
|
return ret
|
||||||
where
|
where
|
||||||
toModuleOpts = ["find-module", mdl, "--simple-output"]
|
toModuleOpts c = ["find-module", mdl, "--simple-output"]
|
||||||
++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
|
++ ghcPkgDbStackOpts (cradlePkgDbStack c)
|
||||||
toDocDirOpts pkg = ["field", pkg, "haddock-html"]
|
toDocDirOpts pkg c = ["field", pkg, "haddock-html"]
|
||||||
++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
|
++ ghcPkgDbStackOpts (cradlePkgDbStack c)
|
||||||
trim = takeWhile (`notElem` " \n")
|
trim = takeWhile (`notElem` " \n")
|
||||||
|
@ -120,6 +120,7 @@ Executable ghc-mod
|
|||||||
Build-Depends: base >= 4.0 && < 5
|
Build-Depends: base >= 4.0 && < 5
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
|
, mtl >= 2.0
|
||||||
, ghc
|
, ghc
|
||||||
, ghc-mod
|
, ghc-mod
|
||||||
|
|
||||||
|
@ -5,6 +5,7 @@ module Main where
|
|||||||
import Config (cProjectVersion)
|
import Config (cProjectVersion)
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception (Exception, Handler(..), ErrorCall(..))
|
import Control.Exception (Exception, Handler(..), ErrorCall(..))
|
||||||
|
import Control.Monad.Trans (liftIO)
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
import Data.Version (showVersion)
|
import Data.Version (showVersion)
|
||||||
@ -102,7 +103,6 @@ main = flip E.catches handlers $ do
|
|||||||
-- #endif
|
-- #endif
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
let (opt,cmdArg) = parseArgs argspec args
|
let (opt,cmdArg) = parseArgs argspec args
|
||||||
cradle <- findCradle
|
|
||||||
let cmdArg0 = cmdArg !. 0
|
let cmdArg0 = cmdArg !. 0
|
||||||
cmdArg1 = cmdArg !. 1
|
cmdArg1 = cmdArg !. 1
|
||||||
cmdArg3 = cmdArg !. 3
|
cmdArg3 = cmdArg !. 3
|
||||||
@ -111,23 +111,23 @@ main = flip E.catches handlers $ do
|
|||||||
nArgs n f = if length remainingArgs == n
|
nArgs n f = if length remainingArgs == n
|
||||||
then f
|
then f
|
||||||
else E.throw (ArgumentsMismatch cmdArg0)
|
else E.throw (ArgumentsMismatch cmdArg0)
|
||||||
res <- case cmdArg0 of
|
res <- runGhcMod opt $ case cmdArg0 of
|
||||||
"list" -> listModules opt cradle
|
"list" -> modules
|
||||||
"lang" -> listLanguages opt
|
"lang" -> languages
|
||||||
"flag" -> listFlags opt
|
"flag" -> flags
|
||||||
"browse" -> runGhcMod opt $ concat <$> mapM browse remainingArgs
|
"browse" -> concat <$> mapM browse remainingArgs
|
||||||
"check" -> runGhcMod opt $ checkSyntax remainingArgs
|
"check" -> checkSyntax remainingArgs
|
||||||
"expand" -> runGhcMod opt $ expandTemplate remainingArgs
|
"expand" -> expandTemplate remainingArgs
|
||||||
"debug" -> debugInfo opt cradle
|
"debug" -> debugInfo
|
||||||
"info" -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg3
|
"info" -> nArgs 3 info cmdArg1 cmdArg3
|
||||||
"type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
|
"type" -> nArgs 4 $ types cmdArg1 (read cmdArg3) (read cmdArg4)
|
||||||
"split" -> nArgs 4 $ splitVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
|
"split" -> nArgs 4 $ splits cmdArg1 (read cmdArg3) (read cmdArg4)
|
||||||
"sig" -> nArgs 4 $ fillSig opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
|
"sig" -> nArgs 4 $ sig cmdArg1 (read cmdArg3) (read cmdArg4)
|
||||||
"find" -> runGhcMod opt $ nArgs 1 $ findSymbol cmdArg1
|
"find" -> nArgs 1 $ findSymbol cmdArg1
|
||||||
"lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1
|
"lint" -> nArgs 1 $ withFile lint cmdArg1
|
||||||
"root" -> rootInfo opt cradle
|
"root" -> rootInfo
|
||||||
"doc" -> nArgs 1 $ packageDoc opt cradle cmdArg1
|
"doc" -> nArgs 1 $ pkgDoc cmdArg1
|
||||||
"boot" -> bootInfo opt
|
"boot" -> boot
|
||||||
"version" -> return progVersion
|
"version" -> return progVersion
|
||||||
"help" -> return $ O.usageInfo usage argspec
|
"help" -> return $ O.usageInfo usage argspec
|
||||||
cmd -> E.throw (NoSuchCommand cmd)
|
cmd -> E.throw (NoSuchCommand cmd)
|
||||||
@ -152,8 +152,9 @@ main = flip E.catches handlers $ do
|
|||||||
hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
|
hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
|
||||||
printUsage
|
printUsage
|
||||||
printUsage = hPutStrLn stderr $ '\n' : O.usageInfo usage argspec
|
printUsage = hPutStrLn stderr $ '\n' : O.usageInfo usage argspec
|
||||||
|
withFile :: (FilePath -> GhcMod a) -> FilePath -> GhcMod a
|
||||||
withFile cmd file = do
|
withFile cmd file = do
|
||||||
exist <- doesFileExist file
|
exist <- liftIO $ doesFileExist file
|
||||||
if exist
|
if exist
|
||||||
then cmd file
|
then cmd file
|
||||||
else E.throw (FileNotExist file)
|
else E.throw (FileNotExist file)
|
||||||
|
@ -31,12 +31,12 @@ import Data.Set (Set)
|
|||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
import Data.Version (showVersion)
|
import Data.Version (showVersion)
|
||||||
|
import Exception (ghandle)
|
||||||
import GHC (GhcMonad)
|
import GHC (GhcMonad)
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Language.Haskell.GhcMod.Ghc
|
import Language.Haskell.GhcMod.Ghc
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Internal
|
|
||||||
import Paths_ghc_mod
|
import Paths_ghc_mod
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
import System.Directory (setCurrentDirectory)
|
import System.Directory (setCurrentDirectory)
|
||||||
@ -98,12 +98,11 @@ main = E.handle cmdHandler $
|
|||||||
go (opt,_) = E.handle someHandler $ do
|
go (opt,_) = E.handle someHandler $ do
|
||||||
cradle0 <- findCradle
|
cradle0 <- findCradle
|
||||||
let rootdir = cradleRootDir cradle0
|
let rootdir = cradleRootDir cradle0
|
||||||
cradle = cradle0 { cradleCurrentDir = rootdir }
|
-- c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
|
||||||
setCurrentDirectory rootdir
|
setCurrentDirectory rootdir
|
||||||
mvar <- liftIO newEmptyMVar
|
mvar <- liftIO newEmptyMVar
|
||||||
mlibdir <- getSystemLibDir
|
void $ forkIO $ runGhcMod opt $ setupDB mvar
|
||||||
void $ forkIO $ setupDB cradle mlibdir opt mvar
|
runGhcMod opt $ loop S.empty mvar
|
||||||
run cradle mlibdir opt $ loop opt S.empty mvar
|
|
||||||
where
|
where
|
||||||
-- this is just in case.
|
-- this is just in case.
|
||||||
-- If an error is caught here, it is a bug of GhcMod library.
|
-- If an error is caught here, it is a bug of GhcMod library.
|
||||||
@ -117,31 +116,23 @@ replace (x:xs) = x : replace xs
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
run :: Cradle -> Maybe FilePath -> Options -> GhcMod a -> IO a
|
setupDB :: MVar SymMdlDb -> GhcMod ()
|
||||||
run _ _ opt body = runGhcMod opt $ do
|
setupDB mvar = ghandle handler $ do
|
||||||
dflags <- G.getSessionDynFlags
|
liftIO . putMVar mvar =<< getSymMdlDb
|
||||||
G.defaultCleanupHandler dflags body
|
|
||||||
|
|
||||||
----------------------------------------------------------------
|
|
||||||
|
|
||||||
setupDB :: Cradle -> Maybe FilePath -> Options -> MVar SymMdlDb -> IO ()
|
|
||||||
setupDB cradle mlibdir opt mvar = E.handle handler $ do
|
|
||||||
db <- run cradle mlibdir opt getSymMdlDb
|
|
||||||
putMVar mvar db
|
|
||||||
where
|
where
|
||||||
handler (SomeException _) = return () -- fixme: put emptyDb?
|
handler (SomeException _) = return () -- fixme: put emptyDb?
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
loop :: Options -> Set FilePath -> MVar SymMdlDb -> GhcMod ()
|
loop :: Set FilePath -> MVar SymMdlDb -> GhcMod ()
|
||||||
loop opt set mvar = do
|
loop set mvar = do
|
||||||
cmdArg <- liftIO getLine
|
cmdArg <- liftIO getLine
|
||||||
let (cmd,arg') = break (== ' ') cmdArg
|
let (cmd,arg') = break (== ' ') cmdArg
|
||||||
arg = dropWhile (== ' ') arg'
|
arg = dropWhile (== ' ') arg'
|
||||||
(ret,ok,set') <- case cmd of
|
(ret,ok,set') <- case cmd of
|
||||||
"check" -> checkStx opt set arg
|
"check" -> checkStx set arg
|
||||||
"find" -> findSym set arg mvar
|
"find" -> findSym set arg mvar
|
||||||
"lint" -> toGhcMod $ lintStx opt set arg
|
"lint" -> lintStx set arg
|
||||||
"info" -> showInfo set arg
|
"info" -> showInfo set arg
|
||||||
"type" -> showType set arg
|
"type" -> showType set arg
|
||||||
"split" -> doSplit set arg
|
"split" -> doSplit set arg
|
||||||
@ -157,15 +148,14 @@ loop opt set mvar = do
|
|||||||
else do
|
else do
|
||||||
liftIO $ putStrLn $ "NG " ++ replace ret
|
liftIO $ putStrLn $ "NG " ++ replace ret
|
||||||
liftIO $ hFlush stdout
|
liftIO $ hFlush stdout
|
||||||
when ok $ loop opt set' mvar
|
when ok $ loop set' mvar
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
checkStx :: Options
|
checkStx :: Set FilePath
|
||||||
-> Set FilePath
|
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> GhcMod (String, Bool, Set FilePath)
|
-> GhcMod (String, Bool, Set FilePath)
|
||||||
checkStx _ set file = do
|
checkStx set file = do
|
||||||
set' <- toGhcMod $ newFileSet set file
|
set' <- toGhcMod $ newFileSet set file
|
||||||
let files = S.toList set'
|
let files = S.toList set'
|
||||||
eret <- check files
|
eret <- check files
|
||||||
@ -209,16 +199,17 @@ findSym set sym mvar = do
|
|||||||
let ret = lookupSym' opt sym db
|
let ret = lookupSym' opt sym db
|
||||||
return (ret, True, set)
|
return (ret, True, set)
|
||||||
|
|
||||||
lintStx :: GhcMonad m
|
lintStx :: Set FilePath
|
||||||
=> Options -> Set FilePath -> FilePath
|
-> FilePath
|
||||||
-> m (String, Bool, Set FilePath)
|
-> GhcMod (String, Bool, Set FilePath)
|
||||||
lintStx opt set optFile = liftIO $ do
|
lintStx set optFile = do
|
||||||
ret <-lintSyntax opt' file
|
ret <- local env' $ lint file
|
||||||
return (ret, True, set)
|
return (ret, True, set)
|
||||||
where
|
where
|
||||||
(opts,file) = parseLintOptions optFile
|
(opts,file) = parseLintOptions optFile
|
||||||
hopts = if opts == "" then [] else read opts
|
hopts = if opts == "" then [] else read opts
|
||||||
opt' = opt { hlintOpts = hopts }
|
env' e = e { gmOptions = opt' $ gmOptions e }
|
||||||
|
opt' o = o { hlintOpts = hopts }
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
|
-- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
|
||||||
|
@ -10,25 +10,25 @@ import Dir
|
|||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "browse" $ do
|
describe "browse Data.Map" $ do
|
||||||
it "lists up symbols in the module" $ do
|
it "contains at least `differenceWithKey'" $ do
|
||||||
syms <- runD $ lines <$> browse "Data.Map"
|
syms <- runD $ lines <$> browse "Data.Map"
|
||||||
syms `shouldContain` ["differenceWithKey"]
|
syms `shouldContain` ["differenceWithKey"]
|
||||||
|
|
||||||
describe "browse -d" $ do
|
describe "browse -d Data.Either" $ do
|
||||||
it "lists up symbols with type info in the module" $ do
|
it "contains functions (e.g. `either') including their type signature" $ do
|
||||||
syms <- run defaultOptions { detailed = True }
|
syms <- run defaultOptions { detailed = True }
|
||||||
$ lines <$> browse "Data.Either"
|
$ lines <$> browse "Data.Either"
|
||||||
syms `shouldContain` ["either :: (a -> c) -> (b -> c) -> Either a b -> c"]
|
syms `shouldContain` ["either :: (a -> c) -> (b -> c) -> Either a b -> c"]
|
||||||
|
|
||||||
it "lists up data constructors with type info in the module" $ do
|
it "contains type constructors (e.g. `Left') including their type signature" $ do
|
||||||
cradle <- findCradle
|
cradle <- findCradle
|
||||||
syms <- run defaultOptions { detailed = True}
|
syms <- run defaultOptions { detailed = True}
|
||||||
$ lines <$> browse "Data.Either"
|
$ lines <$> browse "Data.Either"
|
||||||
syms `shouldContain` ["Left :: a -> Either a b"]
|
syms `shouldContain` ["Left :: a -> Either a b"]
|
||||||
|
|
||||||
describe "browse local" $ do
|
describe "`browse' in a project directory" $ do
|
||||||
it "lists symbols in a local module" $ do
|
it "lists symbols defined in a a local module (e.g. `Baz.baz)" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
syms <- runID $ lines <$> browse "Baz"
|
syms <- runID $ lines <$> browse "Baz"
|
||||||
syms `shouldContain` ["baz"]
|
syms `shouldContain` ["baz"]
|
||||||
|
@ -12,28 +12,28 @@ import Dir
|
|||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "checkSyntax" $ do
|
describe "checkSyntax" $ do
|
||||||
it "can check even if an executable depends on its library" $ do
|
it "works even if an executable depends on the library defined in the same cabal file" $ do
|
||||||
withDirectory_ "test/data/ghc-mod-check" $ do
|
withDirectory_ "test/data/ghc-mod-check" $ do
|
||||||
res <- runID $ checkSyntax ["main.hs"]
|
res <- runID $ checkSyntax ["main.hs"]
|
||||||
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
|
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
|
||||||
|
|
||||||
it "can check even if a test module imports another test module located at different directory" $ do
|
it "works even if a module imports another module from a different directory" $ do
|
||||||
withDirectory_ "test/data/check-test-subdir" $ do
|
withDirectory_ "test/data/check-test-subdir" $ do
|
||||||
res <- runID $ checkSyntax ["test/Bar/Baz.hs"]
|
res <- runID $ checkSyntax ["test/Bar/Baz.hs"]
|
||||||
res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
|
res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
|
||||||
|
|
||||||
it "can detect mutually imported modules" $ do
|
it "detects cyclic imports" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
res <- runID $ checkSyntax ["Mutual1.hs"]
|
res <- runID $ checkSyntax ["Mutual1.hs"]
|
||||||
res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
|
res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
|
||||||
|
|
||||||
it "can check a module using QuasiQuotes" $ do
|
it "works with modules using QuasiQuotes" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
res <- runID $ checkSyntax ["Baz.hs"]
|
res <- runID $ checkSyntax ["Baz.hs"]
|
||||||
res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
|
res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
|
||||||
|
|
||||||
context "without errors" $ do
|
context "when no errors are found" $ do
|
||||||
it "doesn't output empty line" $ do
|
it "doesn't output an empty line" $ do
|
||||||
withDirectory_ "test/data/ghc-mod-check/Data" $ do
|
withDirectory_ "test/data/ghc-mod-check/Data" $ do
|
||||||
res <- runID $ checkSyntax ["Foo.hs"]
|
res <- runID $ checkSyntax ["Foo.hs"]
|
||||||
res `shouldBe` ""
|
res `shouldBe` ""
|
||||||
|
@ -3,10 +3,11 @@ module FlagSpec where
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import TestUtils
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "listFlags" $ do
|
describe "flags" $ do
|
||||||
it "lists up GHC flags" $ do
|
it "contains at least `-fno-warn-orphans'" $ do
|
||||||
flags <- lines <$> listFlags defaultOptions
|
f <- runD $ lines <$> flags
|
||||||
flags `shouldContain` ["-fno-warn-orphans"]
|
f `shouldContain` ["-fno-warn-orphans"]
|
||||||
|
@ -18,10 +18,10 @@ spec = do
|
|||||||
getPackageDbStack "test/data/" `shouldReturn` [GlobalDb, PackageDb $ cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
|
getPackageDbStack "test/data/" `shouldReturn` [GlobalDb, PackageDb $ cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
it "parses a config file and extracts sandbox package db" $ do
|
it "can parse a config file and extract the sandbox package-db" $ do
|
||||||
cwd <- getCurrentDirectory
|
cwd <- getCurrentDirectory
|
||||||
pkgDb <- getSandboxDb "test/data/"
|
pkgDb <- getSandboxDb "test/data/"
|
||||||
pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
|
pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
|
||||||
|
|
||||||
it "throws an error if a config file is broken" $ do
|
it "throws an error if the sandbox config file is broken" $ do
|
||||||
getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException
|
getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException
|
||||||
|
@ -14,47 +14,47 @@ import System.Exit
|
|||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Process
|
import System.Process
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import TestUtils
|
||||||
import Dir
|
import Dir
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "typeExpr" $ do
|
describe "types" $ do
|
||||||
it "shows types of the expression and its outers" $ do
|
it "shows types of the expression and its outers" $ do
|
||||||
withDirectory_ "test/data/ghc-mod-check" $ do
|
withDirectory_ "test/data/ghc-mod-check" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- typeExpr defaultOptions cradle "Data/Foo.hs" 9 5
|
res <- runD $ types "Data/Foo.hs" 9 5
|
||||||
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||||
|
|
||||||
it "works with a module using TemplateHaskell" $ do
|
it "works with a module using TemplateHaskell" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- typeExpr defaultOptions cradle "Bar.hs" 5 1
|
res <- runD $ types "Bar.hs" 5 1
|
||||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||||
|
|
||||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- typeExpr defaultOptions cradle "Main.hs" 3 8
|
res <- runD $ types "Main.hs" 3 8
|
||||||
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
||||||
|
|
||||||
describe "infoExpr" $ do
|
describe "info" $ do
|
||||||
it "works for non-export functions" $ do
|
it "works for non-export functions" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- infoExpr defaultOptions cradle "Info.hs" "fib"
|
res <- runD $ info "Info.hs" "fib"
|
||||||
res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
|
res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
|
||||||
|
|
||||||
it "works with a module using TemplateHaskell" $ do
|
it "works with a module using TemplateHaskell" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- infoExpr defaultOptions cradle "Bar.hs" "foo"
|
res <- runD $ info "Bar.hs" "foo"
|
||||||
res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
|
res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
|
||||||
|
|
||||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||||
withDirectory_ "test/data" $ do
|
withDirectory_ "test/data" $ do
|
||||||
cradle <- findCradleWithoutSandbox
|
cradle <- findCradleWithoutSandbox
|
||||||
res <- infoExpr defaultOptions cradle "Main.hs" "bar"
|
res <- runD $ info "Main.hs" "bar"
|
||||||
res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
|
res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
|
||||||
|
|
||||||
it "doesn't fail on unicode output" $ do
|
it "doesn't fail on unicode output" $ do
|
||||||
|
@ -3,10 +3,11 @@ module LangSpec where
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import TestUtils
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "listLanguages" $ do
|
describe "languages" $ do
|
||||||
it "lists up language extensions" $ do
|
it "contains at lest `OverloadedStrings'" $ do
|
||||||
exts <- lines <$> listLanguages defaultOptions
|
exts <- runD $ lines <$> languages
|
||||||
exts `shouldContain` ["OverloadedStrings"]
|
exts `shouldContain` ["OverloadedStrings"]
|
||||||
|
@ -2,15 +2,16 @@ module LintSpec where
|
|||||||
|
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import TestUtils
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "lintSyntax" $ do
|
describe "lint" $ do
|
||||||
it "check syntax with HLint" $ do
|
it "can detect a redundant import" $ do
|
||||||
res <- lintSyntax defaultOptions "test/data/hlint.hs"
|
res <- runD $ lint "test/data/hlint.hs"
|
||||||
res `shouldBe` "test/data/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n"
|
res `shouldBe` "test/data/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n"
|
||||||
|
|
||||||
context "without suggestions" $ do
|
context "when no suggestions are given" $ do
|
||||||
it "doesn't output empty line" $ do
|
it "doesn't output an empty line" $ do
|
||||||
res <- lintSyntax defaultOptions "test/data/ghc-mod-check/Data/Foo.hs"
|
res <- runD $ lint "test/data/ghc-mod-check/Data/Foo.hs"
|
||||||
res `shouldBe` ""
|
res `shouldBe` ""
|
||||||
|
@ -3,11 +3,11 @@ module ListSpec where
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import TestUtils
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "listModules" $ do
|
describe "modules" $ do
|
||||||
it "lists up module names" $ do
|
it "contains at least `Data.Map'" $ do
|
||||||
cradle <- findCradle
|
modules <- runD $ lines <$> modules
|
||||||
modules <- lines <$> listModules defaultOptions cradle
|
|
||||||
modules `shouldContain` ["Data.Map"]
|
modules `shouldContain` ["Data.Map"]
|
||||||
|
@ -7,6 +7,7 @@ import System.Process
|
|||||||
|
|
||||||
import Language.Haskell.GhcMod (debugInfo, defaultOptions, findCradle)
|
import Language.Haskell.GhcMod (debugInfo, defaultOptions, findCradle)
|
||||||
import Control.Exception as E
|
import Control.Exception as E
|
||||||
|
import TestUtils
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
let sandboxes = [ "test/data", "test/data/check-packageid"
|
let sandboxes = [ "test/data", "test/data/check-packageid"
|
||||||
@ -25,7 +26,7 @@ main = do
|
|||||||
putStrLn $ "ghc-mod was built with Cabal version " ++ VERSION_Cabal
|
putStrLn $ "ghc-mod was built with Cabal version " ++ VERSION_Cabal
|
||||||
system "ghc --version"
|
system "ghc --version"
|
||||||
|
|
||||||
(putStrLn =<< debugInfo defaultOptions =<< findCradle)
|
(putStrLn =<< runD debugInfo)
|
||||||
`E.catch` (\(_ :: E.SomeException) -> return () )
|
`E.catch` (\(_ :: E.SomeException) -> return () )
|
||||||
|
|
||||||
hspec spec
|
hspec spec
|
||||||
|
Loading…
Reference in New Issue
Block a user