packages feed

acme-timemachine (empty) → 0.0.0.0

raw patch · 6 files changed

+181/−0 lines, 6 filesdep +basedep +ghc-primdep +mtlsetup-changed

Dependencies added: base, ghc-prim, mtl, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, mniip++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 mniip 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
+ acme-timemachine.cabal view
@@ -0,0 +1,17 @@+name:                acme-timemachine+version:             0.0.0.0+synopsis:            An easy way to perform and unperform IO actions.+description:         When doing some side-effectful computations, one might regret the decision to change the state. This package provides an 'undo' function for such cases, and universe suspension/resuming functions for finer control.+license:             BSD3+license-file:        LICENSE+author:              mniip+maintainer:          mniip@mniip.com+category:            ACME+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Acme.TimeMachine, Acme.TimeMachine.Undoable, Acme.TimeMachine.Suspension+  build-depends:       base == 4.*, transformers >= 0.2.0.0, mtl >= 1.1.0.0, ghc-prim+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Acme/TimeMachine.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances, MagicHash, UnboxedTuples #-}+module Acme.TimeMachine+    (+		Suspension,+        Universe,+        TimeMachine,+		undo,+		suspend,+		resume,+        runTM+    )+    where++import Control.Monad.IO.Class (MonadIO(..))+import GHC.IO (IO(..))+import GHC.Prim (State#, RealWorld)+import Acme.TimeMachine.Suspension+import Acme.TimeMachine.Undoable++-- | State of the universe.+data Universe = Universe# (State# RealWorld)++-- | Undo-able side-effectful computation monad.+-- Lets you perform and unperform side-effectful computations (with 'undo'), for example:+--+-- > main = runTM $ do+-- >     liftIO $ putStrLn "Launching the missiles!"+-- >     undo+--+-- You can also use 'suspend' and 'resume' for a finer control over execution and unexecution:+--+-- > main = runTM $ do+-- >     universe <- suspend+-- >     liftIO $ putStrLn "Launching the missiles!"+-- >     resume universe+--+-- Beware! You may accidentally create temporal paradoxes such as:+--+-- > main = runTM $ do+-- >     universe <- suspend+-- >     l <- liftIO $ getLine+-- >     putStrLn l+-- >     unless (null l) $ resume universe+type TimeMachine = Undoable Universe++instance MonadIO TimeMachine where+    liftIO (IO m) = Undoable $ \l@(Suspension (Universe# i#) _) -> let (u, r) = case m i# of (# i#, r #) -> (Universe# i#, r) in (Suspension u l, r)++-- | Execute an undo-able computation.+runTM :: TimeMachine a -> IO a+runTM (Undoable f) = IO $ \i# -> case f (mkSuspension $ Universe# i#) of ~(Suspension s _, r) -> case s of Universe# i# -> (# i#, r #)+
+ src/Acme/TimeMachine/Suspension.hs view
@@ -0,0 +1,12 @@+module Acme.TimeMachine.Suspension (+        Suspension(..),+        mkSuspension+    )+    where++-- | Data representing the entire history of the state.+data Suspension s = Suspension s (Suspension s)++-- | Create an infinite history consisting of the same state.+mkSuspension :: s -> Suspension s+mkSuspension s = Suspension s (mkSuspension s)
+ src/Acme/TimeMachine/Undoable.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Acme.TimeMachine.Undoable (+        Suspension,+        Undoable(..),+        evalUndoable,+        execUndoable,+        suspend,+        resume,+        undo+    )+    where++import Control.Applicative (Applicative(..))+import Control.Monad.State.Class (MonadState(..))+import Acme.TimeMachine.Suspension++-- | The undo-able stateful computation monad.+data Undoable s a = Undoable { getUndoable :: Suspension s -> (Suspension s, a) }++-- | Run an undo-able computation and return both the resulting state and the result.+--+-- > >>> runUndoable (do { modify (+3); return 5 }) 0+-- > (3, 5)+runUndoable :: Undoable s a -> s -> (s, a)+runUndoable (Undoable f) s = case f (mkSuspension s) of ~(Suspension s _, r) -> (s, r)++-- | Run an undo-able computation and return the result.+--+-- > >>> evalUndoable (do { return 5 }) 0+-- > 5+evalUndoable :: Undoable s a -> s -> a+evalUndoable (Undoable f) s = case f (mkSuspension s) of ~(_, r) -> r++-- | Run an undo-able computation and return the resulting state.+--+-- > >>> execUndoable (do { modify (+3) }) 0+-- > 3+execUndoable :: Undoable s a -> s -> s+execUndoable (Undoable f) s = case f (mkSuspension s) of ~(Suspension s _, _) -> s++-- | Save the history of a computation, to be later loaded with 'resume'.+suspend :: Undoable s (Suspension s)+suspend = Undoable $ \l -> (l, l)++-- | Load the history of a computation, saved by 'suspend'.+resume :: Suspension s -> Undoable s ()+resume l = Undoable $ \_ -> (l, ())++-- | Rollback the latest addition to the computation's history.+undo :: Undoable s ()+undo = Undoable $ \(Suspension _ l) -> (l, ())++instance Functor (Undoable s) where+    fmap f (Undoable x) = Undoable $ \l -> case x l of ~(l, r) -> (l, f r)++instance Applicative (Undoable s) where+    pure x = Undoable $ \l -> (l, x)+    (Undoable f) <*> (Undoable k) = Undoable $ \l -> case f l of ~(l, f) -> case k l of ~(l, k) -> (l, f k)++instance Monad (Undoable s) where+    return x = Undoable $ \l -> (l, x)+    (Undoable k) >>= f = Undoable $ \l -> case k l of ~(l, r) -> getUndoable (f r) l+    (Undoable k) >> (Undoable f) = Undoable $ \l -> case k l of ~(l, _) -> f l++instance MonadState s (Undoable s) where+    get = Undoable $ \l@(Suspension s _) -> (l, s)+    put s = Undoable $ \l -> (Suspension s l, ())+