I'm attempting to build a free monad (using free) which acts just like a StateT monad, but which allows you to also run monads over a base state AppState. I have a separate constructor LiftAction which holds those types. The idea is that you keep zooming Actions down until they reach AppState, which can store different states inside its extension map.
Here was my earlier (failed) attempt using mtl: Lift through nested state transformers (mtl)
Anyways, since it's basically a wrapper over StateT I've given it a MonadState instance, but now I'm working on adding the ability to zoom the monad's state using the lens library; I'm getting some weird compiler errors I'm having trouble understanding (the lens errors aren't usually terribly user friendly).
Here's my code and initial attempt:
{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Eve.Internal.AppF
( Action(..)
, App
, AppState(..)
, liftAction
, execApp
) where
import Control.Monad.State
import Control.Monad.Free
import Control.Lens
type App a = Action AppState a
data AppState = AppState
{ baseExts :: Int -- Assume this actually contains many nested states which we can zoom
}
data ActionF s next =
LiftAction (Action AppState next)
| LiftIO (IO next)
| StateAction (StateT s IO next)
deriving Functor
newtype Action s a = Action
{ getAction :: Free (ActionF s) a
} deriving (Functor, Applicative, Monad)
liftActionF :: ActionF s next -> Action s next
liftActionF = Action . liftF
instance MonadState s (Action s) where
state = liftActionF . StateAction . state
liftAction :: Action AppState a -> Action s a
liftAction = liftActionF . LiftAction
execApp :: Action AppState a -> StateT AppState IO a
execApp (Action actionF) = foldFree toState actionF
where
toState (LiftAction act) = execApp act
toState (LiftIO io) = liftIO io
toState (StateAction st) = st
type instance Zoomed (Action s) = Zoomed (StateT s IO)
instance Zoom (Action s) (Action t) s t where
zoom l (Action actionF) = Action $ hoistFree (zoomActionF l) actionF
where
zoomActionF _ (LiftAction act) = LiftAction act
zoomActionF _ (LiftIO io) = LiftIO io
zoomActionF lns (StateAction act) = StateAction $ zoom lns act
I'm getting the error:
/Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:65: error:
• Couldn't match type ‘a’ with ‘c’
‘a’ is a rigid type variable bound by
a type expected by the context:
forall a. ActionF s a -> ActionF t a
at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:42
‘c’ is a rigid type variable bound by
the type signature for:
zoom :: forall c.
LensLike' (Zoomed (Action s) c) t s -> Action s c -> Action t c
at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:7
Expected type: LensLike'
(Control.Lens.Internal.Zoom.Focusing IO a) t s
Actual type: LensLike' (Zoomed (Action s) c) t s
• In the first argument of ‘zoomActionF’, namely ‘l’
In the first argument of ‘hoistFree’, namely ‘(zoomActionF l)’
In the second argument of ‘($)’, namely
‘hoistFree (zoomActionF l) actionF’
• Relevant bindings include
actionF :: Free (ActionF s) c
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:22)
l :: LensLike' (Zoomed (Action s) c) t s
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:12)
zoom :: LensLike' (Zoomed (Action s) c) t s
-> Action s c -> Action t c
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:7)
So far as I can tell it's getting confused because the StateT is embedded in the Free constructor and it loses track of the type of a.
I previously had a working version by defining my own zoom function which zoomed the underlying StateT given a 'Lens', but the trick is that I'd like this to also work with Traversal's, so the cleanest way would be to write the zoom instance.
Anyone have an idea of how to get this to compile? Thanks in advance!! If at all possible please try compiling your answers before posting, thanks!
While I couldn't ever get the previous to compile, I came up with an acceptable solution using FreeT as a wrapper around the State monad which simply defers the zooming of the lifted values till later, unfortunately I needed to manually implement MonadTrans and MonadFree as a result, which wasn't terribly easy to figure out. Also interpreting FreeT is a bit tricky without too many good tutorials out there except a (slightly out of date) guide by Gabriel Gonzalez.
Here's what I ended up with
{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language ScopedTypeVariables #-}
module Eve.Internal.Actions
( AppF(..)
, ActionT(..)
, AppT
, execApp
, liftAction
) where
import Control.Monad.State
import Control.Monad.Trans.Free
import Control.Lens
-- | An 'App' has the same base and zoomed values.
type AppT s m a = ActionT s s m a
-- | A Free Functor for storing lifted App actions.
newtype AppF base m next = LiftAction (StateT base m next)
deriving (Functor, Applicative)
-- | Base Action type. Allows paramaterization over application state,
-- zoomed state and underlying monad.
newtype ActionT base zoomed m a = ActionT
{ getAction :: FreeT (AppF base m) (StateT zoomed m) a
} deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed)
instance Monad n => MonadFree (AppF base n) (ActionT base zoomed n) where
wrap (LiftAction act) = join . ActionT . liftF . LiftAction $ act
instance MonadTrans (ActionT base zoomed) where
lift = ActionT . lift . lift
-- | Helper method to run FreeTs.
unLift :: Monad m => FreeT (AppF base m) (StateT base m) a -> StateT base m a
unLift m = do
step <- runFreeT m
case step of
Pure a -> return a
Free (LiftAction next) -> next >>= unLift
-- | Allows 'zoom'ing 'Action's.
type instance Zoomed (ActionT base zoomed m) =
Zoomed (FreeT (AppF base m) (StateT zoomed m))
instance Monad m => Zoom (ActionT base s m) (ActionT base t m) s t where
zoom l (ActionT action) = ActionT $ zoom l action
-- | Given a 'Lens' or 'Traversal' or something similar from "Control.Lens"
-- which focuses the state (t) of an 'Action' from a base state (s),
-- this will convert #Action t a -> Action s a#.
--
-- Given a lens #HasStates s => Lens' s t# it can also convert
-- #Action t a -> App a#
runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c
runAction = zoom
-- | Allows you to run an 'App' or 'AppM' inside of an 'Action' or 'ActionM'
liftAction :: Monad m => AppT base m a -> ActionT base zoomed m a
liftAction = liftF . LiftAction . unLift . getAction
-- | Runs an application and returns the value and state.
runApp :: Monad m => base -> AppT base m a -> m (a, base)
runApp baseState = flip runStateT baseState . unLift . getAction
-- | Runs an application and returns the resulting state.
execApp :: Monad m => base -> AppT base m a -> m base
execApp baseState = fmap snd . runApp baseState
Related
It doesn't look like anything stops you from defining a function like this:
tmp :: (MonadReader Int m, MonadReader Bool m) => m Int
tmp = ifM ask ((+1) <$> ask) ((+2) <$> ask)
So would be something like a typeable context, where as long as you give it a type, ask will give you the part of the environment with that type, which I think is a reasonable alternative to name shadowing.
However, with the default instances of MonadReader defined by Control.Monad.Reader, it doesn't look like there's a way to actually invoke this method. So I defined a new module that attempts to do this:
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses,
UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Control.Monad.Reader.Extra
( MonadReader(ask)
) where
import Control.Monad.Reader (MonadReader(ask, local, reader))
import Control.Monad.Trans.Class (MonadTrans(lift))
instance {-# OVERLAPPABLE #-} ( Monad m
, MonadTrans t
, Monad (t m)
, MonadReader r m
) =>
MonadReader r (t m) where
ask = lift ask
local _ _ = undefined
reader f = lift (reader f)
As long as this second instance is in scope, you'll be able to run tmp, like runReaderT (runReaderT tmp 1) True.
Unfortunately, I can't figure out a decent implementation for local, since it needs to have the type local :: (r -> r) -> (t m a) -> (t m a), but it doesn't seem like there's a way to lift a local :: (r -> r) -> m a -> m a to this.
What would be a reasonable implementation for local for this instance?
Minimal Complete example:
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, LambdaCase, FlexibleContexts #-}
module Tmpfundep where
import Control.Monad.Reader
( MonadReader(ask, local, reader)
, ReaderT(ReaderT)
, runReaderT
)
instance {-# INCOHERENT #-} (Monad m, MonadReader r m) =>
MonadReader r (ReaderT r' m) where
ask = ReaderT (const ask)
local f (ReaderT m) = ReaderT (local f . m)
reader f = ReaderT (const (reader f))
withEnv :: r -> ReaderT r m a -> m a
withEnv r m = runReaderT m r
tmp :: (MonadReader Int m, MonadReader Bool m) => m Int
tmp = ask >>= \case
True -> (+1) <$> ask
False -> (+2) <$> ask
main :: IO ()
main = withEnv True (withEnv (1 :: Int) tmp) >>= print
Was able to run this with echo main | stack exec -- runghc Tmpfundep.hs
I'm trying to implement a Pascal-style write procedure in Haskell as a polyvariadic function. Here is a simplified version with monomorphic result type (IO in that case) that works fine:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import System.IO
class WriteParams a where
writeParams :: IO () -> a
instance (a ~ ()) => WriteParams (IO a) where
writeParams = id
instance (Show a, WriteParams r) => WriteParams (a -> r) where
writeParams m a = writeParams (m >> putStr (show a ++ " "))
write :: WriteParams params => params
write = writeParams (return ())
test :: IO ()
test = do
write 123
write ('a', 'z') True
When changing the result type to a polymorphic type, however, to use that function in different monads that have a MonadIO instance, I'm running into overlapping or undecidable instances. Specifically, that a ~ () trick from the previous version doesn't work anymore. The best approach is the following which requires a lot of type annotations, though:
class WriteParams' m a where
writeParams' :: m () -> a
instance (MonadIO m, m ~ m') => WriteParams' m (m' ()) where
writeParams' m = m
instance (MonadIO m, Show a, WriteParams' m r) => WriteParams' m (a -> r) where
writeParams' m a = writeParams' (m >> liftIO (putStr $ show a ++ " "))
write' :: forall m params . (MonadIO m, WriteParams' m params) => params
write' = writeParams' (return () :: m ())
test' :: IO ()
test' = do
write' 123 () :: IO ()
flip runReaderT () $ do
write' 45 ('a', 'z') :: ReaderT () IO ()
write' True
Is there anyway to make this example work without having to add type annotations here and there and still keep the result type polymorphic?
The two instances overlap, because their indices unify: m' () ~ (a -> r) with m' ~ (->) a and () ~ r.
To pick the first instance whenever m' is not a function type, you can add an OVERLAPPING pragma. (Read more about it in the GHC user guide)
-- We must put the equality (a ~ ()) to the left to make this
-- strictly less specific than (a -> r)
instance (MonadIO m, a ~ ()) => WriteParams (m a) where
writeParams = liftIO
instance {-# OVERLAPPING #-} (Show a, WriteParams r) => WriteParams (a -> r) where
writeParams m a = writeParams (m >> putStr (show a ++ " "))
However, the overlapping instance makes it inconvenient to use write in a context where the monad is a parameter m (try generalizing the signature of test).
There is a way to avoid overlapping instances by using closed type families, to define a type-level boolean that's true if and only if a given type is a function type, so that instances can match on it. See below.
It arguably just looks like more code and more complexity, but, on top of the added expressiveness (we can have a generalized test with a MonadIO constraint), I think this style makes the logic of the instances clearer in the end by isolating the pattern-matching on types.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Main where
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import System.IO
class WriteParams a where
writeParams :: IO () -> a
instance WriteParamsIf a (IsFun a) => WriteParams a where
writeParams = writeParamsIf
type family IsFun a :: Bool where
IsFun (m c) = IsFun1 m
IsFun a = 'False
type family IsFun1 (f :: * -> *) :: Bool where
IsFun1 ((->) b) = 'True
IsFun1 f = 'False
class (isFun ~ IsFun a) => WriteParamsIf a isFun where
writeParamsIf :: IO () -> a
instance (Show a, WriteParams r) => WriteParamsIf (a -> r) 'True where
writeParamsIf m a = writeParams (m >> putStr (show a ++ " "))
instance ('False ~ IsFun (m a), MonadIO m, a ~ ()) => WriteParamsIf (m a) 'False where
writeParamsIf = liftIO
write :: WriteParams params => params
write = writeParams (return ())
test :: (MonadIO m, IsFun1 m ~ 'False) => m ()
test = do
write 123
write ('a', 'z') True
main = test -- for ghc to compile it
Some words on UndecidableInstances
Undecidable instances are an orthogonal feature to overlapping instances, and in fact I think they're much less controversial. Whereas badly using OVERLAPPING may cause incoherence (constraints being solved differently in different contexts), badly using UndecidableInstances may at worst send the compiler in a loop (in practice GHC terminates with an error message once some threshold is reached), which is still bad but when it does manage to resolve instances it is still guaranteed that the solution is unique.
UndecidableInstances lifts limitations that made sense a long time ago, but are now too restrictive to work with the modern extensions to type classes.
In practice, most common type classes and instances defined with UndecidableInstances, including the one above, still guarantee that their resolution will terminate. In fact, there is an active proposal for a new instance termination checker. (I don't know yet whether it handles this case here.)
Here I flesh out my comment into an answer. We will keep the idea of your original class, and even the existing instances, only adding instances. Simply add one instance for each existing MonadIO instance; I'll do just one to illustrate the pattern.
instance (MonadIO m, a ~ ()) => WriteParams (ReaderT r m a) where
writeParams = liftIO
Everything works fine:
main = do
write 45
flip runReaderT () $ do
write 45 ('a', 'z')
write "hi"
This prints 45 45 ('a','z') "hi" when executed.
If you would like to reduce the writeParams = liftIO boilerplate a little bit, you can turn on DefaultSignatures and add:
class WriteParams a where
writeParams :: IO () -> a
default writeParams :: (MonadIO m, a ~ m ()) => IO () -> a
writeParams = liftIO
Then the IO and ReaderT instances are just:
instance a ~ () => WriteParams (IO a)
instance (MonadIO m, a ~ ()) => WriteParams (ReaderT r m a)
having some trouble with a group of monads I'm trying to combine.
I'm using monad-coroutine, State and lens (as I have deeply nested state).
I had an initial approach where there was a working solution. The main point here is that I can request to execute IO tasks outside of Coroutine.
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Main where
import Control.Monad.Coroutine (Coroutine(..), suspend, resume)
import Control.Monad.State (State, MonadState, MonadIO)
import Control.Monad.State (lift, get, put, liftIO, runState)
import System.Environment (getArgs)
type MyType = Coroutine IORequest (State MyState)
instance (MonadState s m) => MonadState s (Coroutine IORequest m) where
get = lift get
put = lift . put
io :: MonadIO m => IO a -> m a
io = liftIO
data IORequest x = forall a. RunIO (IO a) (a -> x)
instance Functor IORequest where
fmap f (RunIO x g) = RunIO x (f . g)
data MyState = MyState { _someInt :: Int }
initialState :: MyState
initialState = MyState 1
request :: Monad m => IO a -> Coroutine IORequest m a
request x = suspend (RunIO x return)
myLogic :: MyType [String]
myLogic = do
args <- request (io getArgs)
request (io (print args))
-- do a lot of useful stuff here
return args
runMyType :: MyType [String] -> MyState -> IO ()
runMyType logic state = do
let (req, state') = runState (resume logic) state
case req of
Left (RunIO cmd q') -> do
result <- cmd
runMyType (q' result) state'
Right _ -> return ()
main :: IO ()
main = runMyType myLogic initialState
Now, at some point a simple State became not enough and I am in a need of ST. I started to try to get the ST inside StateT but for some reason cannot come up with an idea how to properly handle IO outside of coroutine. Is there any way to come up with similar runMyType when there is a change in the Coroutine?
type MyType s = Coroutine IORequest (StateT (MyState s) (ST s))
initialState :: ST s (MyState s)
initialState = do
a <- newSTRef 0
return (MyState a)
Whatever I try to come up with throws some error about s escaping or Couldn't match type ‘s’ with ‘s2’ and so on... Maybe some other order of monad stacking will help? Or is it at all possible?
And another question if you have some time: what is the difference between the above MyType s and this one:
type MyType = forall s. Coroutine IORequest (StateT (MyState s) (ST s))
I have a type alias for a monad transformer stack:
type KStat s a = ReaderT (KStatRoot s) (ExceptT KindError (ST s)) a
I need to abstract users away from this type, largely because the KStatRoot structure was causing cyclic dependencies. I therefore created a separate module and defined a typeclass for it:
class (Monad (m s), MonadError KindError (m s)) =>
MStat m s where
liftToST :: ST s a -> m s a
kstatNewRef :: a -> m s (STRef s a)
kstatReadRef :: STRef s a -> m s a
kstatWriteRef :: STRef s a -> a -> m s ()
This definition compiles OK (albeit needing {-# LANGUAGE MultiParamTypeClasses,FlexibleContexts #-} to work, but I can see why both of those are required), and I've been able to convert some use sites to the typeclass and have them type check, so everything seems OK there. But I'm struggling to work out how to define my instance for the class:
instance MStat (KStat s a) s where
liftToST = lift . lift
kstatNewRef = liftToST . newSTRef
kstatReadRef = liftToST . readSTRef
kstatWriteRef r v = liftToST $ writeSTRef r v
gives me the error:
src/KindLang/Data/KStat.hs:27:17:
The first argument of ‘MStat’ should have kind ‘* -> * -> *’,
but ‘KStat s a’ has kind ‘*’
In the instance declaration for ‘MStat (KStat s a) s’
which kind of makes sense, but then if I change KStat s a to KStat in the instance header I get this error:
src/KindLang/Data/KStat.hs:27:10:
Type synonym ‘KStat’ should have 2 arguments, but has been given none
In the instance declaration for ‘MStat KStat s’
which seems to basically saying the exact opposite.
I'm using these language extensions in the module I declare the instance:
{-# LANGUAGE RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
How do I resolve these errors?
Complete file demonstrating the errors follows:
{-# LANGUAGE RankNTypes, TypeSynonymInstances, FlexibleContexts,
FlexibleInstances, MultiParamTypeClasses #-}
import Control.Monad.Except
import Control.Monad.ST
import Control.Monad.Reader
import Data.STRef
data KStatRoot s = KStatRoot
data KindError
class (Monad (m s), MonadError KindError (m s)) =>
MStat m s where
liftToST :: ST s a -> m s a
kstatNewRef :: a -> m s (STRef s a)
kstatReadRef :: STRef s a -> m s a
kstatWriteRef :: STRef s a -> a -> m s ()
type KStat s a = ReaderT (KStatRoot s) (ExceptT KindError (ST s)) a
instance MStat (KStat s m) s where
liftToST = lift . lift
kstatNewRef = liftToST . newSTRef
kstatReadRef = liftToST . readSTRef
kstatWriteRef r v = liftToST $ writeSTRef r v
The first error is "correct" (you need to use a type of two arguments in the instance declaration), and your attempted fix makes sense.
However, a type synonym doesn't really exist without its arguments. That is, after
type Foo a = ...
you can't use Foo by itself. Foo has to be applied to an argument in order to be processed by the type checker. This is the cause of your second error.
The only workaround I see is changing KStat to a newtype:
newtype KStat s a = KStat{ runKStat :: ReaderT (KStatRoot s) (ExceptT KindError (ST s)) a }
That will let you use KStat without arguments. You'll just have to add explicit runKStat/KStat conversions everywhere.
Consider the following example program:
next :: Int -> Int
next i
| 0 == m2 = d2
| otherwise = 3 * i + 1
where
(d2, m2) = i `divMod` 2
loopIteration :: MaybeT (StateT Int IO) ()
loopIteration = do
i <- get
guard $ i > 1
liftIO $ print i
modify next
main :: IO ()
main = do
(`runStateT` 31) . runMaybeT . forever $ loopIteration
return ()
It can only use get instead of lift get because instance MonadState s m => MonadState s (MaybeT m) is defined in the MaybeT module.
Many such instances are defined in kind of a combinatoric explosion manner.
It would have been nice (although impossible? why?) if we had the following type-class:
{-# LANGUAGE MultiParamTypeClasses #-}
class SuperMonad m s where
lifts :: m a -> s a
Let's try to define it as such:
{-# LANGUAGE FlexibleInstances, ... #-}
instance SuperMonad a a where
lifts = id
instance (SuperMonad a b, MonadTrans t, Monad b) => SuperMonad a (t b) where
lifts = lift . lifts
Using lifts $ print i instead of liftIO $ print i works, which is nice.
But using lifts (get :: StateT Int IO Int) instead of (get :: MaybeT (StateT Int IO) Int) doesn't work.
GHC (6.10.3) gives the following error:
Overlapping instances for SuperMonad
(StateT Int IO) (StateT Int IO)
arising from a use of `lifts'
Matching instances:
instance SuperMonad a a
instance (SuperMonad a b, MonadTrans t, Monad b) =>
SuperMonad a (t b)
In a stmt of a 'do' expression:
i <- lifts (get :: StateT Int IO Int)
I can see why "instance SuperMonad a a" applies. But why does GHC think that the other one does, too?
To follow up ephemient's excellent answer: Haskell type classes use an open-world assumption: some idiot can come along later and add an instance declaration that's not a duplicate and yet overlaps with your instance. Think of it as an adversary game: if an adversary can make your program ambiguous, the compiler bleats.
If you're using GHC you can of course say to the compiler "to hell with your paranoia; allow me my ambiguous instance declaration":
{-# LANGUAGE OverlappingInstances #-}
If later evolution of your program leads to overload resolution you didn't expect, the compiler gets 1,000 I-told-you-so points :-)
Deprecation Note
This pragma has been deprecated since GHC 7.10, and per-instance pragmas should be used instead. More detail can be found in the GHC documentation.
Just because you haven't defined an instance in your current module doesn't mean that one couldn't be defined somewhere else.
{-# LANGUAGE ... #-}
module SomeOtherModule where
-- no practical implementation, but the instance could still be declared
instance SuperMonad (StateT s m) m
Suppose your module and SomeOtherModule are linked together in a single program.
Now, answer this: does your code use
instance SuperMonad a a
-- with a = StateT Int IO
or
instance (SuperMonad a b, MonadTrans t, Monad b) => SuperMonad a (t b)
-- with a = StateT Int IO
-- t = StateT Int
-- b = IO
?
When you have overlapping instances try to attach their behaviour to newtypes:
type SuperEgo :: (k -> Type) -> (k -> Type)
newtype SuperEgo m a = SuperEgo (m a)
type Elevator :: (k -> k1 -> Type) -> (k -> k1 -> Type)
newtype Elevator trans m a = Elevator (trans m a)
instance SuperMonad m (SuperEgo m) where
lifts :: m ~> SuperEgo m
lifts = SuperEgo
instance (SuperMonad m super, Monad super, MonadTrans trans) => SuperMonad m (Elevator trans super) where
lifts :: m ~> Elevator trans super
lifts = Elevator . lift . lifts
Monads can now derive via SuperEgo M to get an identity instances
{-# Language DerivingVia #-}
data Ok a = Ok a
deriving (SuperMonad Ok)
via SuperEgo Ok
It's more of a hassle to define a monad transformer so I'll show how to define a lifting instance for an existing Monad transformers like StateT s. This uses standalone deriving which is more verbose, you need to fill in the class context yourself:
deriving
via Elevator (StateT s) super
instance (Monad super, SuperMonad m super) => SuperMonad m (StateT s super)