{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
module Control.Monad.Tardis.Class
(
MonadTardis (..)
, modifyForwards
, modifyBackwards
, getsPast
, getsFuture
) where
import Control.Applicative
import Control.Monad.Fix
import qualified Control.Monad.Trans.Tardis as T
class (Applicative m, MonadFix m) => MonadTardis bw fw m | m -> bw, m -> fw where
getPast :: m fw
getFuture :: m bw
sendPast :: bw -> m ()
sendFuture :: fw -> m ()
getPast = ((bw, fw) -> (fw, (bw, fw))) -> m fw
forall bw fw (m :: * -> *) a.
MonadTardis bw fw m =>
((bw, fw) -> (a, (bw, fw))) -> m a
tardis (((bw, fw) -> (fw, (bw, fw))) -> m fw)
-> ((bw, fw) -> (fw, (bw, fw))) -> m fw
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
fw) -> (fw
fw, (bw
bw, fw
fw))
getFuture = ((bw, fw) -> (bw, (bw, fw))) -> m bw
forall bw fw (m :: * -> *) a.
MonadTardis bw fw m =>
((bw, fw) -> (a, (bw, fw))) -> m a
tardis (((bw, fw) -> (bw, (bw, fw))) -> m bw)
-> ((bw, fw) -> (bw, (bw, fw))) -> m bw
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
fw) -> (bw
bw, (bw
bw, fw
fw))
sendPast bw
bw' = ((bw, fw) -> ((), (bw, fw))) -> m ()
forall bw fw (m :: * -> *) a.
MonadTardis bw fw m =>
((bw, fw) -> (a, (bw, fw))) -> m a
tardis (((bw, fw) -> ((), (bw, fw))) -> m ())
-> ((bw, fw) -> ((), (bw, fw))) -> m ()
forall a b. (a -> b) -> a -> b
$ \ ~(bw
_bw, fw
fw) -> ((), (bw
bw', fw
fw))
sendFuture fw
fw' = ((bw, fw) -> ((), (bw, fw))) -> m ()
forall bw fw (m :: * -> *) a.
MonadTardis bw fw m =>
((bw, fw) -> (a, (bw, fw))) -> m a
tardis (((bw, fw) -> ((), (bw, fw))) -> m ())
-> ((bw, fw) -> ((), (bw, fw))) -> m ()
forall a b. (a -> b) -> a -> b
$ \ ~(bw
bw, fw
_fw) -> ((), (bw
bw, fw
fw'))
tardis :: ((bw, fw) -> (a, (bw, fw))) -> m a
tardis (bw, fw) -> (a, (bw, fw))
f = do
rec
let (a
a, (bw
future', fw
past')) = (bw, fw) -> (a, (bw, fw))
f (bw
future, fw
past)
bw -> m ()
forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast bw
future'
fw
past <- m fw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
bw
future <- m bw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
fw -> m ()
forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture fw
past'
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
modifyForwards :: MonadTardis bw fw m => (fw -> fw) -> m ()
modifyForwards :: (fw -> fw) -> m ()
modifyForwards fw -> fw
f = m fw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast m fw -> (fw -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= fw -> m ()
forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (fw -> m ()) -> (fw -> fw) -> fw -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fw -> fw
f
modifyBackwards :: MonadTardis bw fw m => (bw -> bw) -> m ()
modifyBackwards :: (bw -> bw) -> m ()
modifyBackwards bw -> bw
f = do
rec
bw -> m ()
forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (bw -> bw
f bw
x)
bw
x <- m bw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getsPast :: MonadTardis bw fw m => (fw -> a) -> m a
getsPast :: (fw -> a) -> m a
getsPast fw -> a
f = fw -> a
f (fw -> a) -> m fw -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m fw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
getsFuture :: MonadTardis bw fw m => (bw -> a) -> m a
getsFuture :: (bw -> a) -> m a
getsFuture bw -> a
f = bw -> a
f (bw -> a) -> m bw -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m bw
forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
instance MonadFix m => MonadTardis bw fw (T.TardisT bw fw m) where
getPast :: TardisT bw fw m fw
getPast = TardisT bw fw m fw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m fw
T.getPast
getFuture :: TardisT bw fw m bw
getFuture = TardisT bw fw m bw
forall (m :: * -> *) bw fw. Monad m => TardisT bw fw m bw
T.getFuture
sendPast :: bw -> TardisT bw fw m ()
sendPast = bw -> TardisT bw fw m ()
forall (m :: * -> *) bw fw. Monad m => bw -> TardisT bw fw m ()
T.sendPast
sendFuture :: fw -> TardisT bw fw m ()
sendFuture = fw -> TardisT bw fw m ()
forall (m :: * -> *) fw bw. Monad m => fw -> TardisT bw fw m ()
T.sendFuture
tardis :: ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a
tardis = ((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
T.tardis