diff --git a/Control/Monad/Tardis.hs b/Control/Monad/Tardis.hs deleted file mode 100644 --- a/Control/Monad/Tardis.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - --- | This module re-exports both 'MonadTardis' and 'TardisT' --- (Wherever there is overlap, the 'MonadTardis' version is preferred.) --- --- The recommended usage of a Tardis is to import this module. -module Control.Monad.Tardis - ( -- * Re-exports - module Control.Monad.Trans.Tardis - , module Control.Monad.Tardis.Class - - -- * What is a Tardis? - -- $whatis - - -- * How do you use a Tardis? - -- $howuse - ) where - - -import Control.Monad.Tardis.Class -import Control.Monad.Trans.Tardis - ( TardisT - , runTardisT - , evalTardisT - , execTardisT - - , Tardis - , runTardis - , evalTardis - , execTardis - - , noState - ) - - -{- $whatis - A Tardis is the combination of the State monad transformer - and the Reverse State monad transformer. - - The State monad transformer features a forwards-traveling state. - You can retrieve the current value of the state, - and you can set its value, affecting any future attempts - to retrieve it. - - The Reverse State monad transformer is just the opposite: - it features a backwards-traveling state. - You can retrieve the current value of the state, - and you can set its value, affecting any /past/ attempts - to retrieve it. This is a bit weirder than its - forwards-traveling counterpart, so its Monad instance - additionally requires that the underlying Monad it transforms - must be an instance of MonadFix. - - A Tardis is nothing more than mashing these two things together. - A Tardis gives you /two/ states: one which travels /backwards/ - (or /upwards/) through your code (referred to as @bw@), - and one which travels /forwards/ (or /downwards/) through your code - (referred to as @fw@). You can retrieve the current - value of either state, and you can set the value of either state. - Setting the forwards-traveling state will affect the /future/, - while setting the backwards-traveling state will affect the /past/. - Take a look at how Monadic bind is implemented for 'TardisT': - -> m >>= f = TardisT $ \ ~(bw, fw) -> do -> rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) -> (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') -> return (x', (bw'', fw'')) - - Like the Reverse State monad transformer, TardisT's Monad instance - requires that the monad it transforms is an instance of MonadFix, - as is evidenced by the use of @rec@. - Notice how the forwards-traveling state travels /normally/: - first it is fed to @m@, producing @fw'@, and then it is fed to @f x@, - producing @fw''@. The backwards-traveling state travels in the opposite - direction: first it is fed to @f x@, producing @bw'@, and then - it is fed to @m@, producing @bw''@. - --} - -{- $howuse - A Tardis provides four primitive operations, - corresponding to the /get/ and /put/ for each of its two states. - The most concise way to explain it is this: - 'getPast' retrieves the value from the latest 'sendFuture', - while 'getFuture' retrieves the value from the next 'sendPast'. - Beware the pitfall of performing send and get in the wrong order. - Let's consider forwards-traveling state: - -> do sendFuture "foo" -> x <- getPast - - In this code snippet, @x@ will be @\"foo\"@, because 'getPast' - grabs the value from the latest 'sendFuture'. If you wanted - to observe that state /before/ overwriting it with @\"foo\"@, - then re-arrange the code so that 'getPast' happens earlier - than 'sendFuture'. Now let's consider backwards-traveling state: - -> do x <- getFuture -> sendPast "bar" - - In this code snippet, @x@ will be @\"bar\"@, because 'getFuture' - grabs the value from the next 'sendPast'. If you wanted - to observe that state /before/ overwriting it with @\"bar\"@, - then re-arrange the code so that 'getFuture' happens later - than 'sendPast'. - - TardisT is an instance of MonadFix. This is especially important - when attempting to write backwards-traveling code, because - the name binding occurs later than its usage. - The result of the following code will be @(11, \"Dan Burton\")@. - -> flip execTardis (10, "Dan") $ do -> name <- getPast -> sendFuture (name ++ " Burton") -> rec -> sendPast (score + 1) -> score <- getFuture -> return () - - To avoid using @rec@, you may find 'modifyBackwards' to be useful. - This code is equivalent to the previous example: - -> flip execTardis (10, "Dan") $ do -> modifyForwards (++ " Burton") -> modifyBackwards (+ 1) - --} - diff --git a/Control/Monad/Tardis/Class.hs b/Control/Monad/Tardis/Class.hs deleted file mode 100644 --- a/Control/Monad/Tardis/Class.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# OPTIONS_GHC -Wall -fno-warn-warnings-deprecations #-} -{-# LANGUAGE DoRec #-} -{-# 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 = tardis $ \ ~(bw, fw) -> (fw, (bw, fw)) - getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) - sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) - sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) - - -- | A Tardis is merely a pure state transformation. - tardis :: ((bw, fw) -> (a, (bw, fw))) -> m a - tardis f = do - rec - let (a, (future', past')) = f (future, past) - sendPast future' - past <- getPast - future <- getFuture - sendFuture past' - return a - --- | Modify the forwards-traveling state --- as it passes through from past to future. -modifyForwards :: MonadTardis bw fw m => (fw -> fw) -> m () -modifyForwards f = getPast >>= sendFuture . f - --- | Modify the backwards-traveling state --- as it passes through from future to past. -modifyBackwards :: MonadTardis bw fw m => (bw -> bw) -> m () -modifyBackwards f = do - rec - sendPast (f x) - x <- getFuture - return () - --- | Retrieve a specific view of the forwards-traveling state. -getsPast :: MonadTardis bw fw m => (fw -> a) -> m a -getsPast f = f <$> getPast - --- | Retrieve a specific view of the backwards-traveling state. -getsFuture :: MonadTardis bw fw m => (bw -> a) -> m a -getsFuture f = f <$> getFuture - - -instance MonadFix m => MonadTardis bw fw (T.TardisT bw fw m) where - getPast = T.getPast - getFuture = T.getFuture - sendPast = T.sendPast - sendFuture = T.sendFuture - tardis = T.tardis diff --git a/Control/Monad/Trans/Tardis.hs b/Control/Monad/Trans/Tardis.hs deleted file mode 100644 --- a/Control/Monad/Trans/Tardis.hs +++ /dev/null @@ -1,212 +0,0 @@ -{-# OPTIONS_GHC -Wall -fno-warn-warnings-deprecations #-} -{-# LANGUAGE DoRec #-} - - --- | The data definition of a "TardisT" --- as well as its primitive operations, --- and straightforward combinators based on the primitives. --- --- See Control.Monad.Tardis for the general explanation --- of what a Tardis is and how to use it. -module Control.Monad.Trans.Tardis ( - -- * The Tardis monad transformer - TardisT (TardisT, runTardisT) - , evalTardisT - , execTardisT - - -- * The Tardis monad - , Tardis - , runTardis - , evalTardis - , execTardis - - -- * Primitive Tardis operations - , tardis - - , getPast - , getFuture - , sendPast - , sendFuture - - -- * Composite Tardis operations - , modifyForwards - , modifyBackwards - - , getsPast - , getsFuture - - -- * Other - , mapTardisT - , noState - ) where - -import Control.Applicative -import Control.Monad.Identity -import Control.Monad.Trans -import Control.Monad.Morph - - --- Definition -------------------------------------------------- - --- | A TardisT 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. -newtype TardisT bw fw m a = TardisT - { runTardisT :: (bw, fw) -> m (a, (bw, fw)) - -- ^ A TardisT is merely an effectful state transformation - } - --- | Using a Tardis with no monad underneath --- will prove to be most common use case. --- Practical uses of a TardisT require that the --- underlying monad be an instance of MonadFix, --- but note that the IO instance of MonadFix --- is almost certainly unsuitable for use with --- Tardis code. -type Tardis bw fw = TardisT bw fw Identity - --- | A Tardis is merely a pure state transformation. -runTardis :: Tardis bw fw a -> (bw, fw) -> (a, (bw, fw)) -runTardis m = runIdentity . runTardisT m - - --- Helpers -------------------------------------------------- - --- | Run a Tardis, and discard the final state, --- observing only the resultant value. -evalTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m a -evalTardisT t s = fst `liftM` runTardisT t s - --- | Run a Tardis, and discard the resultant value, --- observing only the final state (of both streams). --- Note that the 'final' state of the backwards-traveling state --- is the state it reaches by traveling from the 'bottom' --- of your code to the 'top'. -execTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m (bw, fw) -execTardisT t s = snd `liftM` runTardisT t s - - --- | Run a Tardis, and discard the final state, --- observing only the resultant value. -evalTardis :: Tardis bw fw a -> (bw, fw) -> a -evalTardis t = runIdentity . evalTardisT t - --- | Run a Tardis, and discard the resultant value, --- observing only the final state (of both streams). -execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw) -execTardis t = runIdentity . execTardisT t - - --- | A function that operates on the internal representation of a Tardis --- can also be used on a Tardis. -mapTardisT :: (m (a, (bw, fw)) -> n (b, (bw, fw))) - -> TardisT bw fw m a -> TardisT bw fw n b -mapTardisT f m = TardisT $ f . runTardisT m - --- | Some Tardises never observe the 'initial' state --- of either state stream, so it is convenient --- to simply hand dummy values to such Tardises. --- --- > noState = (undefined, undefined) -noState :: (a, b) -noState = (undefined, undefined) - - --- Instances -------------------------------------------------- - -instance MonadFix m => Monad (TardisT bw fw m) where - return x = tardis $ \s -> (x, s) - m >>= f = TardisT $ \ ~(bw, fw) -> do - rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) - (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') - return (x', (bw'', fw'')) - -instance MonadFix m => Functor (TardisT bw fw m) where - fmap = liftM - -instance MonadFix m => Applicative (TardisT bw fw m) where - pure = return - (<*>) = ap - - -instance MonadTrans (TardisT bw fw) where - lift m = TardisT $ \s -> do - x <- m - return (x, s) - -instance MonadFix m => MonadFix (TardisT bw fw m) where - mfix f = TardisT $ \s -> do - rec (x, s') <- runTardisT (f x) s - return (x, s') - -instance MFunctor (TardisT bw fw) where - hoist f = mapTardisT f - --- Basics -------------------------------------------------- - --- | From a stateful computation, construct a Tardis. --- This is the pure parallel to the constructor "TardisT", --- and is polymorphic in the transformed monad. -tardis :: Monad m => ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a -tardis f = TardisT $ \s -> return (f s) - --- | 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 :: Monad m => TardisT bw fw m fw -getPast = tardis $ \ ~(bw, fw) -> (fw, (bw, 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 :: Monad m => TardisT bw fw m bw -getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) - --- | 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 :: Monad m => bw -> TardisT bw fw m () -sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) - --- | 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 :: Monad m => fw -> TardisT bw fw m () -sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) - - --- | Modify the forwards-traveling state --- as it passes through from past to future. -modifyForwards :: MonadFix m => (fw -> fw) -> TardisT bw fw m () -modifyForwards f = getPast >>= sendFuture . f - --- | Modify the backwards-traveling state --- as it passes through from future to past. -modifyBackwards :: MonadFix m => (bw -> bw) -> TardisT bw fw m () -modifyBackwards f = do - rec - sendPast (f x) - x <- getFuture - return () - - --- | Retrieve a specific view of the forwards-traveling state. -getsPast :: MonadFix m => (fw -> a) -> TardisT bw fw m a -getsPast f = fmap f getPast - - --- | Retrieve a specific view of the backwards-traveling state. -getsFuture :: MonadFix m => (bw -> a) -> TardisT bw fw m a -getsFuture f = fmap f getFuture - diff --git a/src/Control/Monad/Tardis.hs b/src/Control/Monad/Tardis.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Tardis.hs @@ -0,0 +1,128 @@ +{-# OPTIONS_GHC -Wall #-} + +-- | This module re-exports both 'MonadTardis' and 'TardisT' +-- (Wherever there is overlap, the 'MonadTardis' version is preferred.) +-- +-- The recommended usage of a Tardis is to import this module. +module Control.Monad.Tardis + ( -- * Re-exports + module Control.Monad.Trans.Tardis + , module Control.Monad.Tardis.Class + + -- * What is a Tardis? + -- $whatis + + -- * How do you use a Tardis? + -- $howuse + ) where + + +import Control.Monad.Tardis.Class +import Control.Monad.Trans.Tardis + ( TardisT + , runTardisT + , evalTardisT + , execTardisT + + , Tardis + , runTardis + , evalTardis + , execTardis + + , noState + ) + + +{- $whatis + A Tardis is the combination of the State monad transformer + and the Reverse State monad transformer. + + The State monad transformer features a forwards-traveling state. + You can retrieve the current value of the state, + and you can set its value, affecting any future attempts + to retrieve it. + + The Reverse State monad transformer is just the opposite: + it features a backwards-traveling state. + You can retrieve the current value of the state, + and you can set its value, affecting any /past/ attempts + to retrieve it. This is a bit weirder than its + forwards-traveling counterpart, so its Monad instance + additionally requires that the underlying Monad it transforms + must be an instance of MonadFix. + + A Tardis is nothing more than mashing these two things together. + A Tardis gives you /two/ states: one which travels /backwards/ + (or /upwards/) through your code (referred to as @bw@), + and one which travels /forwards/ (or /downwards/) through your code + (referred to as @fw@). You can retrieve the current + value of either state, and you can set the value of either state. + Setting the forwards-traveling state will affect the /future/, + while setting the backwards-traveling state will affect the /past/. + Take a look at how Monadic bind is implemented for 'TardisT': + +> m >>= f = TardisT $ \ ~(bw, fw) -> do +> rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) +> (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') +> return (x', (bw'', fw'')) + + Like the Reverse State monad transformer, TardisT's Monad instance + requires that the monad it transforms is an instance of MonadFix, + as is evidenced by the use of @rec@. + Notice how the forwards-traveling state travels /normally/: + first it is fed to @m@, producing @fw'@, and then it is fed to @f x@, + producing @fw''@. The backwards-traveling state travels in the opposite + direction: first it is fed to @f x@, producing @bw'@, and then + it is fed to @m@, producing @bw''@. + +-} + +{- $howuse + A Tardis provides four primitive operations, + corresponding to the /get/ and /put/ for each of its two states. + The most concise way to explain it is this: + 'getPast' retrieves the value from the latest 'sendFuture', + while 'getFuture' retrieves the value from the next 'sendPast'. + Beware the pitfall of performing send and get in the wrong order. + Let's consider forwards-traveling state: + +> do sendFuture "foo" +> x <- getPast + + In this code snippet, @x@ will be @\"foo\"@, because 'getPast' + grabs the value from the latest 'sendFuture'. If you wanted + to observe that state /before/ overwriting it with @\"foo\"@, + then re-arrange the code so that 'getPast' happens earlier + than 'sendFuture'. Now let's consider backwards-traveling state: + +> do x <- getFuture +> sendPast "bar" + + In this code snippet, @x@ will be @\"bar\"@, because 'getFuture' + grabs the value from the next 'sendPast'. If you wanted + to observe that state /before/ overwriting it with @\"bar\"@, + then re-arrange the code so that 'getFuture' happens later + than 'sendPast'. + + TardisT is an instance of MonadFix. This is especially important + when attempting to write backwards-traveling code, because + the name binding occurs later than its usage. + The result of the following code will be @(11, \"Dan Burton\")@. + +> flip execTardis (10, "Dan") $ do +> name <- getPast +> sendFuture (name ++ " Burton") +> rec +> sendPast (score + 1) +> score <- getFuture +> return () + + To avoid using @rec@, you may find 'modifyBackwards' to be useful. + This code is equivalent to the previous example: + +> flip execTardis (10, "Dan") $ do +> modifyForwards (++ " Burton") +> modifyBackwards (+ 1) + +-} + diff --git a/src/Control/Monad/Tardis/Class.hs b/src/Control/Monad/Tardis/Class.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Tardis/Class.hs @@ -0,0 +1,106 @@ +{-# 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 = tardis $ \ ~(bw, fw) -> (fw, (bw, fw)) + getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) + sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) + sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) + + -- | A Tardis is merely a pure state transformation. + tardis :: ((bw, fw) -> (a, (bw, fw))) -> m a + tardis f = do + rec + let (a, (future', past')) = f (future, past) + sendPast future' + past <- getPast + future <- getFuture + sendFuture past' + return a + +-- | Modify the forwards-traveling state +-- as it passes through from past to future. +modifyForwards :: MonadTardis bw fw m => (fw -> fw) -> m () +modifyForwards f = getPast >>= sendFuture . f + +-- | Modify the backwards-traveling state +-- as it passes through from future to past. +modifyBackwards :: MonadTardis bw fw m => (bw -> bw) -> m () +modifyBackwards f = do + rec + sendPast (f x) + x <- getFuture + return () + +-- | Retrieve a specific view of the forwards-traveling state. +getsPast :: MonadTardis bw fw m => (fw -> a) -> m a +getsPast f = f <$> getPast + +-- | Retrieve a specific view of the backwards-traveling state. +getsFuture :: MonadTardis bw fw m => (bw -> a) -> m a +getsFuture f = f <$> getFuture + + +instance MonadFix m => MonadTardis bw fw (T.TardisT bw fw m) where + getPast = T.getPast + getFuture = T.getFuture + sendPast = T.sendPast + sendFuture = T.sendFuture + tardis = T.tardis diff --git a/src/Control/Monad/Trans/Tardis.hs b/src/Control/Monad/Trans/Tardis.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Trans/Tardis.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE RecursiveDo #-} + +-- | The data definition of a "TardisT" +-- as well as its primitive operations, +-- and straightforward combinators based on the primitives. +-- +-- See Control.Monad.Tardis for the general explanation +-- of what a Tardis is and how to use it. +module Control.Monad.Trans.Tardis ( + -- * The Tardis monad transformer + TardisT (TardisT, runTardisT) + , evalTardisT + , execTardisT + + -- * The Tardis monad + , Tardis + , runTardis + , evalTardis + , execTardis + + -- * Primitive Tardis operations + , tardis + + , getPast + , getFuture + , sendPast + , sendFuture + + -- * Composite Tardis operations + , modifyForwards + , modifyBackwards + + , getsPast + , getsFuture + + -- * Other + , mapTardisT + , noState + ) where + +import Control.Applicative +import Control.Monad.Identity +import Control.Monad.Trans +import Control.Monad.Morph + + +-- Definition +------------------------------------------------- + +-- | A TardisT 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. +newtype TardisT bw fw m a = TardisT + { runTardisT :: (bw, fw) -> m (a, (bw, fw)) + -- ^ A TardisT is merely an effectful state transformation + } + +-- | Using a Tardis with no monad underneath +-- will prove to be most common use case. +-- Practical uses of a TardisT require that the +-- underlying monad be an instance of MonadFix, +-- but note that the IO instance of MonadFix +-- is almost certainly unsuitable for use with +-- Tardis code. +type Tardis bw fw = TardisT bw fw Identity + +-- | A Tardis is merely a pure state transformation. +runTardis :: Tardis bw fw a -> (bw, fw) -> (a, (bw, fw)) +runTardis m = runIdentity . runTardisT m + + +-- Helpers +------------------------------------------------- + +-- | Run a Tardis, and discard the final state, +-- observing only the resultant value. +evalTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m a +evalTardisT t s = fst `liftM` runTardisT t s + +-- | Run a Tardis, and discard the resultant value, +-- observing only the final state (of both streams). +-- Note that the 'final' state of the backwards-traveling state +-- is the state it reaches by traveling from the 'bottom' +-- of your code to the 'top'. +execTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m (bw, fw) +execTardisT t s = snd `liftM` runTardisT t s + + +-- | Run a Tardis, and discard the final state, +-- observing only the resultant value. +evalTardis :: Tardis bw fw a -> (bw, fw) -> a +evalTardis t = runIdentity . evalTardisT t + +-- | Run a Tardis, and discard the resultant value, +-- observing only the final state (of both streams). +execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw) +execTardis t = runIdentity . execTardisT t + + +-- | A function that operates on the internal representation of a Tardis +-- can also be used on a Tardis. +mapTardisT :: (m (a, (bw, fw)) -> n (b, (bw, fw))) + -> TardisT bw fw m a -> TardisT bw fw n b +mapTardisT f m = TardisT $ f . runTardisT m + +-- | Some Tardises never observe the 'initial' state +-- of either state stream, so it is convenient +-- to simply hand dummy values to such Tardises. +-- +-- > noState = (undefined, undefined) +noState :: (a, b) +noState = (undefined, undefined) + + +-- Instances +------------------------------------------------- + +instance MonadFix m => Monad (TardisT bw fw m) where + return x = tardis $ \s -> (x, s) + m >>= f = TardisT $ \ ~(bw, fw) -> do + rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) + (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') + return (x', (bw'', fw'')) + +instance MonadFix m => Functor (TardisT bw fw m) where + fmap = liftM + +instance MonadFix m => Applicative (TardisT bw fw m) where + pure = return + (<*>) = ap + + +instance MonadTrans (TardisT bw fw) where + lift m = TardisT $ \s -> do + x <- m + return (x, s) + +instance MonadFix m => MonadFix (TardisT bw fw m) where + mfix f = TardisT $ \s -> do + rec (x, s') <- runTardisT (f x) s + return (x, s') + +instance MFunctor (TardisT bw fw) where + hoist f = mapTardisT f + +-- Basics +------------------------------------------------- + +-- | From a stateful computation, construct a Tardis. +-- This is the pure parallel to the constructor "TardisT", +-- and is polymorphic in the transformed monad. +tardis :: Monad m => ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a +tardis f = TardisT $ \s -> return (f s) + +-- | 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 :: Monad m => TardisT bw fw m fw +getPast = tardis $ \ ~(bw, fw) -> (fw, (bw, 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 :: Monad m => TardisT bw fw m bw +getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) + +-- | 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 :: Monad m => bw -> TardisT bw fw m () +sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) + +-- | 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 :: Monad m => fw -> TardisT bw fw m () +sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) + + +-- | Modify the forwards-traveling state +-- as it passes through from past to future. +modifyForwards :: MonadFix m => (fw -> fw) -> TardisT bw fw m () +modifyForwards f = getPast >>= sendFuture . f + +-- | Modify the backwards-traveling state +-- as it passes through from future to past. +modifyBackwards :: MonadFix m => (bw -> bw) -> TardisT bw fw m () +modifyBackwards f = do + rec + sendPast (f x) + x <- getFuture + return () + + +-- | Retrieve a specific view of the forwards-traveling state. +getsPast :: MonadFix m => (fw -> a) -> TardisT bw fw m a +getsPast f = fmap f getPast + + +-- | Retrieve a specific view of the backwards-traveling state. +getsFuture :: MonadFix m => (bw -> a) -> TardisT bw fw m a +getsFuture f = fmap f getFuture diff --git a/tardis.cabal b/tardis.cabal --- a/tardis.cabal +++ b/tardis.cabal @@ -1,5 +1,5 @@ name: tardis -version: 0.4.2.0 +version: 0.4.3.0 synopsis: Bidirectional state monad transformer homepage: https://github.com/DanBurton/tardis bug-reports: https://github.com/DanBurton/tardis/issues @@ -22,6 +22,7 @@ library default-language: Haskell2010 + hs-source-dirs: src exposed-modules: Control.Monad.Tardis , Control.Monad.Tardis.Class , Control.Monad.Trans.Tardis @@ -30,6 +31,14 @@ , mtl==2.* , mmorph==1.* +test-suite tardis-tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >= 4.8 && < 5 + , tardis + other-modules: Example source-repository head type: git diff --git a/test/Example.hs b/test/Example.hs new file mode 100644 --- /dev/null +++ b/test/Example.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE RecursiveDo #-} + +module Example where + +import Control.Monad.Tardis + +data BowlingGame = BowlingGame + { frames :: ![Frame] -- should be 9, too tedious to type restrict + , lastFrame :: LFrame } + +data Frame = Strike + | Spare { firstThrow :: !Int } + | Frame { firstThrow, secondThrow :: !Int } + +data LFrame = LStrike { bonus1, bonus2 :: !Int } + | LSpare { throw1, bonus1 :: !Int } + | LFrame { throw1, throw2 :: !Int } + +sampleGame :: BowlingGame +sampleGame = BowlingGame + { frames = + [ Strike , Spare 9 + , Strike , Strike + , Strike , Frame 8 1 + , Spare 7 , Strike + , Strike + ] + , lastFrame = LStrike 10 10 + } + +newtype PreviousScores = PreviousScores [Int] +newtype NextThrows = NextThrows (Int, Int) + +toScores :: BowlingGame -> [Int] +toScores game = flip evalTardis initState $ go (frames game) where + go :: [Frame] -> Tardis NextThrows PreviousScores [Int] + go [] = do + PreviousScores scores <- getPast + let score = head scores + return $ (finalFrameScore + score) : scores + go (f : fs) = do + rec + sendPast $ NextThrows throws' + PreviousScores scores <- getPast + let score = head scores + sendFuture $ PreviousScores (score' : scores) + NextThrows ~(nextThrow1, nextThrow2) <- getFuture + let (score', throws') = case f of + Strike -> (score + 10 + nextThrow1 + nextThrow2, (10, nextThrow1)) + Spare n -> (score + 10 + nextThrow1, (n, 10 - n)) + Frame n m -> (score + n + m, (n, m)) + go fs + + finalFrameScore = case lastFrame game of + LStrike n m -> 10 + n + m + LSpare _n m -> 10 + m + LFrame n m -> n + m + + initState = (NextThrows $ case lastFrame game of + LStrike n _m -> (10, n) + LSpare n _m -> (n, 10 - n) + LFrame n m -> (n, m) + , PreviousScores [0]) + +expectedScores :: [Int] +expectedScores = [236,206,176,146,126,117,98,70,40,20,0] + +actualScores :: [Int] +actualScores = toScores sampleGame diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,10 @@ +import Example +import System.Exit + +main :: IO () +main = case actualScores == expectedScores of + False -> do + putStrLn $ "Expected: " <> show expectedScores + putStrLn $ "Actual: " <> show actualScores + exitFailure + True -> exitSuccess