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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user