Use GhcModT everywhere and remove the GhcMod alias
Not doing this makes having GhcModT pretty pointless as users of the library wouldn't be able to use custom inner monads as evey function for dealing with GhcModT's would be constraint to (GhcModT IO) thus only allowing IO as the inner monad.
This commit is contained in:
parent
b6896a481a
commit
f0bfcb8811
@ -8,7 +8,7 @@ import Language.Haskell.GhcMod.List
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
|
||||
-- | Printing necessary information for front-end booting.
|
||||
boot :: GhcMod String
|
||||
boot :: IOish m => GhcModT m String
|
||||
boot = concat <$> sequence [modules, languages, flags,
|
||||
concat <$> mapM browse preBrowsedModules]
|
||||
|
||||
|
@ -28,8 +28,9 @@ import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy)
|
||||
-- | Getting functions, classes, etc from a module.
|
||||
-- If 'detailed' is 'True', their types are also obtained.
|
||||
-- If 'operators' is 'True', operators are also returned.
|
||||
browse :: ModuleString -- ^ A module name. (e.g. \"Data.List\")
|
||||
-> GhcMod String
|
||||
browse :: IOish m
|
||||
=> ModuleString -- ^ A module name. (e.g. \"Data.List\")
|
||||
-> GhcModT m String
|
||||
browse pkgmdl = convert' . sort =<< (listExports =<< getModule)
|
||||
where
|
||||
(mpkg,mdl) = splitPkgMdl pkgmdl
|
||||
@ -61,7 +62,7 @@ splitPkgMdl pkgmdl = case break (==':') pkgmdl of
|
||||
(mdl,"") -> (Nothing,mdl)
|
||||
(pkg,_:mdl) -> (Just pkg,mdl)
|
||||
|
||||
processExports :: ModuleInfo -> GhcMod [String]
|
||||
processExports :: IOish m => ModuleInfo -> GhcModT m [String]
|
||||
processExports minfo = do
|
||||
opt <- options
|
||||
let
|
||||
@ -70,13 +71,13 @@ processExports minfo = do
|
||||
| otherwise = filter (isAlpha . head . getOccString)
|
||||
mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo
|
||||
|
||||
showExport :: Options -> ModuleInfo -> Name -> GhcMod String
|
||||
showExport :: IOish m => Options -> ModuleInfo -> Name -> GhcModT m String
|
||||
showExport opt minfo e = do
|
||||
mtype' <- mtype
|
||||
return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype']
|
||||
where
|
||||
mqualified = (G.moduleNameString (G.moduleName $ G.nameModule e) ++ ".") `justIf` qualified opt
|
||||
mtype :: GhcMod (Maybe String)
|
||||
mtype :: IOish m => GhcModT m (Maybe String)
|
||||
mtype
|
||||
| detailed opt = do
|
||||
tyInfo <- G.modInfoLookupName minfo e
|
||||
@ -91,7 +92,7 @@ showExport opt minfo e = do
|
||||
| isAlpha n = nm
|
||||
| otherwise = "(" ++ nm ++ ")"
|
||||
formatOp "" = error "formatOp"
|
||||
inOtherModule :: Name -> GhcMod (Maybe TyThing)
|
||||
inOtherModule :: IOish m => Name -> GhcModT m (Maybe TyThing)
|
||||
inOtherModule nm = G.getModuleInfo (G.nameModule nm) >> G.lookupGlobalName nm
|
||||
justIf :: a -> Bool -> Maybe a
|
||||
justIf x True = Just x
|
||||
@ -138,7 +139,7 @@ showOutputable dflag = unwords . lines . showPage dflag styleUnqualified . ppr
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Browsing all functions in all system/user modules.
|
||||
browseAll :: DynFlags -> GhcMod [(String,String)]
|
||||
browseAll :: IOish m => DynFlags -> GhcModT m [(String,String)]
|
||||
browseAll dflag = do
|
||||
ms <- G.packageDbModules True
|
||||
is <- mapM G.getModuleInfo ms
|
||||
|
@ -33,10 +33,11 @@ data SplitToTextInfo = SplitToTextInfo { sVarName :: String
|
||||
}
|
||||
|
||||
-- | Splitting a variable in a equation.
|
||||
splits :: FilePath -- ^ A target file.
|
||||
splits :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> GhcMod String
|
||||
-> GhcModT m String
|
||||
splits file lineNo colNo = ghandle handler body
|
||||
where
|
||||
body = inModuleContext file $ \dflag style -> do
|
||||
|
@ -15,8 +15,9 @@ import Language.Haskell.GhcMod.Monad
|
||||
|
||||
-- | Checking syntax of a target file using GHC.
|
||||
-- Warnings and errors are returned.
|
||||
checkSyntax :: [FilePath] -- ^ The target files.
|
||||
-> GhcMod String
|
||||
checkSyntax :: IOish m
|
||||
=> [FilePath] -- ^ The target files.
|
||||
-> GhcModT m String
|
||||
checkSyntax [] = return ""
|
||||
checkSyntax files = withErrorHandler sessionName $ do
|
||||
either id id <$> check files
|
||||
@ -29,8 +30,9 @@ checkSyntax files = withErrorHandler sessionName $ do
|
||||
|
||||
-- | Checking syntax of a target file using GHC.
|
||||
-- Warnings and errors are returned.
|
||||
check :: [FilePath] -- ^ The target files.
|
||||
-> GhcMod (Either String String)
|
||||
check :: IOish m
|
||||
=> [FilePath] -- ^ The target files.
|
||||
-> GhcModT m (Either String String)
|
||||
check fileNames = do
|
||||
withLogger setAllWaringFlags $ do
|
||||
setTargetFiles fileNames
|
||||
@ -38,8 +40,9 @@ check fileNames = do
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Expanding Haskell Template.
|
||||
expandTemplate :: [FilePath] -- ^ The target files.
|
||||
-> GhcMod String
|
||||
expandTemplate :: IOish m
|
||||
=> [FilePath] -- ^ The target files.
|
||||
-> GhcModT m String
|
||||
expandTemplate [] = return ""
|
||||
expandTemplate files = withErrorHandler sessionName $ do
|
||||
either id id <$> expand files
|
||||
@ -51,7 +54,8 @@ expandTemplate files = withErrorHandler sessionName $ do
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Expanding Haskell Template.
|
||||
expand :: [FilePath] -- ^ The target files.
|
||||
-> GhcMod (Either String String)
|
||||
expand :: IOish m
|
||||
=> [FilePath] -- ^ The target files.
|
||||
-> GhcModT m (Either String String)
|
||||
expand fileNames = withLogger (Gap.setDumpSplices . setNoWaringFlags) $
|
||||
setTargetFiles fileNames
|
||||
|
@ -23,7 +23,7 @@ inter :: Char -> [Builder] -> Builder
|
||||
inter _ [] = id
|
||||
inter c bs = foldr1 (\x y -> x . (c:) . y) bs
|
||||
|
||||
convert' :: ToString a => a -> GhcMod String
|
||||
convert' :: (ToString a, IOish m) => a -> GhcModT m String
|
||||
convert' x = flip convert x <$> options
|
||||
|
||||
convert :: ToString a => Options -> a -> String
|
||||
|
@ -12,7 +12,7 @@ import Language.Haskell.GhcMod.Internal
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Obtaining debug information.
|
||||
debugInfo :: GhcMod String
|
||||
debugInfo :: IOish m => GhcModT m String
|
||||
debugInfo = cradle >>= \c -> convert' =<< do
|
||||
CompilerOptions gopts incDir pkgs <-
|
||||
if isJust $ cradleCabalFile c then
|
||||
@ -38,5 +38,5 @@ debugInfo = cradle >>= \c -> convert' =<< do
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Obtaining root information.
|
||||
rootInfo :: GhcMod String
|
||||
rootInfo :: IOish m => GhcModT m String
|
||||
rootInfo = convert' =<< cradleRootDir <$> cradle
|
||||
|
@ -38,10 +38,11 @@ data SigInfo = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName)
|
||||
data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo)
|
||||
|
||||
-- | Create a initial body from a signature.
|
||||
sig :: FilePath -- ^ A target file.
|
||||
sig :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> GhcMod String
|
||||
-> GhcModT m String
|
||||
sig file lineNo colNo = ghandle handler body
|
||||
where
|
||||
body = inModuleContext file $ \dflag style -> do
|
||||
|
@ -31,11 +31,11 @@ type Symbol = String
|
||||
newtype SymMdlDb = SymMdlDb (Map Symbol [ModuleString])
|
||||
|
||||
-- | Finding modules to which the symbol belong.
|
||||
findSymbol :: Symbol -> GhcMod String
|
||||
findSymbol :: IOish m => Symbol -> GhcModT m String
|
||||
findSymbol sym = convert' =<< lookupSym sym <$> getSymMdlDb
|
||||
|
||||
-- | Creating 'SymMdlDb'.
|
||||
getSymMdlDb :: GhcMod SymMdlDb
|
||||
getSymMdlDb :: IOish m => GhcModT m SymMdlDb
|
||||
getSymMdlDb = do
|
||||
sm <- G.getSessionDynFlags >>= browseAll
|
||||
#if MIN_VERSION_containers(0,5,0)
|
||||
|
@ -6,7 +6,7 @@ import Language.Haskell.GhcMod.Monad
|
||||
|
||||
-- | Listing GHC flags. (e.g -fno-warn-orphans)
|
||||
|
||||
flags :: GhcMod String
|
||||
flags :: IOish m => GhcModT m String
|
||||
flags = convert' [ "-f" ++ prefix ++ option
|
||||
| option <- Gap.fOptions
|
||||
, prefix <- ["","no-"]
|
||||
|
@ -21,9 +21,10 @@ import Language.Haskell.GhcMod.Convert
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
||||
info :: FilePath -- ^ A target file.
|
||||
info :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
-> Expression -- ^ A Haskell expression.
|
||||
-> GhcMod String
|
||||
-> GhcModT m String
|
||||
info file expr = do
|
||||
opt <- options
|
||||
convert opt <$> ghandle handler body
|
||||
@ -36,10 +37,11 @@ info file expr = do
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
||||
types :: FilePath -- ^ A target file.
|
||||
types :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> GhcMod String
|
||||
-> GhcModT m String
|
||||
types file lineNo colNo = do
|
||||
opt <- options
|
||||
convert opt <$> ghandle handler body
|
||||
|
@ -6,5 +6,5 @@ import Language.Haskell.GhcMod.Monad
|
||||
|
||||
-- | Listing language extensions.
|
||||
|
||||
languages :: GhcMod String
|
||||
languages :: IOish m => GhcModT m String
|
||||
languages = convert' supportedLanguagesAndExtensions
|
||||
|
@ -11,8 +11,9 @@ import Language.Haskell.HLint (hlint)
|
||||
|
||||
-- | Checking syntax of a target file using hlint.
|
||||
-- Warnings and errors are returned.
|
||||
lint :: FilePath -- ^ A target file.
|
||||
-> GhcMod String
|
||||
lint :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
-> GhcModT m String
|
||||
lint file = do
|
||||
opt <- options
|
||||
ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
|
||||
|
@ -13,7 +13,7 @@ import UniqFM (eltsUFM)
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Listing installed modules.
|
||||
modules :: GhcMod String
|
||||
modules :: IOish m => GhcModT m String
|
||||
modules = do
|
||||
opt <- options
|
||||
convert opt . (arrange opt) <$> (getModules `G.gcatch` handler)
|
||||
|
@ -34,7 +34,7 @@ newtype LogRef = LogRef (IORef Builder)
|
||||
newLogRef :: IO LogRef
|
||||
newLogRef = LogRef <$> newIORef id
|
||||
|
||||
readAndClearLogRef :: LogRef -> GhcMod String
|
||||
readAndClearLogRef :: IOish m => LogRef -> GhcModT m String
|
||||
readAndClearLogRef (LogRef ref) = do
|
||||
b <- liftIO $ readIORef ref
|
||||
liftIO $ writeIORef ref id
|
||||
@ -50,9 +50,10 @@ appendLogRef df (LogRef ref) _ sev src style msg = do
|
||||
-- | Set the session flag (e.g. "-Wall" or "-w:") then
|
||||
-- executes a body. Logged messages are returned as 'String'.
|
||||
-- Right is success and Left is failure.
|
||||
withLogger :: (DynFlags -> DynFlags)
|
||||
-> GhcMod ()
|
||||
-> GhcMod (Either String String)
|
||||
withLogger :: IOish m
|
||||
=> (DynFlags -> DynFlags)
|
||||
-> GhcModT m ()
|
||||
-> GhcModT m (Either String String)
|
||||
withLogger setDF body = ghandle sourceError $ do
|
||||
logref <- liftIO $ newLogRef
|
||||
wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
|
||||
@ -65,7 +66,7 @@ withLogger setDF body = ghandle sourceError $ do
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Converting 'SourceError' to 'String'.
|
||||
sourceError :: SourceError -> GhcMod (Either String String)
|
||||
sourceError :: IOish m => SourceError -> GhcModT m (Either String String)
|
||||
sourceError err = do
|
||||
dflags <- G.getSessionDynFlags
|
||||
style <- toGhcMod getStyle
|
||||
|
@ -4,13 +4,11 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Language.Haskell.GhcMod.Monad (
|
||||
GhcMod
|
||||
, GhcModT
|
||||
GhcModT
|
||||
, IOish
|
||||
, GhcModEnv(..)
|
||||
, GhcModWriter
|
||||
, GhcModState(..)
|
||||
, runGhcMod'
|
||||
, runGhcMod
|
||||
, runGhcModT'
|
||||
, runGhcModT
|
||||
, newGhcModEnv
|
||||
@ -60,7 +58,8 @@ import Control.Monad.Base (MonadBase, liftBase)
|
||||
import Control.Monad.Reader.Class
|
||||
import Control.Monad.State.Class
|
||||
import Control.Monad.Trans.Class
|
||||
import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, control, liftBaseOp, liftBaseOp_)
|
||||
import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith,
|
||||
control, liftBaseOp, liftBaseOp_)
|
||||
import Control.Monad.Trans.RWS.Lazy (RWST(..), runRWST)
|
||||
import Control.Monad.Writer.Class
|
||||
|
||||
@ -87,7 +86,7 @@ type GhcModWriter = ()
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
type GhcMod a = GhcModT IO a
|
||||
type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m)
|
||||
|
||||
newtype GhcModT m a = GhcModT {
|
||||
unGhcModT :: RWST GhcModEnv GhcModWriter GhcModState m a
|
||||
@ -155,7 +154,7 @@ initSession build Options {..} CompilerOptions {..} = do
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
runGhcModT' :: (MonadIO m, MonadBaseControl IO m)
|
||||
runGhcModT' :: IOish m
|
||||
=> GhcModEnv
|
||||
-> GhcModState
|
||||
-> GhcModT m a
|
||||
@ -174,7 +173,7 @@ newGhcModEnv opt dir = do
|
||||
, gmCradle = c
|
||||
}
|
||||
|
||||
runGhcModT :: (MonadIO m, MonadBaseControl IO m) => Options -> GhcModT m a -> m a
|
||||
runGhcModT :: IOish m => Options -> GhcModT m a -> m a
|
||||
runGhcModT opt action = do
|
||||
env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
|
||||
(a,(_,_)) <- runGhcModT' env defaultState $ do
|
||||
@ -183,41 +182,31 @@ runGhcModT opt action = do
|
||||
initializeFlagsWithCradle opt (gmCradle env)
|
||||
action
|
||||
return a
|
||||
|
||||
runGhcMod' :: GhcModEnv
|
||||
-> GhcModState
|
||||
-> GhcModT IO a
|
||||
-> IO (a,(GhcModState, GhcModWriter))
|
||||
runGhcMod' = runGhcModT'
|
||||
|
||||
runGhcMod :: Options -> GhcMod a -> IO a
|
||||
runGhcMod = runGhcModT
|
||||
----------------------------------------------------------------
|
||||
|
||||
withErrorHandler :: String -> GhcMod a -> GhcMod a
|
||||
withErrorHandler :: IOish m => String -> GhcModT m a -> GhcModT m a
|
||||
withErrorHandler label = ghandle ignore
|
||||
where
|
||||
ignore :: SomeException -> GhcMod a
|
||||
ignore :: IOish m => SomeException -> GhcModT m a
|
||||
ignore e = liftIO $ do
|
||||
hPutStr stderr $ label ++ ":0:0:Error:"
|
||||
hPrint stderr e
|
||||
exitSuccess
|
||||
|
||||
-- | This is only a transitional mechanism don't use it for new code.
|
||||
toGhcMod :: (Functor m, MonadIO m) => Ghc a -> GhcModT m a
|
||||
toGhcMod :: IOish m => Ghc a -> GhcModT m a
|
||||
toGhcMod a = do
|
||||
s <- gmGhcSession <$> ask
|
||||
liftIO $ unGhc a $ Session s
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
options :: GhcMod Options
|
||||
options :: IOish m => GhcModT m Options
|
||||
options = gmOptions <$> ask
|
||||
|
||||
cradle :: GhcMod Cradle
|
||||
cradle :: IOish m => GhcModT m Cradle
|
||||
cradle = gmCradle <$> ask
|
||||
|
||||
|
||||
instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
|
||||
liftBase = GhcModT . liftBase
|
||||
|
||||
|
@ -9,7 +9,7 @@ import Control.Applicative ((<$>))
|
||||
import System.Process (readProcess)
|
||||
|
||||
-- | Obtaining the package name and the doc path of a module.
|
||||
pkgDoc :: String -> GhcMod String
|
||||
pkgDoc :: IOish m => String -> GhcModT m String
|
||||
pkgDoc mdl = cradle >>= \c -> liftIO $ do
|
||||
pkg <- trim <$> readProcess "ghc-pkg" (toModuleOpts c) []
|
||||
if pkg == "" then
|
||||
|
@ -51,6 +51,7 @@ Extra-Source-Files: ChangeLog
|
||||
Library
|
||||
Default-Language: Haskell2010
|
||||
GHC-Options: -Wall
|
||||
Extensions: ConstraintKinds, FlexibleContexts
|
||||
Exposed-Modules: Language.Haskell.GhcMod
|
||||
Language.Haskell.GhcMod.Ghc
|
||||
Language.Haskell.GhcMod.Monad
|
||||
@ -117,6 +118,7 @@ Executable ghc-mod
|
||||
Main-Is: GHCMod.hs
|
||||
Other-Modules: Paths_ghc_mod
|
||||
GHC-Options: -Wall
|
||||
Extensions: ConstraintKinds, FlexibleContexts
|
||||
HS-Source-Dirs: src
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, directory
|
||||
@ -130,6 +132,7 @@ Executable ghc-modi
|
||||
Main-Is: GHCModi.hs
|
||||
Other-Modules: Paths_ghc_mod
|
||||
GHC-Options: -Wall
|
||||
Extensions: ConstraintKinds, FlexibleContexts
|
||||
HS-Source-Dirs: src
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, containers
|
||||
@ -143,12 +146,14 @@ Test-Suite doctest
|
||||
Default-Language: Haskell2010
|
||||
HS-Source-Dirs: test
|
||||
Ghc-Options: -threaded -Wall
|
||||
Extensions: ConstraintKinds, FlexibleContexts
|
||||
Main-Is: doctests.hs
|
||||
Build-Depends: base
|
||||
, doctest >= 0.9.3
|
||||
|
||||
Test-Suite spec
|
||||
Default-Language: Haskell2010
|
||||
Extensions: ConstraintKinds, FlexibleContexts
|
||||
Main-Is: Main.hs
|
||||
Hs-Source-Dirs: test, .
|
||||
Type: exitcode-stdio-1.0
|
||||
|
@ -111,7 +111,7 @@ main = flip E.catches handlers $ do
|
||||
nArgs n f = if length remainingArgs == n
|
||||
then f
|
||||
else E.throw (ArgumentsMismatch cmdArg0)
|
||||
res <- runGhcMod opt $ case cmdArg0 of
|
||||
res <- runGhcModT opt $ case cmdArg0 of
|
||||
"list" -> modules
|
||||
"lang" -> languages
|
||||
"flag" -> flags
|
||||
@ -152,7 +152,7 @@ main = flip E.catches handlers $ do
|
||||
hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
|
||||
printUsage
|
||||
printUsage = hPutStrLn stderr $ '\n' : O.usageInfo usage argspec
|
||||
withFile :: (FilePath -> GhcMod a) -> FilePath -> GhcMod a
|
||||
withFile :: IOish m => (FilePath -> GhcModT m a) -> FilePath -> GhcModT m a
|
||||
withFile cmd file = do
|
||||
exist <- liftIO $ doesFileExist file
|
||||
if exist
|
||||
|
@ -101,8 +101,8 @@ main = E.handle cmdHandler $
|
||||
-- c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
|
||||
setCurrentDirectory rootdir
|
||||
mvar <- liftIO newEmptyMVar
|
||||
void $ forkIO $ runGhcMod opt $ setupDB mvar
|
||||
runGhcMod opt $ loop S.empty mvar
|
||||
void $ forkIO $ runGhcModT opt $ setupDB mvar
|
||||
runGhcModT opt $ loop S.empty mvar
|
||||
where
|
||||
-- this is just in case.
|
||||
-- If an error is caught here, it is a bug of GhcMod library.
|
||||
@ -116,7 +116,7 @@ replace (x:xs) = x : replace xs
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
setupDB :: MVar SymMdlDb -> GhcMod ()
|
||||
setupDB :: IOish m => MVar SymMdlDb -> GhcModT m ()
|
||||
setupDB mvar = ghandle handler $ do
|
||||
liftIO . putMVar mvar =<< getSymMdlDb
|
||||
where
|
||||
@ -124,7 +124,7 @@ setupDB mvar = ghandle handler $ do
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
loop :: Set FilePath -> MVar SymMdlDb -> GhcMod ()
|
||||
loop :: IOish m => Set FilePath -> MVar SymMdlDb -> GhcModT m ()
|
||||
loop set mvar = do
|
||||
cmdArg <- liftIO getLine
|
||||
let (cmd,arg') = break (== ' ') cmdArg
|
||||
@ -152,9 +152,10 @@ loop set mvar = do
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
checkStx :: Set FilePath
|
||||
checkStx :: IOish m
|
||||
=> Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
checkStx set file = do
|
||||
set' <- toGhcMod $ newFileSet set file
|
||||
let files = S.toList set'
|
||||
@ -191,17 +192,17 @@ isSameMainFile file (Just x)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
findSym :: Set FilePath -> String -> MVar SymMdlDb
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
findSym :: IOish m => Set FilePath -> String -> MVar SymMdlDb
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
findSym set sym mvar = do
|
||||
db <- liftIO $ readMVar mvar
|
||||
opt <- options
|
||||
let ret = lookupSym' opt sym db
|
||||
return (ret, True, set)
|
||||
|
||||
lintStx :: Set FilePath
|
||||
lintStx :: IOish m => Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
lintStx set optFile = do
|
||||
ret <- local env' $ lint file
|
||||
return (ret, True, set)
|
||||
@ -228,36 +229,40 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
showInfo :: Set FilePath
|
||||
showInfo :: IOish m
|
||||
=> Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
showInfo set fileArg = do
|
||||
let [file, expr] = words fileArg
|
||||
set' <- newFileSet set file
|
||||
ret <- info file expr
|
||||
return (ret, True, set')
|
||||
|
||||
showType :: Set FilePath
|
||||
showType :: IOish m
|
||||
=> Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
showType set fileArg = do
|
||||
let [file, line, column] = words fileArg
|
||||
set' <- newFileSet set file
|
||||
ret <- types file (read line) (read column)
|
||||
return (ret, True, set')
|
||||
|
||||
doSplit :: Set FilePath
|
||||
doSplit :: IOish m
|
||||
=> Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
doSplit set fileArg = do
|
||||
let [file, line, column] = words fileArg
|
||||
set' <- newFileSet set file
|
||||
ret <- splits file (read line) (read column)
|
||||
return (ret, True, set')
|
||||
|
||||
doSig :: Set FilePath
|
||||
doSig :: IOish m
|
||||
=> Set FilePath
|
||||
-> FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
doSig set fileArg = do
|
||||
let [file, line, column] = words fileArg
|
||||
set' <- newFileSet set file
|
||||
@ -266,15 +271,17 @@ doSig set fileArg = do
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
bootIt :: Set FilePath
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
bootIt :: IOish m
|
||||
=> Set FilePath
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
bootIt set = do
|
||||
ret <- boot
|
||||
return (ret, True, set)
|
||||
|
||||
browseIt :: Set FilePath
|
||||
browseIt :: IOish m
|
||||
=> Set FilePath
|
||||
-> ModuleString
|
||||
-> GhcMod (String, Bool, Set FilePath)
|
||||
-> GhcModT m (String, Bool, Set FilePath)
|
||||
browseIt set mdl = do
|
||||
ret <- browse mdl
|
||||
return (ret, True, set)
|
||||
|
@ -12,14 +12,14 @@ module TestUtils (
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Types
|
||||
|
||||
isolateCradle :: GhcMod a -> GhcMod a
|
||||
isolateCradle :: IOish m => GhcModT m a -> GhcModT m a
|
||||
isolateCradle action =
|
||||
local modifyEnv $ action
|
||||
where
|
||||
modifyEnv e = e { gmCradle = (gmCradle e) { cradlePkgDbStack = [GlobalDb] } }
|
||||
|
||||
runIsolatedGhcMod :: Options -> GhcMod a -> IO a
|
||||
runIsolatedGhcMod opt action = runGhcMod opt $ isolateCradle action
|
||||
runIsolatedGhcMod :: Options -> GhcModT IO a -> IO a
|
||||
runIsolatedGhcMod opt action = runGhcModT opt $ isolateCradle action
|
||||
|
||||
-- | Run GhcMod in isolated cradle with default options
|
||||
runID = runIsolatedGhcMod defaultOptions
|
||||
@ -28,7 +28,9 @@ runID = runIsolatedGhcMod defaultOptions
|
||||
runI = runIsolatedGhcMod
|
||||
|
||||
-- | Run GhcMod
|
||||
run = runGhcMod
|
||||
run :: Options -> GhcModT IO a -> IO a
|
||||
run = runGhcModT
|
||||
|
||||
-- | Run GhcMod with default options
|
||||
runD = runGhcMod defaultOptions
|
||||
runD :: GhcModT IO a -> IO a
|
||||
runD = runGhcModT defaultOptions
|
||||
|
Loading…
Reference in New Issue
Block a user