export minimum Monad stuff from GhcMod.

This commit is contained in:
Kazu Yamamoto 2014-07-18 15:31:42 +09:00
parent e1d9c3b881
commit 30ddd655cd
4 changed files with 25 additions and 12 deletions

View File

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

View File

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

View File

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

View File

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