{-# LANGUAGE RecursiveDo #-}
module Control.Monad.Trans.Tardis (
TardisT (TardisT, runTardisT)
, evalTardisT
, execTardisT
, Tardis
, runTardis
, evalTardis
, execTardis
, tardis
, getPast
, getFuture
, sendPast
, sendFuture
, modifyForwards
, modifyBackwards
, getsPast
, getsFuture
, mapTardisT
, noState
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Morph
newtype TardisT bw fw m a = TardisT
{ TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT :: (bw, fw) -> m (a, (bw, fw))
}
type Tardis bw fw = TardisT bw fw Identity
runTardis :: Tardis bw fw a -> (bw, fw) -> (a, (bw, fw))
runTardis :: Tardis bw fw a -> (bw, fw) -> (a, (bw, fw))
runTardis Tardis bw fw a
m = Identity (a, (bw, fw)) -> (a, (bw, fw))
forall a. Identity a -> a
runIdentity (Identity (a, (bw, fw)) -> (a, (bw, fw)))
-> ((bw, fw) -> Identity (a, (bw, fw)))
-> (bw, fw)
-> (a, (bw, fw))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tardis bw fw a -> (bw, fw) -> Identity (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT Tardis bw fw a
m
evalTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m a
evalTardisT :: TardisT bw fw m a -> (bw, fw) -> m a
evalTardisT TardisT bw fw m a
t (bw, fw)
s = (a, (bw, fw)) -> a
forall a b. (a, b) -> a
fst ((a, (bw, fw)) -> a) -> m (a, (bw, fw)) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT TardisT bw fw m a
t (bw, fw)
s
execTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m (bw, fw)
execTardisT :: TardisT bw fw m a -> (bw, fw) -> m (bw, fw)
execTardisT TardisT bw fw m a
t (bw, fw)
s = (a, (bw, fw)) -> (bw, fw)
forall a b. (a, b) -> b
snd ((a, (bw, fw)) -> (bw, fw)) -> m (a, (bw, fw)) -> m (bw, fw)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT TardisT bw fw m a
t (bw, fw)
s
evalTardis :: Tardis bw fw a -> (bw, fw) -> a
evalTardis :: Tardis bw fw a -> (bw, fw) -> a
evalTardis Tardis bw fw a
t = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> ((bw, fw) -> Identity a) -> (bw, fw) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tardis bw fw a -> (bw, fw) -> Identity a
forall (m :: * -> *) bw fw a.
Monad m =>
TardisT bw fw m a -> (bw, fw) -> m a
evalTardisT Tardis bw fw a
t
execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw)
execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw)
execTardis Tardis bw fw a
t = Identity (bw, fw) -> (bw, fw)
forall a. Identity a -> a
runIdentity (Identity (bw, fw) -> (bw, fw))
-> ((bw, fw) -> Identity (bw, fw)) -> (bw, fw) -> (bw, fw)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tardis bw fw a -> (bw, fw) -> Identity (bw, fw)
forall (m :: * -> *) bw fw a.
Monad m =>
TardisT bw fw m a -> (bw, fw) -> m (bw, fw)
execTardisT Tardis bw fw a
t
mapTardisT :: (m (a, (bw, fw)) -> n (b, (bw, fw)))
-> TardisT bw fw m a -> TardisT bw fw n b
mapTardisT :: (m (a, (bw, fw)) -> n (b, (bw, fw)))
-> TardisT bw fw m a -> TardisT bw fw n b
mapTardisT m (a, (bw, fw)) -> n (b, (bw, fw))
f TardisT bw fw m a
m = ((bw, fw) -> n (b, (bw, fw))) -> TardisT bw fw n b
forall bw fw (m :: * -> *) a.
((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
TardisT (((bw, fw) -> n (b, (bw, fw))) -> TardisT bw fw n b)
-> ((bw, fw) -> n (b, (bw, fw))) -> TardisT bw fw n b
forall a b. (a -> b) -> a -> b
$ m (a, (bw, fw)) -> n (b, (bw, fw))
f (m (a, (bw, fw)) -> n (b, (bw, fw)))
-> ((bw, fw) -> m (a, (bw, fw))) -> (bw, fw) -> n (b, (bw, fw))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT TardisT bw fw m a
m
noState :: (a, b)
noState :: (a, b)
noState = (a
forall a. HasCallStack => a
undefined, b
forall a. HasCallStack => a
undefined)
instance MonadFix m => Monad (TardisT bw fw m) where
return :: a -> TardisT bw fw m a
return a
x = ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
forall (m :: * -> *) bw fw a.
Monad m =>
((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a)
-> ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
forall a b. (a -> b) -> a -> b
$ \(bw, fw)
s -> (a
x, (bw, fw)
s)
TardisT bw fw m a
m >>= :: TardisT bw fw m a -> (a -> TardisT bw fw m b) -> TardisT bw fw m b
>>= a -> TardisT bw fw m b
f = ((bw, fw) -> m (b, (bw, fw))) -> TardisT bw fw m b
forall bw fw (m :: * -> *) a.
((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
TardisT (((bw, fw) -> m (b, (bw, fw))) -> TardisT bw fw m b)
-> ((bw, fw) -> m (b, (bw, fw))) -> TardisT bw fw m b
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
fw) -> do
rec (a
x, ~(bw
bw'', fw
fw' )) <- TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT TardisT bw fw m a
m (bw
bw', fw
fw)
(b
x', ~(bw
bw' , fw
fw'')) <- TardisT bw fw m b -> (bw, fw) -> m (b, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT (a -> TardisT bw fw m b
f a
x) (bw
bw, fw
fw')
(b, (bw, fw)) -> m (b, (bw, fw))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
x', (bw
bw'', fw
fw''))
instance MonadFix m => Functor (TardisT bw fw m) where
fmap :: (a -> b) -> TardisT bw fw m a -> TardisT bw fw m b
fmap = (a -> b) -> TardisT bw fw m a -> TardisT bw fw m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance MonadFix m => Applicative (TardisT bw fw m) where
pure :: a -> TardisT bw fw m a
pure = a -> TardisT bw fw m a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: TardisT bw fw m (a -> b) -> TardisT bw fw m a -> TardisT bw fw m b
(<*>) = TardisT bw fw m (a -> b) -> TardisT bw fw m a -> TardisT bw fw m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance MonadTrans (TardisT bw fw) where
lift :: m a -> TardisT bw fw m a
lift m a
m = ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall bw fw (m :: * -> *) a.
((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
TardisT (((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a)
-> ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall a b. (a -> b) -> a -> b
$ \(bw, fw)
s -> do
a
x <- m a
m
(a, (bw, fw)) -> m (a, (bw, fw))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, (bw, fw)
s)
instance MonadFix m => MonadFix (TardisT bw fw m) where
mfix :: (a -> TardisT bw fw m a) -> TardisT bw fw m a
mfix a -> TardisT bw fw m a
f = ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall bw fw (m :: * -> *) a.
((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
TardisT (((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a)
-> ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall a b. (a -> b) -> a -> b
$ \(bw, fw)
s -> do
rec (a
x, (bw, fw)
s') <- TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
forall bw fw (m :: * -> *) a.
TardisT bw fw m a -> (bw, fw) -> m (a, (bw, fw))
runTardisT (a -> TardisT bw fw m a
f a
x) (bw, fw)
s
(a, (bw, fw)) -> m (a, (bw, fw))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, (bw, fw)
s')
instance MFunctor (TardisT bw fw) where
hoist :: (forall a. m a -> n a) -> TardisT bw fw m b -> TardisT bw fw n b
hoist forall a. m a -> n a
f = (m (b, (bw, fw)) -> n (b, (bw, fw)))
-> TardisT bw fw m b -> TardisT bw fw n b
forall (m :: * -> *) a bw fw (n :: * -> *) b.
(m (a, (bw, fw)) -> n (b, (bw, fw)))
-> TardisT bw fw m a -> TardisT bw fw n b
mapTardisT m (b, (bw, fw)) -> n (b, (bw, fw))
forall a. m a -> n a
f
tardis :: Monad m => ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis :: ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (bw, fw) -> (a, (bw, fw))
f = ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall bw fw (m :: * -> *) a.
((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
TardisT (((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a)
-> ((bw, fw) -> m (a, (bw, fw))) -> TardisT bw fw m a
forall a b. (a -> b) -> a -> b
$ \(bw, fw)
s -> (a, (bw, fw)) -> m (a, (bw, fw))
forall (m :: * -> *) a. Monad m => a -> m a
return ((bw, fw) -> (a, (bw, fw))
f (bw, fw)
s)
getPast :: Monad m => TardisT bw fw m fw
getPast :: TardisT bw fw m fw
getPast = ((bw, fw) -> (fw, (bw, fw))) -> TardisT bw fw m fw
forall (m :: * -> *) bw fw a.
Monad m =>
((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (((bw, fw) -> (fw, (bw, fw))) -> TardisT bw fw m fw)
-> ((bw, fw) -> (fw, (bw, fw))) -> TardisT bw fw m fw
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
fw) -> (fw
fw, (bw
bw, fw
fw))
getFuture :: Monad m => TardisT bw fw m bw
getFuture :: TardisT bw fw m bw
getFuture = ((bw, fw) -> (bw, (bw, fw))) -> TardisT bw fw m bw
forall (m :: * -> *) bw fw a.
Monad m =>
((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (((bw, fw) -> (bw, (bw, fw))) -> TardisT bw fw m bw)
-> ((bw, fw) -> (bw, (bw, fw))) -> TardisT bw fw m bw
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
fw) -> (bw
bw, (bw
bw, fw
fw))
sendPast :: Monad m => bw -> TardisT bw fw m ()
sendPast :: bw -> TardisT bw fw m ()
sendPast bw
bw' = ((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ()
forall (m :: * -> *) bw fw a.
Monad m =>
((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ())
-> ((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ()
forall a b. (a -> b) -> a -> b
$ \ ~(bw
_bw, fw
fw) -> ((), (bw
bw', fw
fw))
sendFuture :: Monad m => fw -> TardisT bw fw m ()
sendFuture :: fw -> TardisT bw fw m ()
sendFuture fw
fw' = ((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ()
forall (m :: * -> *) bw fw a.
Monad m =>
((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis (((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ())
-> ((bw, fw) -> ((), (bw, fw))) -> TardisT bw fw m ()
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
_fw) -> ((), (bw
bw, fw
fw'))
modifyForwards :: MonadFix m => (fw -> fw) -> TardisT bw fw m ()
modifyForwards :: (fw -> fw) -> TardisT bw fw m ()
modifyForwards fw -> fw
f = TardisT bw fw m fw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m fw
getPast TardisT bw fw m fw
-> (fw -> TardisT bw fw m ()) -> TardisT bw fw m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= fw -> TardisT bw fw m ()
forall (m :: * -> *) fw bw. Monad m => fw -> TardisT bw fw m ()
sendFuture (fw -> TardisT bw fw m ())
-> (fw -> fw) -> fw -> TardisT bw fw m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fw -> fw
f
modifyBackwards :: MonadFix m => (bw -> bw) -> TardisT bw fw m ()
modifyBackwards :: (bw -> bw) -> TardisT bw fw m ()
modifyBackwards bw -> bw
f = do
rec
bw -> TardisT bw fw m ()
forall (m :: * -> *) bw fw. Monad m => bw -> TardisT bw fw m ()
sendPast (bw -> bw
f bw
x)
bw
x <- TardisT bw fw m bw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m bw
getFuture
() -> TardisT bw fw m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getsPast :: MonadFix m => (fw -> a) -> TardisT bw fw m a
getsPast :: (fw -> a) -> TardisT bw fw m a
getsPast fw -> a
f = (fw -> a) -> TardisT bw fw m fw -> TardisT bw fw m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap fw -> a
f TardisT bw fw m fw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m fw
getPast
getsFuture :: MonadFix m => (bw -> a) -> TardisT bw fw m a
getsFuture :: (bw -> a) -> TardisT bw fw m a
getsFuture bw -> a
f = (bw -> a) -> TardisT bw fw m bw -> TardisT bw fw m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap bw -> a
f TardisT bw fw m bw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m bw
getFuture