ghc-mod/core/Language/Haskell/GhcMod/Monad/State.hs
2017-01-12 17:05:47 +01:00

68 lines
2.2 KiB
Haskell

-- ghc-mod: Making Haskell development *more* fun
-- Copyright (C) 2015,2016 Daniel Gröber <dxld ÄT darkboxed DOT org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
module Language.Haskell.GhcMod.Monad.State where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Newtypes
import Control.Monad
import Control.Monad.State.Strict (StateT(..))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Prelude
class Monad m => GmState m where
gmsGet :: m GhcModState
gmsGet = gmsState (\s -> (s, s))
gmsPut :: GhcModState -> m ()
gmsPut s = gmsState (\_ -> ((), s))
gmsState :: (GhcModState -> (a, GhcModState)) -> m a
gmsState f = do
s <- gmsGet
let ~(a, s') = f s
gmsPut s'
return a
{-# MINIMAL gmsState | gmsGet, gmsPut #-}
instance GmState m => GmState (StateT s m) where
gmsGet = lift gmsGet
gmsPut = lift . gmsPut
gmsState = lift . gmsState
instance Monad m => GmState (StateT GhcModState m) where
gmsGet = get
gmsPut = put
gmsState = state
instance Monad m => GmState (GmT m) where
gmsGet = GmT get
gmsPut = GmT . put
gmsState = GmT . state
instance GmState m => GmState (MaybeT m) where
gmsGet = MaybeT $ Just `liftM` gmsGet
gmsPut = MaybeT . (Just `liftM`) . gmsPut
gmsState = MaybeT . (Just `liftM`) . gmsState
deriving instance (Monad m, GmState (GhcModT m)) => GmState (GmlT m)