Make GhcModT's MonadState instance pass through
..to the underlying monad
This commit is contained in:
parent
c0652c0321
commit
e345c92edb
@ -30,8 +30,6 @@ module Language.Haskell.GhcMod.Monad (
|
|||||||
, withOptions
|
, withOptions
|
||||||
-- ** Exporting convenient modules
|
-- ** Exporting convenient modules
|
||||||
, module Control.Monad.Reader.Class
|
, module Control.Monad.Reader.Class
|
||||||
, module Control.Monad.Writer.Class
|
|
||||||
, module Control.Monad.State.Class
|
|
||||||
, module Control.Monad.Journal.Class
|
, module Control.Monad.Journal.Class
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -85,10 +83,10 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith,
|
|||||||
|
|
||||||
import Control.Monad.Trans.Class
|
import Control.Monad.Trans.Class
|
||||||
import Control.Monad.Reader.Class
|
import Control.Monad.Reader.Class
|
||||||
import Control.Monad.Writer.Class
|
import Control.Monad.Writer.Class (MonadWriter)
|
||||||
import Control.Monad.State.Class
|
import Control.Monad.State.Class (MonadState(..))
|
||||||
|
|
||||||
import Control.Monad.Error (Error(..), MonadError, ErrorT, runErrorT)
|
import Control.Monad.Error (MonadError, ErrorT, runErrorT)
|
||||||
import Control.Monad.Reader (ReaderT, runReaderT)
|
import Control.Monad.Reader (ReaderT, runReaderT)
|
||||||
import Control.Monad.State.Strict (StateT, runStateT)
|
import Control.Monad.State.Strict (StateT, runStateT)
|
||||||
import Control.Monad.Trans.Journal (JournalT, runJournalT)
|
import Control.Monad.Trans.Journal (JournalT, runJournalT)
|
||||||
@ -155,13 +153,18 @@ newtype GhcModT m a = GhcModT {
|
|||||||
#endif
|
#endif
|
||||||
, MonadReader GhcModEnv
|
, MonadReader GhcModEnv
|
||||||
, MonadWriter w
|
, MonadWriter w
|
||||||
, MonadState GhcModState
|
|
||||||
, MonadError GhcModError
|
, MonadError GhcModError
|
||||||
)
|
)
|
||||||
|
|
||||||
instance MonadTrans GhcModT where
|
instance MonadTrans GhcModT where
|
||||||
lift = GhcModT . lift . lift . lift . lift
|
lift = GhcModT . lift . lift . lift . lift
|
||||||
|
|
||||||
|
instance MonadState s m => MonadState s (GhcModT m) where
|
||||||
|
get = GhcModT $ lift $ lift $ lift $ get
|
||||||
|
put = GhcModT . lift . lift . lift . put
|
||||||
|
state = GhcModT . lift . lift . lift . state
|
||||||
|
|
||||||
|
|
||||||
#if MONADIO_INSTANCES
|
#if MONADIO_INSTANCES
|
||||||
instance MonadIO m => MonadIO (StateT s m) where
|
instance MonadIO m => MonadIO (StateT s m) where
|
||||||
liftIO = lift . liftIO
|
liftIO = lift . liftIO
|
||||||
@ -283,17 +286,23 @@ toGhcModT a = do
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
gmsGet :: IOish m => GhcModT m GhcModState
|
||||||
|
gmsGet = GhcModT get
|
||||||
|
|
||||||
|
gmsPut :: IOish m => GhcModState -> GhcModT m ()
|
||||||
|
gmsPut = GhcModT . put
|
||||||
|
|
||||||
options :: IOish m => GhcModT m Options
|
options :: IOish m => GhcModT m Options
|
||||||
options = gmOptions <$> ask
|
options = gmOptions <$> ask
|
||||||
|
|
||||||
cradle :: IOish m => GhcModT m Cradle
|
cradle :: IOish m => GhcModT m Cradle
|
||||||
cradle = gmCradle <$> ask
|
cradle = gmCradle <$> ask
|
||||||
|
|
||||||
getCompilerMode :: (Functor m, MonadState GhcModState m) => m CompilerMode
|
getCompilerMode :: IOish m => GhcModT m CompilerMode
|
||||||
getCompilerMode = gmCompilerMode <$> get
|
getCompilerMode = gmCompilerMode <$> gmsGet
|
||||||
|
|
||||||
setCompilerMode :: MonadState GhcModState m => CompilerMode -> m ()
|
setCompilerMode :: IOish m => CompilerMode -> GhcModT m ()
|
||||||
setCompilerMode mode = (\s -> put s { gmCompilerMode = mode } ) =<< get
|
setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -15,7 +15,7 @@ setTargetFiles :: IOish m => [FilePath] -> GhcModT m ()
|
|||||||
setTargetFiles files = do
|
setTargetFiles files = do
|
||||||
targets <- forM files $ \file -> G.guessTarget file Nothing
|
targets <- forM files $ \file -> G.guessTarget file Nothing
|
||||||
G.setTargets targets
|
G.setTargets targets
|
||||||
mode <- gmCompilerMode <$> get
|
mode <- getCompilerMode
|
||||||
if mode == Intelligent then
|
if mode == Intelligent then
|
||||||
loadTargets Intelligent
|
loadTargets Intelligent
|
||||||
else do
|
else do
|
||||||
|
Loading…
Reference in New Issue
Block a user