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