tardis (empty) → 0.2.0.0
raw patch · 6 files changed
+317/−0 lines, 6 filesdep +basedep +mtlsetup-changed
Dependencies added: base, mtl
Files
- Control/Monad/Tardis.hs +69/−0
- Control/Monad/Tardis/Class.hs +50/−0
- Control/Monad/Trans/Tardis.hs +127/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- tardis.cabal +39/−0
+ Control/Monad/Tardis.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}++{-# LANGUAGE DoRec #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++#ifdef USE_UNDECIDABLE_INSTANCES+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverlappingInstances #-}+#endif++module Control.Monad.Tardis+ ( module Control.Monad.Trans.Tardis+ , module Control.Monad.Tardis.Class+ ) where+++#ifdef USE_UNDECIDABLE_INSTANCES+import Control.Applicative (Applicative)+import Control.Monad.Trans (MonadTrans, lift)+#endif++import Control.Monad.Fix+import Control.Monad.State.Class++import qualified Control.Monad.Trans.Tardis as T+import Control.Monad.Tardis.Class+import Control.Monad.Trans.Tardis+ ( TardisT+ , runTardisT+ , evalTardisT+ , execTardisT++ , Tardis+ , runTardis+ , evalTardis+ , execTardis+ + , noState+ )++instance MonadFix m => MonadTardis bw fw (TardisT bw fw m) where+ getPast = T.getPast+ getFuture = T.getFuture+ sendPast = T.sendPast+ sendFuture = T.sendFuture+ tardis = T.tardis++instance MonadFix m => MonadState fw (TardisT bw fw m) where+ get = getPast+ put = sendFuture+++#ifdef USE_UNDECIDABLE_INSTANCES+instance ( MonadTrans t+ , MonadTardis bw fw m+ , MonadFix (t m)+ , Applicative (t m)+ ) => MonadTardis bw fw (t m) where+ getPast = lift getPast+ getFuture = lift getFuture+ sendPast = lift . sendPast+ sendFuture = lift . sendFuture+ tardis = lift . tardis+#endif+
+ Control/Monad/Tardis/Class.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE DoRec #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++module Control.Monad.Tardis.Class+ ( MonadTardis (..)+ , modifyForwards+ , modifyBackwards+ , getsPast+ , getsFuture+ ) where++import Control.Applicative+import Control.Monad.Fix++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 = 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'))++ 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+++modifyForwards :: MonadTardis bw fw m => (fw -> fw) -> m ()+modifyForwards f = getPast >>= sendFuture . f++modifyBackwards :: MonadTardis bw fw m => (bw -> bw) -> m ()+modifyBackwards f = getFuture >>= sendPast . f++getsPast :: MonadTardis bw fw m => (fw -> a) -> m a+getsPast f = f <$> getPast++getsFuture :: MonadTardis bw fw m => (bw -> a) -> m a+getsFuture f = f <$> getFuture+
+ Control/Monad/Trans/Tardis.hs view
@@ -0,0 +1,127 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE DoRec #-}++module Control.Monad.Trans.Tardis (+ TardisT+ , runTardisT+ , evalTardisT+ , execTardisT++ , Tardis+ , runTardis+ , evalTardis+ , execTardis++ , tardis++ , getPast+ , getFuture+ , sendPast+ , sendFuture++ , modifyForwards+ , modifyBackwards++ , getsPast+ , getsFuture++ , noState+ ) where++import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Trans+++-- Definition+-------------------------------------------------+newtype TardisT bw fw m a = TardisT+ { 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 m = runIdentity . runTardisT m+++-- Helpers+-------------------------------------------------++evalTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m a+evalTardisT t s = fst `liftM` runTardisT t s++execTardisT :: Monad m => TardisT bw fw m a -> (bw, fw) -> m (bw, fw)+execTardisT t s = snd `liftM` runTardisT t s++evalTardis :: Tardis bw fw a -> (bw, fw) -> a+evalTardis t = runIdentity . evalTardisT t++execTardis :: Tardis bw fw a -> (bw, fw) -> (bw, fw)+execTardis t = runIdentity . execTardisT t+++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')+++-- Basics+-------------------------------------------------++tardis :: Monad m => ((bw, fw) -> (a, (bw, fw))) -> TardisT bw fw m a+tardis f = TardisT $ \s -> return (f s)+++getPast :: Monad m => TardisT bw fw m fw+getPast = tardis $ \ ~(bw, fw) -> (fw, (bw, fw))++getFuture :: Monad m => TardisT bw fw m bw+getFuture = tardis $ \ ~(bw, fw) -> (bw, (bw, fw))++sendPast :: Monad m => bw -> TardisT bw fw m ()+sendPast bw' = tardis $ \ ~(_bw, fw) -> ((), (bw', fw))++sendFuture :: Monad m => fw -> TardisT bw fw m ()+sendFuture fw' = tardis $ \ ~(bw, _fw) -> ((), (bw, fw'))+++modifyForwards :: MonadFix m => (fw -> fw) -> TardisT bw fw m ()+modifyForwards f = getPast >>= sendFuture . f++modifyBackwards :: MonadFix m => (bw -> bw) -> TardisT bw fw m ()+modifyBackwards f = getFuture >>= sendPast . f+++getsPast :: MonadFix m => (fw -> a) -> TardisT bw fw m a+getsPast f = fmap f getPast++getsFuture :: MonadFix m => (bw -> a) -> TardisT bw fw m a+getsFuture f = fmap f getFuture+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Dan Burton++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dan Burton nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ tardis.cabal view
@@ -0,0 +1,39 @@+name: tardis+version: 0.2.0.0+synopsis: Bidirectional state monad transformer+homepage: https://github.com/DanBurton/tardis+bug-reports: https://github.com/DanBurton/tardis/issues+license: BSD3+license-file: LICENSE+author: Dan Burton+maintainer: danburton.email@gmail.com+category: Control+build-type: Simple+cabal-version: >=1.8++Flag use-undecidable-instances+ description: Include additional instances for MonadTardis+ that require some sketchy language extensions+ default: False++library+ exposed-modules: Control.Monad.Tardis+ , Control.Monad.Tardis.Class+ , Control.Monad.Trans.Tardis+++ build-depends: base==4.*+ , mtl==2.*++ if flag(use-undecidable-instances)+ cpp-options: -DUSE_UNDECIDABLE_INSTANCES+++source-repository head+ type: git+ location: git://github.com/DanBurton/tardis.git++source-repository this+ type: git+ location: git://github.com/DanBurton/tardis.git+ tag: tardis-0.2.0.0