{-# LANGUAGE RecursiveDo            #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances      #-}

-- | The class definition of a Tardis,
-- as well as a few straightforward combinators
-- based on its primitives.
--
-- See Control.Monad.Tardis for the general explanation
-- of what a Tardis is and how to use it.
module Control.Monad.Tardis.Class
  ( -- * The MonadTardis class
    MonadTardis (..)
    -- * Composite Tardis operations
  , modifyForwards
  , modifyBackwards
  , getsPast
  , getsFuture
  ) where

import Control.Applicative
import Control.Monad.Fix

import qualified Control.Monad.Trans.Tardis as T

-- | A Tardis is parameterized by two state streams:
-- a 'backwards-traveling' state and a 'forwards-traveling' state.
-- This library consistently puts the backwards-traveling state first
-- whenever the two are seen together.
-- 
-- Minimal complete definition:
-- ("tardis") or
-- ("getPast", "getFuture", "sendPast", and "sendFuture").
class (Applicative m, MonadFix m) => MonadTardis bw fw m | m -> bw, m -> fw where
  -- | Retrieve the current value of the 'forwards-traveling' state,
  -- which therefore came forwards from the past.
  -- You can think of forwards-traveling state as traveling
  -- 'downwards' through your code.
  getPast    :: m fw
  
  -- | Retrieve the current value of the 'backwards-traveling' state,
  -- which therefore came backwards from the future.
  -- You can think of backwards-traveling state as traveling
  -- 'upwards' through your code.
  getFuture  :: m bw
  
  -- | Set the current value of the 'backwards-traveling' state,
  -- which will therefore be sent backwards to the past.
  -- This value can be retrieved by calls to "getFuture"
  -- located 'above' the current location,
  -- unless it is overwritten by an intervening "sendPast".
  sendPast   :: bw -> m ()
  
  -- | Set the current value of the 'forwards-traveling' state,
  -- which will therefore be sent forwards to the future.
  -- This value can be retrieved by calls to "getPast"
  -- located 'below' the current location,
  -- unless it is overwritten by an intervening "sendFuture".
  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'))

  -- | A Tardis is merely a pure state transformation.
  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

-- | Modify the forwards-traveling state
-- as it passes through from past to future.
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

-- | Modify the backwards-traveling state
-- as it passes through from future to past.
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 ()

-- | Retrieve a specific view of the forwards-traveling state.
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

-- | Retrieve a specific view of the backwards-traveling state.
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