├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── src └── Control │ └── Monad │ ├── Tardis.hs │ ├── Tardis │ └── Class.hs │ └── Trans │ └── Tardis.hs ├── stack.yaml ├── stack.yaml.lock ├── tardis.cabal └── test ├── Example.hs └── Main.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell tests 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | 9 | env: 10 | STACK_ARGS: --no-terminal --system-ghc --resolver=${{ matrix.snapshot }} 11 | 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | include: 16 | - snapshot: nightly-2024-01-15 17 | ghc: 9.8.1 18 | - snapshot: lts-22.6 19 | ghc: 9.6.3 20 | - snapshot: lts-21.25 21 | ghc: 9.4.8 22 | steps: 23 | - uses: actions/checkout@v4 24 | 25 | - name: Setup Haskell Stack 26 | uses: haskell-actions/setup@v2 27 | with: 28 | ghc-version: ${{ matrix.ghc }} 29 | enable-stack: true 30 | stack-version: 'latest' 31 | 32 | - name: Cache dependencies 33 | id: cache-stack 34 | uses: actions/cache@v3 35 | with: 36 | path: ~/.stack 37 | key: ${{ runner.os }}-stack-${{ matrix.snapshot }}-${{ hashFiles('**/stack.yaml') }} 38 | restore-keys: | 39 | ${{ runner.os }}-stack-${{ matrix.snapshot }}- 40 | 41 | - name: Dependencies 42 | run: stack ${{ env.STACK_ARGS }} test --dependencies-only 43 | 44 | - name: Build and Test 45 | run: | 46 | stack ${{ env.STACK_ARGS }} exec -- ghc --version 47 | stack ${{ env.STACK_ARGS }} test 48 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist 2 | /dist-newstyle 3 | .stack-work 4 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | * **0.5.0**: 2 | 2024-01-15: Removed MonadTrans instance, replaced with liftTardisT 3 | 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012, Dan Burton 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Dan Burton nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TardisT 2 | 3 | ![build status](https://github.com/DanBurton/tardis/actions/workflows/haskell.yml/badge.svg?branch=master) 4 | 5 | The State monad allows you 6 | to send information forwards to the future, 7 | or to receive such information from the past. 8 | The Reverse State monad allows you to do the reverse: 9 | send information backwards to the past, 10 | or receive information from the future. 11 | 12 | TardisT is a monad transformer 13 | that provides state operations that allow you 14 | to send information to both the future *and* the past, 15 | as well as receive information from both directions. 16 | It is isomorphic to a StateT on top of a ReverseStateT, 17 | or vice-versa. 18 | 19 | See test/Example.hs for an example. 20 | 21 | ---- 22 | 23 | This was inspired by Luke Palmer's blog post on 24 | the "reverse state monad". 25 | 26 | http://lukepalmer.wordpress.com/2008/08/10/mindfuck-the-reverse-state-monad/ 27 | 28 | See also: 29 | 30 | http://panicsonic.blogspot.com/2007/12/backwards-state-or-power-of-laziness.html 31 | 32 | ---- 33 | 34 | (c) 2012 Dan Burton 35 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/Control/Monad/Tardis.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | 3 | -- | This module re-exports both 'MonadTardis' and 'TardisT' 4 | -- (Wherever there is overlap, the 'MonadTardis' version is preferred.) 5 | -- 6 | -- The recommended usage of a Tardis is to import this module. 7 | module Control.Monad.Tardis 8 | ( -- * Re-exports 9 | module Control.Monad.Trans.Tardis 10 | , module Control.Monad.Tardis.Class 11 | 12 | -- * What is a Tardis? 13 | -- $whatis 14 | 15 | -- * How do you use a Tardis? 16 | -- $howuse 17 | ) where 18 | 19 | 20 | import Control.Monad.Tardis.Class 21 | import Control.Monad.Trans.Tardis 22 | ( TardisT 23 | , runTardisT 24 | , evalTardisT 25 | , execTardisT 26 | 27 | , Tardis 28 | , runTardis 29 | , evalTardis 30 | , execTardis 31 | 32 | , noState 33 | ) 34 | 35 | 36 | {- $whatis 37 | A Tardis is the combination of the State monad transformer 38 | and the Reverse State monad transformer. 39 | 40 | The State monad transformer features a forwards-traveling state. 41 | You can retrieve the current value of the state, 42 | and you can set its value, affecting any future attempts 43 | to retrieve it. 44 | 45 | The Reverse State monad transformer is just the opposite: 46 | it features a backwards-traveling state. 47 | You can retrieve the current value of the state, 48 | and you can set its value, affecting any /past/ attempts 49 | to retrieve it. This is a bit weirder than its 50 | forwards-traveling counterpart, so its Monad instance 51 | additionally requires that the underlying Monad it transforms 52 | must be an instance of MonadFix. 53 | 54 | A Tardis is nothing more than mashing these two things together. 55 | A Tardis gives you /two/ states: one which travels /backwards/ 56 | (or /upwards/) through your code (referred to as @bw@), 57 | and one which travels /forwards/ (or /downwards/) through your code 58 | (referred to as @fw@). You can retrieve the current 59 | value of either state, and you can set the value of either state. 60 | Setting the forwards-traveling state will affect the /future/, 61 | while setting the backwards-traveling state will affect the /past/. 62 | Take a look at how Monadic bind is implemented for 'TardisT': 63 | 64 | > m >>= f = TardisT $ \ ~(bw, fw) -> do 65 | > rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) 66 | > (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') 67 | > return (x', (bw'', fw'')) 68 | 69 | Like the Reverse State monad transformer, TardisT's Monad instance 70 | requires that the monad it transforms is an instance of MonadFix, 71 | as is evidenced by the use of @rec@. 72 | Notice how the forwards-traveling state travels /normally/: 73 | first it is fed to @m@, producing @fw'@, and then it is fed to @f x@, 74 | producing @fw''@. The backwards-traveling state travels in the opposite 75 | direction: first it is fed to @f x@, producing @bw'@, and then 76 | it is fed to @m@, producing @bw''@. 77 | 78 | -} 79 | 80 | {- $howuse 81 | A Tardis provides four primitive operations, 82 | corresponding to the /get/ and /put/ for each of its two states. 83 | The most concise way to explain it is this: 84 | 'getPast' retrieves the value from the latest 'sendFuture', 85 | while 'getFuture' retrieves the value from the next 'sendPast'. 86 | Beware the pitfall of performing send and get in the wrong order. 87 | Let's consider forwards-traveling state: 88 | 89 | > do sendFuture "foo" 90 | > x <- getPast 91 | 92 | In this code snippet, @x@ will be @\"foo\"@, because 'getPast' 93 | grabs the value from the latest 'sendFuture'. If you wanted 94 | to observe that state /before/ overwriting it with @\"foo\"@, 95 | then re-arrange the code so that 'getPast' happens earlier 96 | than 'sendFuture'. Now let's consider backwards-traveling state: 97 | 98 | > do x <- getFuture 99 | > sendPast "bar" 100 | 101 | In this code snippet, @x@ will be @\"bar\"@, because 'getFuture' 102 | grabs the value from the next 'sendPast'. If you wanted 103 | to observe that state /before/ overwriting it with @\"bar\"@, 104 | then re-arrange the code so that 'getFuture' happens later 105 | than 'sendPast'. 106 | 107 | TardisT is an instance of MonadFix. This is especially important 108 | when attempting to write backwards-traveling code, because 109 | the name binding occurs later than its usage. 110 | The result of the following code will be @(11, \"Dan Burton\")@. 111 | 112 | > flip execTardis (10, "Dan") $ do 113 | > name <- getPast 114 | > sendFuture (name ++ " Burton") 115 | > rec 116 | > sendPast (score + 1) 117 | > score <- getFuture 118 | > return () 119 | 120 | To avoid using @rec@, you may find 'modifyBackwards' to be useful. 121 | This code is equivalent to the previous example: 122 | 123 | > flip execTardis (10, "Dan") $ do 124 | > modifyForwards (++ " Burton") 125 | > modifyBackwards (+ 1) 126 | 127 | -} 128 | 129 | -------------------------------------------------------------------------------- /src/Control/Monad/Tardis/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE FunctionalDependencies #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | 6 | -- | The class definition of a Tardis, 7 | -- as well as a few straightforward combinators 8 | -- based on its primitives. 9 | -- 10 | -- See Control.Monad.Tardis for the general explanation 11 | -- of what a Tardis is and how to use it. 12 | module Control.Monad.Tardis.Class 13 | ( -- * The MonadTardis class 14 | MonadTardis (..) 15 | -- * Composite Tardis operations 16 | , modifyForwards 17 | , modifyBackwards 18 | , getsPast 19 | , getsFuture 20 | ) where 21 | 22 | import Control.Applicative 23 | import Control.Monad.Fix 24 | 25 | import qualified Control.Monad.Trans.Tardis as T 26 | 27 | -- | A Tardis is parameterized by two state streams: 28 | -- a 'backwards-traveling' state and a 'forwards-traveling' state. 29 | -- This library consistently puts the backwards-traveling state first 30 | -- whenever the two are seen together. 31 | -- 32 | -- Minimal complete definition: 33 | -- ("tardis") or 34 | -- ("getPast", "getFuture", "sendPast", and "sendFuture"). 35 | class (Applicative m, MonadFix m) => MonadTardis bw fw m | m -> bw, m -> fw where 36 | -- | Retrieve the current value of the 'forwards-traveling' state, 37 | -- which therefore came forwards from the past. 38 | -- You can think of forwards-traveling state as traveling 39 | -- 'downwards' through your code. 40 | getPast :: m fw 41 | 42 | -- | Retrieve the current value of the 'backwards-traveling' state, 43 | -- which therefore came backwards from the future. 44 | -- You can think of backwards-traveling state as traveling 45 | -- 'upwards' through your code. 46 | getFuture :: m bw 47 | 48 | -- | Set the current value of the 'backwards-traveling' state, 49 | -- which will therefore be sent backwards to the past. 50 | -- This value can be retrieved by calls to "getFuture" 51 | -- located 'above' the current location, 52 | -- unless it is overwritten by an intervening "sendPast". 53 | sendPast :: bw -> m () 54 | 55 | -- | Set the current value of the 'forwards-traveling' state, 56 | -- which will therefore be sent forwards to the future. 57 | -- This value can be retrieved by calls to "getPast" 58 | -- located 'below' the current location, 59 | -- unless it is overwritten by an intervening "sendFuture". 60 | sendFuture :: fw -> m () 61 | 62 | getPast = tardis $ \ ~(bw, fw) -> (fw, (bw, fw)) 63 | getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) 64 | sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) 65 | sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) 66 | 67 | -- | A Tardis is merely a pure state transformation. 68 | tardis :: ((bw, fw) -> (a, (bw, fw))) -> m a 69 | tardis f = do 70 | rec 71 | let (a, (future', past')) = f (future, past) 72 | sendPast future' 73 | past <- getPast 74 | future <- getFuture 75 | sendFuture past' 76 | return a 77 | 78 | -- | Modify the forwards-traveling state 79 | -- as it passes through from past to future. 80 | modifyForwards :: MonadTardis bw fw m => (fw -> fw) -> m () 81 | modifyForwards f = getPast >>= sendFuture . f 82 | 83 | -- | Modify the backwards-traveling state 84 | -- as it passes through from future to past. 85 | modifyBackwards :: MonadTardis bw fw m => (bw -> bw) -> m () 86 | modifyBackwards f = do 87 | rec 88 | sendPast (f x) 89 | x <- getFuture 90 | return () 91 | 92 | -- | Retrieve a specific view of the forwards-traveling state. 93 | getsPast :: MonadTardis bw fw m => (fw -> a) -> m a 94 | getsPast f = f <$> getPast 95 | 96 | -- | Retrieve a specific view of the backwards-traveling state. 97 | getsFuture :: MonadTardis bw fw m => (bw -> a) -> m a 98 | getsFuture f = f <$> getFuture 99 | 100 | 101 | instance MonadFix m => MonadTardis bw fw (T.TardisT bw fw m) where 102 | getPast = T.getPast 103 | getFuture = T.getFuture 104 | sendPast = T.sendPast 105 | sendFuture = T.sendFuture 106 | tardis = T.tardis 107 | -------------------------------------------------------------------------------- /src/Control/Monad/Trans/Tardis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE TupleSections #-} 3 | 4 | -- | The data definition of a "TardisT" 5 | -- as well as its primitive operations, 6 | -- and straightforward combinators based on the primitives. 7 | -- 8 | -- See Control.Monad.Tardis for the general explanation 9 | -- of what a Tardis is and how to use it. 10 | module Control.Monad.Trans.Tardis ( 11 | -- * The Tardis monad transformer 12 | TardisT (TardisT, runTardisT) 13 | , evalTardisT 14 | , execTardisT 15 | 16 | -- * The Tardis monad 17 | , Tardis 18 | , runTardis 19 | , evalTardis 20 | , execTardis 21 | 22 | -- * Primitive Tardis operations 23 | , tardis 24 | 25 | , getPast 26 | , getFuture 27 | , sendPast 28 | , sendFuture 29 | 30 | -- * Composite Tardis operations 31 | , modifyForwards 32 | , modifyBackwards 33 | 34 | , getsPast 35 | , getsFuture 36 | 37 | -- * Other 38 | , mapTardisT 39 | , liftTardisT 40 | , noState 41 | ) where 42 | 43 | import Control.Applicative 44 | import Control.Monad 45 | import Control.Monad.Identity 46 | import Control.Monad.Trans 47 | import Control.Monad.Fix 48 | import Control.Monad.Morph 49 | 50 | 51 | -- Definition 52 | ------------------------------------------------- 53 | 54 | -- | A TardisT is parameterized by two state streams: 55 | -- a 'backwards-traveling' state and a 'forwards-traveling' state. 56 | -- This library consistently puts the backwards-traveling state first 57 | -- whenever the two are seen together. 58 | newtype TardisT bw fw m a = TardisT 59 | { runTardisT :: (bw, fw) -> m (a, (bw, fw)) 60 | -- ^ A TardisT is merely an effectful state transformation 61 | } 62 | 63 | -- | Using a Tardis with no monad underneath 64 | -- will prove to be most common use case. 65 | -- Practical uses of a TardisT require that the 66 | -- underlying monad be an instance of MonadFix, 67 | -- but note that the IO instance of MonadFix 68 | -- is almost certainly unsuitable for use with 69 | -- Tardis code. 70 | type Tardis bw fw = TardisT bw fw Identity 71 | 72 | -- | A Tardis is merely a pure state transformation. 73 | runTardis :: Tardis bw fw a -> (bw, fw) -> (a, (bw, fw)) 74 | runTardis m = runIdentity . runTardisT m 75 | 76 | 77 | -- Helpers 78 | ------------------------------------------------- 79 | 80 | -- | Run a Tardis, and discard the final state, 81 | -- observing only the resultant value. 82 | evalTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m a 83 | evalTardisT t s = fst `liftM` runTardisT t s 84 | 85 | -- | Run a Tardis, and discard the resultant value, 86 | -- observing only the final state (of both streams). 87 | -- Note that the 'final' state of the backwards-traveling state 88 | -- is the state it reaches by traveling from the 'bottom' 89 | -- of your code to the 'top'. 90 | execTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m (bw, fw) 91 | execTardisT t s = snd `liftM` runTardisT t s 92 | 93 | 94 | -- | Run a Tardis, and discard the final state, 95 | -- observing only the resultant value. 96 | evalTardis :: Tardis bw fw a -> (bw, fw) -> a 97 | evalTardis t = runIdentity . evalTardisT t 98 | 99 | -- | Run a Tardis, and discard the resultant value, 100 | -- observing only the final state (of both streams). 101 | execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw) 102 | execTardis t = runIdentity . execTardisT t 103 | 104 | -- | An action in the underlying monad (or just functor, really) 105 | -- can also be used in a Tardis by lifting it in. 106 | liftTardisT :: (Functor m) => m a -> TardisT bw fw m a 107 | liftTardisT m = TardisT $ \s -> fmap (,s) m 108 | 109 | -- | A function that operates on the internal representation of a Tardis 110 | -- can also be used on a Tardis. 111 | mapTardisT :: (m (a, (bw, fw)) -> n (b, (bw, fw))) 112 | -> TardisT bw fw m a -> TardisT bw fw n b 113 | mapTardisT f m = TardisT $ f . runTardisT m 114 | 115 | -- | Some Tardises never observe the 'initial' state 116 | -- of either state stream, so it is convenient 117 | -- to simply hand dummy values to such Tardises. 118 | -- 119 | -- > noState = (undefined, undefined) 120 | noState :: (a, b) 121 | noState = (undefined, undefined) 122 | 123 | 124 | -- Instances 125 | ------------------------------------------------- 126 | 127 | instance MonadFix m => Monad (TardisT bw fw m) where 128 | return x = tardis $ \s -> (x, s) 129 | m >>= f = TardisT $ \ ~(bw, fw) -> do 130 | rec (x, ~(bw'', fw' )) <- runTardisT m (bw', fw) 131 | (x', ~(bw' , fw'')) <- runTardisT (f x) (bw, fw') 132 | return (x', (bw'', fw'')) 133 | 134 | instance MonadFix m => Functor (TardisT bw fw m) where 135 | fmap = liftM 136 | 137 | instance MonadFix m => Applicative (TardisT bw fw m) where 138 | pure = return 139 | (<*>) = ap 140 | 141 | instance MonadFix m => MonadFix (TardisT bw fw m) where 142 | mfix f = TardisT $ \s -> do 143 | rec (x, s') <- runTardisT (f x) s 144 | return (x, s') 145 | 146 | instance MFunctor (TardisT bw fw) where 147 | hoist f = mapTardisT f 148 | 149 | -- Basics 150 | ------------------------------------------------- 151 | 152 | -- | From a stateful computation, construct a Tardis. 153 | -- This is the pure parallel to the constructor "TardisT", 154 | -- and is polymorphic in the transformed monad. 155 | tardis :: Monad m => ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a 156 | tardis f = TardisT $ \s -> return (f s) 157 | 158 | -- | Retrieve the current value of the 'forwards-traveling' state, 159 | -- which therefore came forwards from the past. 160 | -- You can think of forwards-traveling state as traveling 161 | -- 'downwards' through your code. 162 | getPast :: Monad m => TardisT bw fw m fw 163 | getPast = tardis $ \ ~(bw, fw) -> (fw, (bw, fw)) 164 | 165 | -- | Retrieve the current value of the 'backwards-traveling' state, 166 | -- which therefore came backwards from the future. 167 | -- You can think of backwards-traveling state as traveling 168 | -- 'upwards' through your code. 169 | getFuture :: Monad m => TardisT bw fw m bw 170 | getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw)) 171 | 172 | -- | Set the current value of the 'backwards-traveling' state, 173 | -- which will therefore be sent backwards to the past. 174 | -- This value can be retrieved by calls to "getFuture" 175 | -- located 'above' the current location, 176 | -- unless it is overwritten by an intervening "sendPast". 177 | sendPast :: Monad m => bw -> TardisT bw fw m () 178 | sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw)) 179 | 180 | -- | Set the current value of the 'forwards-traveling' state, 181 | -- which will therefore be sent forwards to the future. 182 | -- This value can be retrieved by calls to "getPast" 183 | -- located 'below' the current location, 184 | -- unless it is overwritten by an intervening "sendFuture". 185 | sendFuture :: Monad m => fw -> TardisT bw fw m () 186 | sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw')) 187 | 188 | 189 | -- | Modify the forwards-traveling state 190 | -- as it passes through from past to future. 191 | modifyForwards :: MonadFix m => (fw -> fw) -> TardisT bw fw m () 192 | modifyForwards f = getPast >>= sendFuture . f 193 | 194 | -- | Modify the backwards-traveling state 195 | -- as it passes through from future to past. 196 | modifyBackwards :: MonadFix m => (bw -> bw) -> TardisT bw fw m () 197 | modifyBackwards f = do 198 | rec 199 | sendPast (f x) 200 | x <- getFuture 201 | return () 202 | 203 | 204 | -- | Retrieve a specific view of the forwards-traveling state. 205 | getsPast :: MonadFix m => (fw -> a) -> TardisT bw fw m a 206 | getsPast f = fmap f getPast 207 | 208 | 209 | -- | Retrieve a specific view of the backwards-traveling state. 210 | getsFuture :: MonadFix m => (bw -> a) -> TardisT bw fw m a 211 | getsFuture f = fmap f getFuture 212 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2024-01-15 2 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: b2d7d0e14fcbd81b6dd819b08e6efb28b76b60fd22a3b3c455f119e3af1ed0d8 10 | size: 556888 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/1/15.yaml 12 | original: nightly-2024-01-15 13 | -------------------------------------------------------------------------------- /tardis.cabal: -------------------------------------------------------------------------------- 1 | name: tardis 2 | version: 0.5.0 3 | synopsis: Bidirectional state monad transformer 4 | homepage: https://github.com/DanBurton/tardis 5 | bug-reports: https://github.com/DanBurton/tardis/issues 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Dan Burton 9 | maintainer: danburton.email@gmail.com 10 | category: Control 11 | build-type: Simple 12 | cabal-version: >=1.10 13 | tested-with: GHC == 9.8.1, GHC == 9.6.3, GHC == 9.4.8 14 | extra-source-files: README.md, ChangeLog.md 15 | 16 | description: 17 | A Tardis is a combination of both a forwards and a backwards 18 | state transformer, providing two state values that \"travel\" 19 | in opposite directions. 20 | . 21 | A detailed description of what a Tardis is and how to use it 22 | can be found in the documentation for Control.Monad.Tardis. 23 | 24 | 25 | library 26 | default-language: Haskell2010 27 | hs-source-dirs: src 28 | exposed-modules: Control.Monad.Tardis 29 | , Control.Monad.Tardis.Class 30 | , Control.Monad.Trans.Tardis 31 | 32 | build-depends: base >= 4.8 && < 5 33 | , mtl==2.* 34 | , mmorph==1.* 35 | 36 | test-suite tardis-tests 37 | default-language: Haskell2010 38 | type: exitcode-stdio-1.0 39 | hs-source-dirs: test 40 | main-is: Main.hs 41 | build-depends: base >= 4.8 && < 5 42 | , tardis 43 | other-modules: Example 44 | 45 | source-repository head 46 | type: git 47 | location: git://github.com/DanBurton/tardis.git 48 | 49 | source-repository this 50 | type: git 51 | location: git://github.com/DanBurton/tardis.git 52 | tag: tardis-0.4.1.0 53 | -------------------------------------------------------------------------------- /test/Example.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | 3 | module Example where 4 | 5 | import Control.Monad.Tardis 6 | 7 | data BowlingGame = BowlingGame 8 | { frames :: ![Frame] -- should be 9, too tedious to type restrict 9 | , lastFrame :: LFrame } 10 | 11 | data Frame = Strike 12 | | Spare { firstThrow :: !Int } 13 | | Frame { firstThrow, secondThrow :: !Int } 14 | 15 | data LFrame = LStrike { bonus1, bonus2 :: !Int } 16 | | LSpare { throw1, bonus1 :: !Int } 17 | | LFrame { throw1, throw2 :: !Int } 18 | 19 | sampleGame :: BowlingGame 20 | sampleGame = BowlingGame 21 | { frames = 22 | [ Strike , Spare 9 23 | , Strike , Strike 24 | , Strike , Frame 8 1 25 | , Spare 7 , Strike 26 | , Strike 27 | ] 28 | , lastFrame = LStrike 10 10 29 | } 30 | 31 | newtype PreviousScores = PreviousScores [Int] 32 | newtype NextThrows = NextThrows (Int, Int) 33 | 34 | toScores :: BowlingGame -> [Int] 35 | toScores game = flip evalTardis initState $ go (frames game) where 36 | go :: [Frame] -> Tardis NextThrows PreviousScores [Int] 37 | go [] = do 38 | PreviousScores scores <- getPast 39 | let score = head scores 40 | return $ (finalFrameScore + score) : scores 41 | go (f : fs) = do 42 | rec 43 | sendPast $ NextThrows throws' 44 | PreviousScores scores <- getPast 45 | let score = head scores 46 | sendFuture $ PreviousScores (score' : scores) 47 | NextThrows ~(nextThrow1, nextThrow2) <- getFuture 48 | let (score', throws') = case f of 49 | Strike -> (score + 10 + nextThrow1 + nextThrow2, (10, nextThrow1)) 50 | Spare n -> (score + 10 + nextThrow1, (n, 10 - n)) 51 | Frame n m -> (score + n + m, (n, m)) 52 | go fs 53 | 54 | finalFrameScore = case lastFrame game of 55 | LStrike n m -> 10 + n + m 56 | LSpare _n m -> 10 + m 57 | LFrame n m -> n + m 58 | 59 | initState = (NextThrows $ case lastFrame game of 60 | LStrike n _m -> (10, n) 61 | LSpare n _m -> (n, 10 - n) 62 | LFrame n m -> (n, m) 63 | , PreviousScores [0]) 64 | 65 | expectedScores :: [Int] 66 | expectedScores = [236,206,176,146,126,117,98,70,40,20,0] 67 | 68 | actualScores :: [Int] 69 | actualScores = toScores sampleGame 70 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | import Example 2 | import System.Exit 3 | 4 | main :: IO () 5 | main = case actualScores == expectedScores of 6 | False -> do 7 | putStrLn $ "Expected: " <> show expectedScores 8 | putStrLn $ "Actual: " <> show actualScores 9 | exitFailure 10 | True -> exitSuccess 11 | --------------------------------------------------------------------------------