{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Trans.Chronicle (
Chronicle, chronicle, runChronicle,
ChronicleT(..),
dictate, disclose, confess,
memento, absolve, condemn,
retcon,
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Trans
import Data.Default.Class
import Data.Functor.Identity
import Data.Semigroup
import Control.Monad.Error.Class
import Control.Monad.Reader.Class
import Control.Monad.RWS.Class
import Data.These
import Data.These.Combinators (mapHere)
import Prelude
#ifdef MIN_VERSION_semigroupoids
import Data.Functor.Apply (Apply (..))
import Data.Functor.Bind (Bind (..))
#endif
type Chronicle c = ChronicleT c Identity
chronicle :: Monad m => These c a -> ChronicleT c m a
chronicle :: These c a -> ChronicleT c m a
chronicle = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> (These c a -> m (These c a)) -> These c a -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These c a -> m (These c a)
forall (m :: * -> *) a. Monad m => a -> m a
return
runChronicle :: Chronicle c a -> These c a
runChronicle :: Chronicle c a -> These c a
runChronicle = Identity (These c a) -> These c a
forall a. Identity a -> a
runIdentity (Identity (These c a) -> These c a)
-> (Chronicle c a -> Identity (These c a))
-> Chronicle c a
-> These c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chronicle c a -> Identity (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT
newtype ChronicleT c m a = ChronicleT { ChronicleT c m a -> m (These c a)
runChronicleT :: m (These c a) }
instance (Functor m) => Functor (ChronicleT c m) where
fmap :: (a -> b) -> ChronicleT c m a -> ChronicleT c m b
fmap a -> b
f (ChronicleT m (These c a)
c) = m (These c b) -> ChronicleT c m b
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT ((a -> b) -> These c a -> These c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (These c a -> These c b) -> m (These c a) -> m (These c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (These c a)
c)
#ifdef MIN_VERSION_semigroupoids
instance (Semigroup c, Apply m) => Apply (ChronicleT c m) where
ChronicleT m (These c (a -> b))
f <.> :: ChronicleT c m (a -> b) -> ChronicleT c m a -> ChronicleT c m b
<.> ChronicleT m (These c a)
x = m (These c b) -> ChronicleT c m b
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (These c (a -> b) -> These c a -> These c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (These c (a -> b) -> These c a -> These c b)
-> m (These c (a -> b)) -> m (These c a -> These c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (These c (a -> b))
f m (These c a -> These c b) -> m (These c a) -> m (These c b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> m (These c a)
x)
instance (Semigroup c, Apply m, Monad m) => Bind (ChronicleT c m) where
>>- :: ChronicleT c m a -> (a -> ChronicleT c m b) -> ChronicleT c m b
(>>-) = ChronicleT c m a -> (a -> ChronicleT c m b) -> ChronicleT c m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
#endif
instance (Semigroup c, Applicative m) => Applicative (ChronicleT c m) where
pure :: a -> ChronicleT c m a
pure = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> (a -> m (These c a)) -> a -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These c a -> m (These c a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These c a -> m (These c a))
-> (a -> These c a) -> a -> m (These c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ChronicleT m (These c (a -> b))
f <*> :: ChronicleT c m (a -> b) -> ChronicleT c m a -> ChronicleT c m b
<*> ChronicleT m (These c a)
x = m (These c b) -> ChronicleT c m b
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT ((These c (a -> b) -> These c a -> These c b)
-> m (These c (a -> b)) -> m (These c a) -> m (These c b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 These c (a -> b) -> These c a -> These c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) m (These c (a -> b))
f m (These c a)
x)
instance (Semigroup c, Monad m) => Monad (ChronicleT c m) where
return :: a -> ChronicleT c m a
return = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> (a -> m (These c a)) -> a -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These c a -> m (These c a)
forall (m :: * -> *) a. Monad m => a -> m a
return (These c a -> m (These c a))
-> (a -> These c a) -> a -> m (These c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These c a
forall (m :: * -> *) a. Monad m => a -> m a
return
ChronicleT c m a
m >>= :: ChronicleT c m a -> (a -> ChronicleT c m b) -> ChronicleT c m b
>>= a -> ChronicleT c m b
k = m (These c b) -> ChronicleT c m b
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c b) -> ChronicleT c m b)
-> m (These c b) -> ChronicleT c m b
forall a b. (a -> b) -> a -> b
$
do These c a
cx <- ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT ChronicleT c m a
m
case These c a
cx of
This c
a -> These c b -> m (These c b)
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> These c b
forall a b. a -> These a b
This c
a)
That a
x -> ChronicleT c m b -> m (These c b)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT (a -> ChronicleT c m b
k a
x)
These c
a a
x -> do These c b
cy <- ChronicleT c m b -> m (These c b)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT (a -> ChronicleT c m b
k a
x)
These c b -> m (These c b)
forall (m :: * -> *) a. Monad m => a -> m a
return (These c b -> m (These c b)) -> These c b -> m (These c b)
forall a b. (a -> b) -> a -> b
$ case These c b
cy of
This c
b -> c -> These c b
forall a b. a -> These a b
This (c
a c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
b)
That b
y -> c -> b -> These c b
forall a b. a -> b -> These a b
These c
a b
y
These c
b b
y -> c -> b -> These c b
forall a b. a -> b -> These a b
These (c
a c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
b) b
y
instance (Semigroup c) => MonadTrans (ChronicleT c) where
lift :: m a -> ChronicleT c m a
lift m a
m = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (a -> These c a
forall a b. b -> These a b
That (a -> These c a) -> m a -> m (These c a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
m)
instance (Semigroup c, MonadIO m) => MonadIO (ChronicleT c m) where
liftIO :: IO a -> ChronicleT c m a
liftIO = m a -> ChronicleT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChronicleT c m a)
-> (IO a -> m a) -> IO a -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (Semigroup c, Monoid c, Applicative m, Monad m) => Alternative (ChronicleT c m) where
empty :: ChronicleT c m a
empty = ChronicleT c m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: ChronicleT c m a -> ChronicleT c m a -> ChronicleT c m a
(<|>) = ChronicleT c m a -> ChronicleT c m a -> ChronicleT c m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance (Semigroup c, Monoid c, Monad m) => MonadPlus (ChronicleT c m) where
mzero :: ChronicleT c m a
mzero = c -> ChronicleT c m a
forall c (m :: * -> *) a.
(Semigroup c, Monad m) =>
c -> ChronicleT c m a
confess c
forall a. Monoid a => a
mempty
mplus :: ChronicleT c m a -> ChronicleT c m a -> ChronicleT c m a
mplus ChronicleT c m a
x ChronicleT c m a
y = do Either c a
x' <- ChronicleT c m a -> ChronicleT c m (Either c a)
forall c (m :: * -> *) a.
(Semigroup c, Monad m) =>
ChronicleT c m a -> ChronicleT c m (Either c a)
memento ChronicleT c m a
x
case Either c a
x' of
Left c
_ -> ChronicleT c m a
y
Right a
r -> a -> ChronicleT c m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
instance (Semigroup c, MonadError e m) => MonadError e (ChronicleT c m) where
throwError :: e -> ChronicleT c m a
throwError = m a -> ChronicleT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChronicleT c m a) -> (e -> m a) -> e -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: ChronicleT c m a -> (e -> ChronicleT c m a) -> ChronicleT c m a
catchError (ChronicleT m (These c a)
m) e -> ChronicleT c m a
c = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ m (These c a) -> (e -> m (These c a)) -> m (These c a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m (These c a)
m (ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT (ChronicleT c m a -> m (These c a))
-> (e -> ChronicleT c m a) -> e -> m (These c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ChronicleT c m a
c)
instance (Semigroup c, MonadReader r m) => MonadReader r (ChronicleT c m) where
ask :: ChronicleT c m r
ask = m r -> ChronicleT c m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> ChronicleT c m a -> ChronicleT c m a
local r -> r
f (ChronicleT m (These c a)
m) = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m (These c a) -> m (These c a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f m (These c a)
m
reader :: (r -> a) -> ChronicleT c m a
reader = m a -> ChronicleT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChronicleT c m a)
-> ((r -> a) -> m a) -> (r -> a) -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
instance (Semigroup c, MonadRWS r w s m) => MonadRWS r w s (ChronicleT c m) where
instance (Semigroup c, MonadState s m) => MonadState s (ChronicleT c m) where
get :: ChronicleT c m s
get = m s -> ChronicleT c m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> ChronicleT c m ()
put = m () -> ChronicleT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ChronicleT c m ())
-> (s -> m ()) -> s -> ChronicleT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: (s -> (a, s)) -> ChronicleT c m a
state = m a -> ChronicleT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChronicleT c m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance (Semigroup c, MonadWriter w m) => MonadWriter w (ChronicleT c m) where
tell :: w -> ChronicleT c m ()
tell = m () -> ChronicleT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ChronicleT c m ())
-> (w -> m ()) -> w -> ChronicleT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: ChronicleT c m a -> ChronicleT c m (a, w)
listen (ChronicleT m (These c a)
m) = m (These c (a, w)) -> ChronicleT c m (a, w)
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c (a, w)) -> ChronicleT c m (a, w))
-> m (These c (a, w)) -> ChronicleT c m (a, w)
forall a b. (a -> b) -> a -> b
$ do
(These c a
m', w
w) <- m (These c a) -> m (These c a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (These c a)
m
These c (a, w) -> m (These c (a, w))
forall (m :: * -> *) a. Monad m => a -> m a
return (These c (a, w) -> m (These c (a, w)))
-> These c (a, w) -> m (These c (a, w))
forall a b. (a -> b) -> a -> b
$ case These c a
m' of
This c
c -> c -> These c (a, w)
forall a b. a -> These a b
This c
c
That a
x -> (a, w) -> These c (a, w)
forall a b. b -> These a b
That (a
x, w
w)
These c
c a
x -> c -> (a, w) -> These c (a, w)
forall a b. a -> b -> These a b
These c
c (a
x, w
w)
pass :: ChronicleT c m (a, w -> w) -> ChronicleT c m a
pass (ChronicleT m (These c (a, w -> w))
m) = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ do
m (These c a, w -> w) -> m (These c a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (These c a, w -> w) -> m (These c a))
-> m (These c a, w -> w) -> m (These c a)
forall a b. (a -> b) -> a -> b
$ (c -> (These c a, w -> w))
-> ((a, w -> w) -> (These c a, w -> w))
-> (c -> (a, w -> w) -> (These c a, w -> w))
-> These c (a, w -> w)
-> (These c a, w -> w)
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (\c
c -> (c -> These c a
forall a b. a -> These a b
This c
c, w -> w
forall a. a -> a
id))
(\(a
x, w -> w
f) -> (a -> These c a
forall a b. b -> These a b
That a
x, w -> w
f))
(\c
c (a
x, w -> w
f) -> (c -> a -> These c a
forall a b. a -> b -> These a b
These c
c a
x, w -> w
f)) (These c (a, w -> w) -> (These c a, w -> w))
-> m (These c (a, w -> w)) -> m (These c a, w -> w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (These c (a, w -> w))
m
writer :: (a, w) -> ChronicleT c m a
writer = m a -> ChronicleT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChronicleT c m a)
-> ((a, w) -> m a) -> (a, w) -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
instance (Semigroup c, MonadFix m) => MonadFix (ChronicleT c m) where
mfix :: (a -> ChronicleT c m a) -> ChronicleT c m a
mfix a -> ChronicleT c m a
f = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT ((These c a -> m (These c a)) -> m (These c a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT (ChronicleT c m a -> m (These c a))
-> (These c a -> ChronicleT c m a) -> These c a -> m (These c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ChronicleT c m a
f (a -> ChronicleT c m a)
-> (These c a -> a) -> These c a -> ChronicleT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> a) -> (a -> a) -> (c -> a -> a) -> These c a -> a
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (a -> c -> a
forall a b. a -> b -> a
const a
forall a. a
bomb) a -> a
forall a. a -> a
id ((a -> c -> a) -> c -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> c -> a
forall a b. a -> b -> a
const)))
where bomb :: a
bomb = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"mfix (ChronicleT): inner compuation returned This value"
dictate :: (Semigroup c, Monad m) => c -> ChronicleT c m ()
dictate :: c -> ChronicleT c m ()
dictate c
c = m (These c ()) -> ChronicleT c m ()
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c ()) -> ChronicleT c m ())
-> m (These c ()) -> ChronicleT c m ()
forall a b. (a -> b) -> a -> b
$ These c () -> m (These c ())
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> () -> These c ()
forall a b. a -> b -> These a b
These c
c ())
disclose :: (Default a, Semigroup c, Monad m) => c -> ChronicleT c m a
disclose :: c -> ChronicleT c m a
disclose c
c = c -> ChronicleT c m ()
forall c (m :: * -> *).
(Semigroup c, Monad m) =>
c -> ChronicleT c m ()
dictate c
c ChronicleT c m () -> ChronicleT c m a -> ChronicleT c m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ChronicleT c m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Default a => a
def
confess :: (Semigroup c, Monad m) => c -> ChronicleT c m a
confess :: c -> ChronicleT c m a
confess c
c = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ These c a -> m (These c a)
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> These c a
forall a b. a -> These a b
This c
c)
memento :: (Semigroup c, Monad m) => ChronicleT c m a -> ChronicleT c m (Either c a)
memento :: ChronicleT c m a -> ChronicleT c m (Either c a)
memento ChronicleT c m a
m = m (These c (Either c a)) -> ChronicleT c m (Either c a)
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c (Either c a)) -> ChronicleT c m (Either c a))
-> m (These c (Either c a)) -> ChronicleT c m (Either c a)
forall a b. (a -> b) -> a -> b
$
do These c a
cx <- ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT ChronicleT c m a
m
These c (Either c a) -> m (These c (Either c a))
forall (m :: * -> *) a. Monad m => a -> m a
return (These c (Either c a) -> m (These c (Either c a)))
-> These c (Either c a) -> m (These c (Either c a))
forall a b. (a -> b) -> a -> b
$ case These c a
cx of
This c
a -> Either c a -> These c (Either c a)
forall a b. b -> These a b
That (c -> Either c a
forall a b. a -> Either a b
Left c
a)
That a
x -> Either c a -> These c (Either c a)
forall a b. b -> These a b
That (a -> Either c a
forall a b. b -> Either a b
Right a
x)
These c
a a
x -> c -> Either c a -> These c (Either c a)
forall a b. a -> b -> These a b
These c
a (a -> Either c a
forall a b. b -> Either a b
Right a
x)
absolve :: (Semigroup c, Monad m) => a -> ChronicleT c m a -> ChronicleT c m a
absolve :: a -> ChronicleT c m a -> ChronicleT c m a
absolve a
x ChronicleT c m a
m = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$
do These c a
cy <- ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT ChronicleT c m a
m
These c a -> m (These c a)
forall (m :: * -> *) a. Monad m => a -> m a
return (These c a -> m (These c a)) -> These c a -> m (These c a)
forall a b. (a -> b) -> a -> b
$ case These c a
cy of
This c
_ -> a -> These c a
forall a b. b -> These a b
That a
x
That a
y -> a -> These c a
forall a b. b -> These a b
That a
y
These c
_ a
y -> a -> These c a
forall a b. b -> These a b
That a
y
condemn :: (Semigroup c, Monad m) => ChronicleT c m a -> ChronicleT c m a
condemn :: ChronicleT c m a -> ChronicleT c m a
condemn (ChronicleT m (These c a)
m) = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ do
These c a
m' <- m (These c a)
m
These c a -> m (These c a)
forall (m :: * -> *) a. Monad m => a -> m a
return (These c a -> m (These c a)) -> These c a -> m (These c a)
forall a b. (a -> b) -> a -> b
$ case These c a
m' of
This c
x -> c -> These c a
forall a b. a -> These a b
This c
x
That a
y -> a -> These c a
forall a b. b -> These a b
That a
y
These c
x a
_ -> c -> These c a
forall a b. a -> These a b
This c
x
retcon :: (Semigroup c, Monad m) => (c -> c) -> ChronicleT c m a -> ChronicleT c m a
retcon :: (c -> c) -> ChronicleT c m a -> ChronicleT c m a
retcon c -> c
f ChronicleT c m a
m = m (These c a) -> ChronicleT c m a
forall c (m :: * -> *) a. m (These c a) -> ChronicleT c m a
ChronicleT (m (These c a) -> ChronicleT c m a)
-> m (These c a) -> ChronicleT c m a
forall a b. (a -> b) -> a -> b
$ (c -> c) -> These c a -> These c a
forall a c b. (a -> c) -> These a b -> These c b
mapHere c -> c
f (These c a -> These c a) -> m (These c a) -> m (These c a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ChronicleT c m a -> m (These c a)
forall c (m :: * -> *) a. ChronicleT c m a -> m (These c a)
runChronicleT ChronicleT c m a
m