Commits

C. Dylan Shearer committed 205e010

Moved source files to 'src' directory.

  • Participants
  • Parent commits fae7929

Comments (0)

Files changed (4)

File IoTransaction.hs

-{-# LANGUAGE DeriveDataTypeable #-}
-
-{-|
-This module provides facilities for building 'IO' actions in such a way that, if one 'IO' action in a sequence
-throws 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 updated
-from some external data source.  The new contents for a particular file are retrieved from the external data
-source 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 @IoTransaction@, we could do this thus:
-
-> import IoTransaction
-> 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 @IoTransaction@: 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 would
-be if they had been combined as usual inside the 'IO' monad.  When we invoke an 'IO' action whose effect should be undone if an
-exception 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 will
-be 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', which
-converts it into an 'IO' action.  If an exception occurs when this 'IO' action is executed, then any changes so far made to the
-files will be undone using the undoers added by @updateFile@.
--}
-module IoTransaction(UndoableIO, doAction, addUndoer, exec, rollback, makeUndoable) where
-
-import qualified Control.Exception as C
-import Data.Typeable.Internal
-
-data UndoableM m a = Do (m (a, m ()))
-
-runUndoableM :: UndoableM m a -> m (a, m ())
-runUndoableM (Do op) = op
-
-execM :: Monad m => UndoableM m a -> m a
-execM u = do (val, undo) <- runUndoableM u
-             return val
-
-class Monad m => ExceptionalMonad m where
-    throwM :: C.Exception e => e -> m a
-    catchM :: C.Exception e => m a -> (e -> m a) -> m a
-
-instance ExceptionalMonad m => Monad (UndoableM m) where
-    {-
-    We combine two UIOs by making a new one that executes the
-    first one and then tries to execute the second; if the first fails,
-    the UIO fails; if the second fails, the UIO undoes the first and
-    then fails.  The new UIO returns the value retuned by the second
-    along with an undo IO that is a combination of the undo IOs of the
-    first and second UIOs.
-    -}
-    -- (>>=) :: UIO a -> (a -> UIO b) -> UIO b
-    Do op >>= f  = Do $ do (val, undo)   <- op
-                           (val', undo') <- runUndoableM (f val) `catchM` (\e -> undo >> throwM (e :: C.SomeException))
-                           return (val', (undo >> undo'))
-
-    return val = Do $ return (val, return ())
-
-makeUndoableM :: ExceptionalMonad m => m a -> m () -> UndoableM m a
-makeUndoableM op undo = Do $ do result <- op
-                                return (result, undo)
-
-doActionM :: ExceptionalMonad m => m a -> UndoableM m a
-doActionM action = makeUndoableM action (return ())
-
-addUndoerM :: ExceptionalMonad m => m () -> UndoableM m ()
-addUndoerM undo = makeUndoableM (return ()) undo
-
-data ManualUndo = ManualUndo
-    deriving (Show, Typeable)
-
-instance C.Exception ManualUndo
-
-rollbackM :: ExceptionalMonad m => UndoableM m ()
-rollbackM = makeUndoableM (throwM ManualUndo) (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 undoers
-are placed into a stack.  When the doers are executed, if one of them throws an exception, the undoers
-so 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 of
-the undoers are executed.
--}
-type UndoableIO a = UndoableM IO a
-
-instance ExceptionalMonad IO where
-    throwM = C.throwIO -- C.throwIO should be used when throwing inside the IO monad
-    catchM = C.catch
-
-runUndoable :: UndoableIO a -> IO (a, IO ())
-runUndoable op = runUndoableM op
-
--- | Convert an 'UndoableIO' action into an 'IO' action that invokes
--- the actions (and the undoers if necessary) that were added to the
--- 'UndoableIO' action.
-exec :: UndoableIO a -> IO a
-exec op = execM op
-
--- | Make an undoable action.
-makeUndoable :: IO a -- ^ The ''doer'': the action to perform.
-             -> IO () -- ^ An ''undoer'': an action that undoes the effect of the other one.
-             -> UndoableIO a
-makeUndoable doer undoer = makeUndoableM doer undoer
-
-{-|
-Make an undoable action without any undoer.
-
-This undoable action will not add any undoer to the undoer stack.
--}
-doAction :: IO a -- ^ The ''doer'': the action to perform.
-         -> UndoableIO a
-doAction doer = doActionM doer
-
--- | Add an undoer to the undoer stack.
-addUndoer :: IO () -- ^ An ''undoer'': an action that will be added to the undoer stack.
-          -> UndoableIO ()
-addUndoer undoer = addUndoerM undoer
-
--- | Stop execution, run the actions on the undoer stack, and throw an exception.
-rollback :: UndoableIO ()
-rollback = rollbackM
-
-{-
-UndoableIO satisfies first two monad laws.  Don't know about third one.
-
-Monad Laws:
-1. return x >>= f    ==  f x
-2. mv >>= return     ==  mv
-3. (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 undoIo
-          
-Do io' >>= g == Do $ (io >>= \(val, undoIo) -> fK (val, undoIo) >>= J undoIo) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIo
-
-Do 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) -> 
--}
-
-

