hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make GhcModT's MonadState instance pass through

Browse Source 
..to the underlying monad
This commit is contained in:
Daniel Gröber 2014-08-12 18:09:31 +02:00
parent c0652c0321
commit e345c92edb
2 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Language/Haskell/GhcMod/Monad.hs
View File

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

2
Language/Haskell/GhcMod/Target.hs
View File

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