{-# LANGUAGE DeriveDataTypeable #-}{-|This module provides facilities for building 'IO' actions in such a way that, if one 'IO' action in a sequencethrows an exception, the effects of previous actions will be undone.Here's an example of how to use this module. Suppose you have two files that, every so often, must be updatedfrom some external data source. The new contents for a particular file are retrieved from the external datasource via a function @getNewContents :: 'FilePath' -> 'IO' 'String'@. @getNewContents@ could throw an exception, as could any of the other 'IO' actions that we invoke, and if an exception is thrown while the files are being updated,we want all changes made so far to either of the files to be rolled back. Using this module, we could do this thus:> import Control.MonadTransaction> import System.IO> import System.FilePath.Posix> > getNewContents :: FilePath -> IO String> getNewContents path = ...> > updateFile :: FilePath -> UndoableIO ()> updateFile path = do -- get current contents> oldContents <- doAction $ readFile path> > -- get new contents from external data source> newContents <- doAction $ getNewContents path> > -- write new contents> doAction $ writeFile path newContents> > -- add an undo action that rewrites the old contents> addUndoer $ writeFile path oldContents> > main :: IO ()> main = exec $ do updateFile "file1"> updateFile "file2"In this code, we use the following from this module: the 'UndoableIO' monad, and the functions 'doAction', 'addUndoer',and 'exec'. The 'UndoableIO' monad is like a context for combining 'IO' actions together into a transaction. Inside'UndoableIO', we invoke 'IO' actions using the function 'doAction'. When executed, these actions will be sequenced as they wouldbe if they had been combined as usual inside the 'IO' monad. When we invoke an 'IO' action whose effect should be undone if anexception occurs later, we add an \"undoer\" --- that is, an 'IO' action that undoes the effect --- using the function'addUndoer'. 'UndoableIO' maintains a stack of undoers, and if an exception occurs during execution, the undoers willbe executed in the reverse of the order in which they were added, and then the exception will be rethrown.So, in @updateFile@ we use 'doAction' to call 'IO' actions that read from and write to the files and retrieve strings from the external data source, and at the end we add an undoer that restores the original contents. In @main@, we combine the 'UndoableIO'actions returned by two calls to @updateFile@ into one. We pass the resulting 'UndoableIO' action to 'exec', whichconverts it into an 'IO' action. If an exception occurs when this 'IO' action is executed, then any changes so far made to thefiles will be undone using the undoers added by @updateFile@.-}moduleControl.IoTransaction(-- * IO TransactionsUndoableIO,doAction,addUndoer,exec,rollback,makeUndoable,ManualUndo(ManualUndo),-- * Internal StuffUndoableM(Do),ExceptionalMonad(throwM,catchM),doActionM,addUndoerM,execM,rollbackM,makeUndoableM)whereimportqualifiedControl.ExceptionasCimportData.Typeable.Internal-- * Impl{-| A monad for combining other, side-effectual monads in a transactionthat can be rolled back if an exception is thrown. @m@ must implement@ExceptionalMonad@.This type is for implementing transactions and should not be used directlyby code that uses transactions.-}dataUndoableMma=Do(m(a,m()))runUndoableM::UndoableMma->m(a,m())runUndoableM(Doop)=opexecM::Monadm=>UndoableMma->maexecMu=do(val,undo)<-runUndoableMureturnval{-| An @ExceptionalMonad@ is a monad that in which 'Control.Exception's can be thrown and caught.A monad @m@ must implement @ExceptionalMonad@ in order to work with 'UndoableM'.-}classMonadm=>ExceptionalMonadmwhere-- | Throw an exception.throwM::C.Exceptione=>e->ma-- | Catch an exception.catchM::C.Exceptione=>ma->(e->ma)->mainstanceExceptionalMonadm=>Monad(UndoableMm)where{- We combine two UndoableMs by making a new one that executes the first one and then tries to execute the second; if the first fails, the UndoableM fails; if the second fails, the UndoableM undoes the first and then fails. The new UndoableM returns the value retuned by the second along with an undo action that is a combination of the undo actions of the first and second UndoableMs. -}Doop>>=f=Do$do(val,undo)<-op(val',undo')<-runUndoableM(fval)`catchM`(\e->undo>>throwM(e::C.SomeException))return(val',undo>>undo')returnval=Do$return(val,return())makeUndoableM::ExceptionalMonadm=>ma->m()->UndoableMmamakeUndoableMopundo=Do$doresult<-opreturn(result,undo)doActionM::ExceptionalMonadm=>ma->UndoableMmadoActionMaction=makeUndoableMaction(return())addUndoerM::ExceptionalMonadm=>m()->UndoableMm()addUndoerM=makeUndoableM(return())dataManualUndo=ManualUndoderiving(Show,Typeable)instanceC.ExceptionManualUndorollbackM::ExceptionalMonadm=>UndoableMm()rollbackM=makeUndoableM(throwMManualUndo)(return())-- yes, the handler in the ExceptionalMonad instance decl above will catch this exception{-|An \"undoable action\" is a wrapper for an 'IO' action (the \"doer\") that combines it with another'IO' action (the \"undoer\") that undoes the effects of the first one.Undoable actions are monads, and when sequenced together they act like transactions involving 'IO' operations.As undoable actions are sequenced together, their doers are also sequenced together and their undoersare placed into a stack. When the doers are executed, if one of them throws an exception, the undoersso far added to the stack are executed in reverse the reverse of the order in which they were added to the stack,and then the exception is rethrown; no other doers (or undoers) are executed. If no exception is thrown, none ofthe undoers are executed.-}typeUndoableIOa=UndoableMIOainstanceExceptionalMonadIOwherethrowM=C.throwIO-- C.throwIO should be used when throwing inside the IO monadcatchM=C.catchrunUndoable::UndoableIOa->IO(a,IO())runUndoable=runUndoableM{-|Convert an 'UndoableIO' action into an 'IO' action that invokesthe actions (and the undoers if necessary) that were added to the'UndoableIO' action.-}exec::UndoableIOa->IOaexec=execM-- | Make an undoable action.makeUndoable::IOa-- ^ The \"doer\": the action to perform.->IO()-- ^ An \"undoer\": an action that undoes the effect of the other one.->UndoableIOamakeUndoable=makeUndoableM{-|Make an undoable action without any undoer.This undoable action will not add any undoer to the undoer stack.-}doAction::IOa-- ^ The \"doer\": the action to perform.->UndoableIOadoAction=doActionM-- | Add an undoer to the undoer stack.addUndoer::IO()-- ^ An \"undoer\": an action that will be added to the undoer stack.->UndoableIO()addUndoer=addUndoerM-- | Stop execution, run the actions on the undoer stack, and throw 'ManualUndo'.rollback::UndoableIO()rollback=rollbackM{-UndoableIO satisfies first two monad laws. Don't know about third one.Monad Laws:1. return x >>= f == f x2. mv >>= return == mv3. (mv >>= f) >>= g == mv >>= (\x -> (f x >>= g))let gK = \(v, u) -> runUio (g v) `C.catch` (\e -> u >> ioError e)let fK = \(v, u) -> runUio (f v) `C.catch` (\e -> u >> ioError e)let J = \u -> \(val', undoIo') -> return (val', (u >> undoIo'))// (Do io >>= f) >>= g == Do io >>= (\x -> (f x >>= g))\x -> (f x >>= g) == \x -> Do $ runUio (f x) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIo(Do io >>= f) >>= g == Do io' >>= g where io' = io >>= \(val, undoIo) -> fK (val, undoIo) >>= J undoIoDo io' >>= g == Do $ (io >>= \(val, undoIo) -> fK (val, undoIo) >>= J undoIo) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIoDo io >>= (\x -> (f x >>= g)) == Do io >>= (\x -> Do $ runUio (f x) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIo) == Do $ do (v, u) <- io (v', u') <- runUio (Do $ runUio (f v) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIo) `C.catch` (\e -> undoIo >> ioError e) return (v', (u >> u')) == Do $ io >>= \(v, u) -> -}