File IoTransactionTest.hs

-import IoTransaction
-import System.Posix.Directory as Dir
-import System.Posix.Files
-
-makeDir2 :: UndoableIO ()
-makeDir2 = do doAction $ createDirectory "dir2" 504
-              addUndoer $ removeDirectory "dir2"
-
-makeDir3 :: UndoableIO ()
-makeDir3 = do exists <- doAction $ fileExist "dir2"
-              if exists
-                then do _makeDir3
-                        makeDir4
-                else return ()
-
-_makeDir3 :: UndoableIO ()
-_makeDir3 = do doAction $ createDirectory "dir2/dir3" 504
-               addUndoer $ removeDirectory "dir2/dir3"
-
-makeDir4 :: UndoableIO ()
-makeDir4 = do doAction $ createDirectory "dir4" 504
-              addUndoer $ removeDirectory "dir4"
-
-main = execUndoable $ do makeDir2
-                         makeDir3
-                         rollback

File src/IoTransaction.hs

+{-# LANGUAGE DeriveDataTypeable #-}
+
+{-|
+This module provides facilities for building 'IO' actions in such a way that, if one 'IO' action in a sequence
+throws 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 updated
+from some external data source.  The new contents for a particular file are retrieved from the external data
+source 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 @IoTransaction@, we could do this thus:
+
+> import IoTransaction
+> 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 @IoTransaction@: 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 would
+be if they had been combined as usual inside the 'IO' monad.  When we invoke an 'IO' action whose effect should be undone if an
+exception 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 will
+be 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', which
+converts it into an 'IO' action.  If an exception occurs when this 'IO' action is executed, then any changes so far made to the
+files will be undone using the undoers added by @updateFile@.
+-}
+module IoTransaction(UndoableIO, doAction, addUndoer, exec, rollback, makeUndoable) where
+
+import qualified Control.Exception as C
+import Data.Typeable.Internal
+
+data UndoableM m a = Do (m (a, m ()))
+
+runUndoableM :: UndoableM m a -> m (a, m ())
+runUndoableM (Do op) = op
+
+execM :: Monad m => UndoableM m a -> m a
+execM u = do (val, undo) <- runUndoableM u
+             return val
+
+class Monad m => ExceptionalMonad m where
+    throwM :: C.Exception e => e -> m a
+    catchM :: C.Exception e => m a -> (e -> m a) -> m a
+
+instance ExceptionalMonad m => Monad (UndoableM m) where
+    {-
+    We combine two UIOs by making a new one that executes the
+    first one and then tries to execute the second; if the first fails,
+    the UIO fails; if the second fails, the UIO undoes the first and
+    then fails.  The new UIO returns the value retuned by the second
+    along with an undo IO that is a combination of the undo IOs of the
+    first and second UIOs.
+    -}
+    -- (>>=) :: UIO a -> (a -> UIO b) -> UIO b
+    Do op >>= f  = Do $ do (val, undo)   <- op
+                           (val', undo') <- runUndoableM (f val) `catchM` (\e -> undo >> throwM (e :: C.SomeException))
+                           return (val', (undo >> undo'))
+
+    return val = Do $ return (val, return ())
+
+makeUndoableM :: ExceptionalMonad m => m a -> m () -> UndoableM m a
+makeUndoableM op undo = Do $ do result <- op
+                                return (result, undo)
+
+doActionM :: ExceptionalMonad m => m a -> UndoableM m a
+doActionM action = makeUndoableM action (return ())
+
+addUndoerM :: ExceptionalMonad m => m () -> UndoableM m ()
+addUndoerM undo = makeUndoableM (return ()) undo
+
+data ManualUndo = ManualUndo
+    deriving (Show, Typeable)
+
+instance C.Exception ManualUndo
+
+rollbackM :: ExceptionalMonad m => UndoableM m ()
+rollbackM = makeUndoableM (throwM ManualUndo) (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 undoers
+are placed into a stack.  When the doers are executed, if one of them throws an exception, the undoers
+so 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 of
+the undoers are executed.
+-}
+type UndoableIO a = UndoableM IO a
+
+instance ExceptionalMonad IO where
+    throwM = C.throwIO -- C.throwIO should be used when throwing inside the IO monad
+    catchM = C.catch
+
+runUndoable :: UndoableIO a -> IO (a, IO ())
+runUndoable op = runUndoableM op
+
+-- | Convert an 'UndoableIO' action into an 'IO' action that invokes
+-- the actions (and the undoers if necessary) that were added to the
+-- 'UndoableIO' action.
+exec :: UndoableIO a -> IO a
+exec op = execM op
+
+-- | Make an undoable action.
+makeUndoable :: IO a -- ^ The ''doer'': the action to perform.
+             -> IO () -- ^ An ''undoer'': an action that undoes the effect of the other one.
+             -> UndoableIO a
+makeUndoable doer undoer = makeUndoableM doer undoer
+
+{-|
+Make an undoable action without any undoer.
+
+This undoable action will not add any undoer to the undoer stack.
+-}
+doAction :: IO a -- ^ The ''doer'': the action to perform.
+         -> UndoableIO a
+doAction doer = doActionM doer
+
+-- | Add an undoer to the undoer stack.
+addUndoer :: IO () -- ^ An ''undoer'': an action that will be added to the undoer stack.
+          -> UndoableIO ()
+addUndoer undoer = addUndoerM undoer
+
+-- | Stop execution, run the actions on the undoer stack, and throw an exception.
+rollback :: UndoableIO ()
+rollback = rollbackM
+
+{-
+UndoableIO satisfies first two monad laws.  Don't know about third one.
+
+Monad Laws:
+1. return x >>= f    ==  f x
+2. mv >>= return     ==  mv
+3. (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 undoIo
+          
+Do io' >>= g == Do $ (io >>= \(val, undoIo) -> fK (val, undoIo) >>= J undoIo) >>= \(val, undoIo) -> gK (val, undoIo) >>= J undoIo
+
+Do 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) -> 
+-}
+
+

File src/IoTransactionTest.hs

+import IoTransaction
+import System.IO
+import System.FilePath.Posix
+
+updateFile :: FilePath -> FilePath -> UndoableIO ()
+
+updateFile path sourcePath = do -- get current contents
+                                oldContents <- doAction $ readFile path
+
+                                -- get new contents from external data source
+                                newContents <- doAction $ readFile sourcePath
+
+                                -- write new contents
+                                doAction $ writeFile path newContents
+                                
+                                -- add an undo action that rewrites the old contents
+                                addUndoer $ writeFile path oldContents
+
+scenario1 :: IO ()
+scenario1 = do writeFile "file1" "old contents 1"
+               writeFile "file2" "old contents 2"
+               writeFile "source1" "hello"
+               writeFile "source2" "goodbye"
+               
+               exec $ do updateFile "file1" "source1"
+                         updateFile "file2" "doesntExist"
+
+main = scenario1