diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index cfb75f7..24833f8 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -15,7 +15,12 @@ module Language.Haskell.GhcMod ( , GhcPkgDb , Symbol , SymbolDb - , module Language.Haskell.GhcMod.Monad + -- * Monad Types + , GhcModT + , IOish + -- * Monad utilities + , runGhcModT + , withOptions -- * 'GhcMod' utilities , boot , browse diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 5167372..17aa82a 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -79,7 +79,7 @@ withLogger setDF body = ghandle sourceError $ do sourceError :: IOish m => SourceError -> GhcModT m (Either String String) sourceError err = do dflags <- G.getSessionDynFlags - style <- toGhcMod getStyle + style <- toGhcModT getStyle ret <- convert' (errBagToStrList dflags style . srcErrorMessages $ err) return $ Left ret diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index ff35dad..a323f6b 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -23,12 +23,13 @@ module Language.Haskell.GhcMod.Monad ( , withErrorHandler -- ** Conversion , liftGhcMod - , toGhcMod + , toGhcModT -- ** Accessing 'GhcModEnv' and 'GhcModState' , options , cradle , getMode , setMode + , withOptions -- ** Exporting convenient modules , module Control.Monad.Reader.Class , module Control.Monad.Writer.Class @@ -274,8 +275,8 @@ withErrorHandler label = ghandle ignore exitSuccess -- | This is only a transitional mechanism don't use it for new code. -toGhcMod :: IOish m => Ghc a -> GhcModT m a -toGhcMod a = do +toGhcModT :: IOish m => Ghc a -> GhcModT m a +toGhcModT a = do s <- gmGhcSession <$> ask liftIO $ unGhc a $ Session s @@ -297,6 +298,15 @@ setMode mode = put $ GhcModState mode ---------------------------------------------------------------- +withOptions :: IOish m => (Options -> Options) -> GhcModT m a -> GhcModT m a +withOptions changeOpt action = local changeEnv action + where + changeEnv e = e { gmOptions = changeOpt opt } + where + opt = gmOptions e + +---------------------------------------------------------------- + instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where liftBase = GhcModT . liftBase diff --git a/src/GHCModi.hs b/src/GHCModi.hs index e3a888b..efd94cf 100644 --- a/src/GHCModi.hs +++ b/src/GHCModi.hs @@ -31,7 +31,6 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Typeable (Typeable) import Data.Version (showVersion) -import GHC (GhcMonad) import qualified GHC as G import Language.Haskell.GhcMod import Paths_ghc_mod @@ -151,14 +150,14 @@ checkStx :: IOish m -> FilePath -> GhcModT m (String, Bool, Set FilePath) checkStx set file = do - set' <- toGhcMod $ newFileSet set file + set' <- newFileSet set file let files = S.toList set' eret <- check files case eret of Right ret -> return (ret, True, set') Left ret -> return (ret, True, set) -- fxime: set -newFileSet :: GhcMonad m => Set FilePath -> FilePath -> m (Set FilePath) +newFileSet :: IOish m => Set FilePath -> FilePath -> GhcModT m (Set FilePath) newFileSet set file = do let set1 | S.member file set = set @@ -168,7 +167,7 @@ newFileSet set file = do Nothing -> set1 Just mainfile -> S.delete mainfile set1 -getModSummaryForMain :: GhcMonad m => m (Maybe G.ModSummary) +getModSummaryForMain :: IOish m => GhcModT m (Maybe G.ModSummary) getModSummaryForMain = find isMain <$> G.getModuleGraph where isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main" @@ -197,13 +196,12 @@ lintStx :: IOish m => Set FilePath -> FilePath -> GhcModT m (String, Bool, Set FilePath) lintStx set optFile = do - ret <- local env' $ lint file + ret <- withOptions changeOpt $ lint file return (ret, True, set) where (opts,file) = parseLintOptions optFile hopts = if opts == "" then [] else read opts - env' e = e { gmOptions = opt' $ gmOptions e } - opt' o = o { hlintOpts = hopts } + changeOpt o = o { hlintOpts = hopts } -- | -- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"