1- {-# LANGUAGE Safe #-}
21{-# LANGUAGE FlexibleInstances #-}
32{-# LANGUAGE FunctionalDependencies #-}
43{-# LANGUAGE MultiParamTypeClasses #-}
54-- Search for UndecidableInstances to see why this is needed
65{-# LANGUAGE UndecidableInstances #-}
6+ {-# LANGUAGE StandaloneKindSignatures #-}
7+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
8+ {-# LANGUAGE Trustworthy #-}
79-- Needed because the CPSed versions of Writer and State are secretly State
810-- wrappers, which don't force such constraints, even though they should legally
911-- be there.
@@ -48,6 +50,7 @@ than using the 'Control.Monad.State.State' monad.
4850module Control.Monad.Reader.Class (
4951 MonadReader (.. ),
5052 asks ,
53+ LiftingReader (.. ),
5154 ) where
5255
5356import qualified Control.Monad.Trans.Cont as Cont
@@ -68,7 +71,8 @@ import qualified Control.Monad.Trans.Accum as Accum
6871import Control.Monad.Trans.Select (SelectT (SelectT ), runSelectT )
6972import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
7073import qualified Control.Monad.Trans.Writer.CPS as CPS
71- import Control.Monad.Trans.Class (lift )
74+ import Control.Monad.Trans.Class (MonadTrans (lift ))
75+ import Data.Kind (Type )
7276
7377-- ----------------------------------------------------------------------------
7478-- class MonadReader
@@ -202,3 +206,17 @@ instance
202206 r <- ask
203207 local f (runSelectT m (local (const r) . c))
204208 reader = lift . reader
209+
210+ type LiftingReader :: ((Type -> Type ) -> Type -> Type ) -> (Type -> Type ) -> Type -> Type
211+ newtype LiftingReader t m a = LiftingReader (t m a )
212+ deriving (Functor , Applicative , Monad , MonadTrans )
213+
214+ instance MonadReader r m => MonadReader r (LiftingReader (ReaderT r' ) m ) where
215+ ask = lift ask
216+ local f (LiftingReader (ReaderT. ReaderT x)) = LiftingReader . ReaderT. ReaderT $ local f . x
217+ reader = lift . reader
218+
219+ instance (MonadReader r m , Monoid w ) => MonadReader r (LiftingReader (LazyRWS. RWST r' w s ) m ) where
220+ ask = lift ask
221+ local f (LiftingReader (LazyRWS. RWST x)) = LiftingReader . LazyRWS. RWST $ \ r s -> local f $ x r s
222+ reader = lift . reader
0 commit comments