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:
Daniel Gröber
2014-07-12 11:16:16 +02:00
parent b6896a481a
commit f0bfcb8811
20 changed files with 106 additions and 92 deletions

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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-"]

View File

@@ -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

View File

@@ -6,5 +6,5 @@ import Language.Haskell.GhcMod.Monad
-- | Listing language extensions.
languages :: GhcMod String
languages :: IOish m => GhcModT m String
languages = convert' supportedLanguagesAndExtensions

View File

@@ -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)

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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