TimeMachine.hs

{-# 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 #)