export minimum Monad stuff from GhcMod.
This commit is contained in:
parent
e1d9c3b881
commit
30ddd655cd
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user