diff --git a/Control/Monad/Reader.hs b/Control/Monad/Reader.hs index 4f2f649..a2c95ed 100644 --- a/Control/Monad/Reader.hs +++ b/Control/Monad/Reader.hs @@ -50,6 +50,9 @@ module Control.Monad.Reader ( runReaderT, mapReaderT, withReaderT, + -- * Lifting helper type + MonadReader.LiftingReader(..), + -- * Lifting into the transformer module Control.Monad.Trans, -- * Example 1: Simple Reader Usage -- $simpleReaderExample diff --git a/Control/Monad/Reader/Class.hs b/Control/Monad/Reader/Class.hs index 6cb83dd..c95f24e 100644 --- a/Control/Monad/Reader/Class.hs +++ b/Control/Monad/Reader/Class.hs @@ -1,9 +1,12 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} -- Search for UndecidableInstances to see why this is needed {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ViewPatterns #-} -- Needed because the CPSed versions of Writer and State are secretly State -- wrappers, which don't force such constraints, even though they should legally -- be there. @@ -48,6 +51,7 @@ than using the 'Control.Monad.State.State' monad. module Control.Monad.Reader.Class ( MonadReader(..), asks, + LiftingReader(..), ) where import qualified Control.Monad.Trans.Cont as Cont @@ -68,7 +72,9 @@ import qualified Control.Monad.Trans.Accum as Accum import Control.Monad.Trans.Select (SelectT (SelectT), runSelectT) import qualified Control.Monad.Trans.RWS.CPS as CPSRWS import qualified Control.Monad.Trans.Writer.CPS as CPS -import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Data.Kind (Type) +import Data.Coerce (coerce) -- ---------------------------------------------------------------------------- -- class MonadReader @@ -202,3 +208,45 @@ instance r <- ask local f (runSelectT m (local (const r) . c)) reader = lift . reader + +-- | A helper type to decrease boilerplate when defining new transformer +-- instances of 'MonadReader'. +-- +-- @ +-- newtype SneakyReaderT m a = SneakyReaderT { runSneakyReaderT :: ReaderT String m a } +-- deriving (Functor, Applicative, Monad) +-- deriving (MonadReader r) via LiftingReader (ReaderT String) m +-- @ +-- +-- @since ???? +type LiftingReader :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type +newtype LiftingReader t m a = LiftingReader (t m a) + deriving (Functor, Applicative, Monad, MonadTrans) + +mapLiftingReader :: (t m a -> t m b) -> LiftingReader t m a -> LiftingReader t m b +mapLiftingReader = coerce + +-- | @since ???? +instance (MonadReader r m, Monoid w) => MonadReader r (LiftingReader (LazyRWS.RWST r' w s) m) where + ask = lift ask + local = mapLiftingReader . LazyRWS.mapRWST . local + reader = lift . reader + +-- | @since ???? +instance (MonadReader r m, Monoid w) => MonadReader r (LiftingReader (StrictRWS.RWST r' w s) m) where + ask = lift ask + local = mapLiftingReader . StrictRWS.mapRWST . local + reader = lift . reader + +-- | @since ???? +instance (MonadReader r m, Monoid w) => MonadReader r (LiftingReader (CPSRWS.RWST r' w s) m) where + ask = lift ask + local = mapLiftingReader . CPSRWS.mapRWST . local + reader = lift . reader + +-- | @since ???? +instance MonadReader r m => MonadReader r (LiftingReader (ReaderT r') m) where + ask = lift ask + local = mapLiftingReader . ReaderT.mapReaderT . local + reader = lift . reader + diff --git a/Control/Monad/State/Class.hs b/Control/Monad/State/Class.hs index df5a33d..ba4d25c 100644 --- a/Control/Monad/State/Class.hs +++ b/Control/Monad/State/Class.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -33,7 +35,8 @@ module Control.Monad.State.Class ( MonadState(..), modify, modify', - gets + gets, + LiftingState(..), ) where import Control.Monad.Trans.Cont (ContT) @@ -51,7 +54,8 @@ import Control.Monad.Trans.Accum (AccumT) import Control.Monad.Trans.Select (SelectT) import qualified Control.Monad.Trans.RWS.CPS as CPSRWS import qualified Control.Monad.Trans.Writer.CPS as CPS -import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Data.Kind (Type) -- --------------------------------------------------------------------------- @@ -192,3 +196,24 @@ instance MonadState s m => MonadState s (SelectT r m) where get = lift get put = lift . put state = lift . state + +-- | A helper type to decrease boilerplate when defining new transformer +-- instances of 'MonadState'. +-- +-- @ +-- newtype SneakyStateT m a = SneakyStateT { runSneakyStateT :: Lazy.StateT String m a } +-- deriving (Functor, Applicative, Monad) +-- deriving (MonadState s) via LiftingState (Lazy.StateT String) m +-- @ +-- +-- @since ???? +type LiftingState :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type +newtype LiftingState t m a = LiftingState (t m a) + deriving (Functor, Applicative, Monad, MonadTrans) + +-- | @since ???? +instance (MonadState s m, MonadTrans t, Monad (t m)) => MonadState s (LiftingState t m) where + get = lift get + put = lift . put + state = lift . state + diff --git a/Control/Monad/State/Lazy.hs b/Control/Monad/State/Lazy.hs index 98241d6..3d90381 100644 --- a/Control/Monad/State/Lazy.hs +++ b/Control/Monad/State/Lazy.hs @@ -39,6 +39,9 @@ module Control.Monad.State.Lazy ( execStateT, mapStateT, withStateT, + -- * Lifting helper type + MonadState.LiftingState(..), + -- * Lifting into the transformer module Control.Monad.Trans, -- * Examples -- $examples diff --git a/Control/Monad/State/Strict.hs b/Control/Monad/State/Strict.hs index 5c9d93f..33f7da1 100644 --- a/Control/Monad/State/Strict.hs +++ b/Control/Monad/State/Strict.hs @@ -39,6 +39,9 @@ module Control.Monad.State.Strict ( execStateT, mapStateT, withStateT, + -- * Lifting helper type + MonadState.LiftingState(..), + -- * Lifting into the transformer module Control.Monad.Trans, -- * Examples -- $examples diff --git a/Control/Monad/Writer/CPS.hs b/Control/Monad/Writer/CPS.hs index ad9d34d..d9b74b9 100644 --- a/Control/Monad/Writer/CPS.hs +++ b/Control/Monad/Writer/CPS.hs @@ -35,6 +35,11 @@ module Control.Monad.Writer.CPS ( WriterT, execWriterT, mapWriterT, + -- * Lifting helper type + MonadWriter.LiftingWriter, + MonadWriter.LiftWriter(..), + MonadWriter.LiftWriterRWS(..), + -- * Lifting into the transformer module Control.Monad.Trans, ) where diff --git a/Control/Monad/Writer/Class.hs b/Control/Monad/Writer/Class.hs index 11c156a..b392481 100644 --- a/Control/Monad/Writer/Class.hs +++ b/Control/Monad/Writer/Class.hs @@ -1,8 +1,16 @@ -{-# LANGUAGE Safe #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} + +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} -- Search for UndecidableInstances to see why this is needed ----------------------------------------------------------------------------- @@ -28,6 +36,9 @@ module Control.Monad.Writer.Class ( MonadWriter(..), listens, censor, + LiftingWriter, + LiftWriter(..), + LiftWriterRWS(..), ) where import Control.Monad.Trans.Except (ExceptT) @@ -47,7 +58,9 @@ import Control.Monad.Trans.Accum (AccumT) import qualified Control.Monad.Trans.Accum as Accum import qualified Control.Monad.Trans.RWS.CPS as CPSRWS import qualified Control.Monad.Trans.Writer.CPS as CPS -import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Data.Kind (Type, Constraint) +import Data.Coerce (coerce) -- --------------------------------------------------------------------------- -- MonadWriter class @@ -205,3 +218,90 @@ instance tell = lift . tell listen = Accum.liftListen listen pass = Accum.liftPass pass + +-- | A helper type function to decrease boilerplate when defining new +-- transformer instances of 'MonadWriter'. +-- +-- Example of deriving 'MonadWriter' from @m@ and not the 'Lazy.WriterT' transformer. +-- +-- @ +-- newtype SneakyWriterT m a = SneakyWriterT { runSneakyWriterT :: Lazy.WriterT String m a } +-- deriving (Functor, Applicative, Monad) +-- deriving (MonadWriter w) via LiftingWriter Lazy.WriterT String m +-- @ +-- +-- Example of deriving 'MonadWriter' from @m@ and not the 'LazyRWS.RWST' transformer. +-- +-- @ +-- newtype SneakyRWST m a = SneakyRWST { runSneakyRWST :: LazyRWS.RWST () String () m a } +-- deriving (Functor, Applicative, Monad) +-- deriving (MonadWriter w) via LiftingWriter LazyRWS.RWST () String () m +-- @ +-- +-- | @since ???? +type LiftingWriter :: forall t. t +type family LiftingWriter where + LiftingWriter = LiftWriter + LiftingWriter = LiftWriterRWS + +-- | Do not use directly; use @LiftingWriter@ instead. +-- +-- | @since ???? +newtype LiftWriter t w (m :: Type -> Type) a = LiftWriter (t w m a) + deriving (Functor, Applicative, Monad, MonadTrans) + +-- | Do not use directly; use @LiftingWriter@ instead. +-- +-- | @since ???? +newtype LiftWriterRWS t r w s (m :: Type -> Type) a = LiftWriterRWS (t r w s m a) + deriving (Functor, Applicative, Monad, MonadTrans) + +-- | Class that allows new writer transformers to use the existing instance of 'MonadWriter' so that they can be used with 'LiftingWriter' to using the monad's "MonadWriter' instance. +-- By using this class you only have to define 'mapWriterT' instead of 'writer', 'tell', 'listen', and 'pass'. +-- +-- | @since ???? +type MapWriter :: (Type -> (Type -> Type) -> Type -> Type) -> Constraint +class MapWriter t where mapWriterT :: (Monad m, Monoid w) => (m (a, w) -> m (b, w)) -> t w m a -> t w m b +-- | @since ???? +instance MapWriter Lazy.WriterT where mapWriterT = Lazy.mapWriterT +-- | @since ???? +instance MapWriter Strict.WriterT where mapWriterT = Strict.mapWriterT +-- | @since ???? +instance MapWriter CPS.WriterT where mapWriterT = CPS.mapWriterT + +-- | Class that allows new reader writer state transformers to use the existing instance of 'MonadWriter' so that they can be used with 'LiftingWriter' to using the monad's "MonadWriter' instance. +-- By using this class you only have to define 'mapRWST' instead of 'writer', 'tell', 'listen', and 'pass'. +-- +-- | @since ???? +type MapRWS :: (Type -> Type -> Type -> (Type -> Type) -> Type -> Type) -> Constraint +class MapRWS t where mapRWST :: (Monad m, Monoid w) => (m (a, s, w) -> m (b, s, w)) -> t r w s m a -> t r w s m b +-- | @since ???? +instance MapRWS LazyRWS.RWST where mapRWST = LazyRWS.mapRWST +-- | @since ???? +instance MapRWS StrictRWS.RWST where mapRWST = StrictRWS.mapRWST +-- | @since ???? +instance MapRWS CPSRWS.RWST where mapRWST = CPSRWS.mapRWST + +mapLiftWriter :: (t w m a -> t w m b) -> LiftWriter t w m a -> LiftWriter t w m b +mapLiftWriter = coerce + +formatWriter :: ((a,b),c) -> ((a,c),b) +formatWriter ((a,b),c) = ((a,c),b) + +mapLiftWriterRWS :: (t r w s m a -> t r w s m b) -> LiftWriterRWS t r w s m a -> LiftWriterRWS t r w s m b +mapLiftWriterRWS = coerce + +-- | @since ???? +instance (MapWriter t, MonadWriter w m, MonadTrans (t w'), Monad (t w' m), Monoid w') => MonadWriter w (LiftWriter t w' m) where + writer = lift . writer + tell = lift . tell + listen = mapLiftWriter $ mapWriterT $ fmap formatWriter . listen + pass = mapLiftWriter $ mapWriterT $ pass . fmap formatWriter + +-- | @since ???? +instance (MapRWS t, MonadWriter w m, MonadTrans (t r w' s), Monad (t r w' s m), Monoid w') => MonadWriter w (LiftWriterRWS t r w' s m) where + writer = lift . writer + tell = lift . tell + listen = mapLiftWriterRWS $ mapRWST $ fmap (\((a,b,c),d) -> ((a,d),b,c)) . listen + pass = mapLiftWriterRWS $ mapRWST $ pass . fmap (\((a,b),c,d) -> ((a,c,d),b)) + diff --git a/Control/Monad/Writer/Lazy.hs b/Control/Monad/Writer/Lazy.hs index 6013f0c..ff60e87 100644 --- a/Control/Monad/Writer/Lazy.hs +++ b/Control/Monad/Writer/Lazy.hs @@ -33,6 +33,11 @@ module Control.Monad.Writer.Lazy ( runWriterT, execWriterT, mapWriterT, + -- * Lifting helper type + MonadWriter.LiftingWriter, + MonadWriter.LiftWriter(..), + MonadWriter.LiftWriterRWS(..), + -- * Lifting into the transformer module Control.Monad.Trans, ) where diff --git a/Control/Monad/Writer/Strict.hs b/Control/Monad/Writer/Strict.hs index 0844753..b4588a2 100644 --- a/Control/Monad/Writer/Strict.hs +++ b/Control/Monad/Writer/Strict.hs @@ -32,6 +32,11 @@ module Control.Monad.Writer.Strict ( WriterT(..), execWriterT, mapWriterT, + -- * Lifting helper type + MonadWriter.LiftingWriter, + MonadWriter.LiftWriter(..), + MonadWriter.LiftWriterRWS(..), + -- * Lifting into the transformer module Control.Monad.Trans, ) where