changes for compatibility with acid-state-dist

acid-state.cabal

@@ -24,13 +24,14 @@ Library
   Exposed-Modules:     Data.Acid,
                        Data.Acid.Local, Data.Acid.Memory,
                        Data.Acid.Memory.Pure, Data.Acid.Remote,
-                       Data.Acid.Advanced
-
-  Other-modules:       Data.Acid.Log, Data.Acid.Archive,
-                       Data.Acid.CRC, Paths_acid_state,
-                       Data.Acid.TemplateHaskell, Data.Acid.Common, FileIO,
+                       Data.Acid.Advanced,
+                       Data.Acid.Log, Data.Acid.CRC,
                        Data.Acid.Abstract, Data.Acid.Core
 
+  Other-modules:       Data.Acid.Archive,
+                       Paths_acid_state,
+                       Data.Acid.TemplateHaskell, Data.Acid.Common, FileIO
+
   Build-depends:       array,
                        base >= 4 && < 5,
                        bytestring >= 0.10,

src/Data/Acid/Local.hs

@@ -17,7 +17,11 @@ module Data.Acid.Local
     , openLocalStateFrom
     , prepareLocalState
     , prepareLocalStateFrom
+    , scheduleLocalUpdate'
+    , scheduleLocalColdUpdate'
     , createCheckpointAndClose
+    , LocalState(..)
+    , Checkpoint(..)
     ) where
 
 import Data.Acid.Log as Log
@@ -95,6 +99,32 @@ scheduleLocalUpdate acidState event
          return mvar
     where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event
 
+-- | Same as scheduleLocalUpdate but does not immediately change the localCopy
+-- and return the result mvar - returns an IO action to do this instead. Take
+-- care to run actions of multiple Updates in the correct order as otherwise
+-- Queries will operate on outdated state.
+scheduleLocalUpdate' :: UpdateEvent event => LocalState (EventState event) -> event -> MVar (EventResult event) -> IO (IO ())
+scheduleLocalUpdate' acidState event mvar
+    = do
+         let encoded = runPutLazy (safePut event)
+
+         -- It is important that we encode the event now so that we can catch
+         -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs)
+         evaluate (Lazy.length encoded)
+
+         act <- modifyCoreState (localCore acidState) $ \st ->
+           do let !(result, !st') = runState hotMethod st
+              -- Schedule the log entry. Very important that it happens when 'localCore' is locked
+              -- to ensure that events are logged in the same order that they are executed.
+              pushEntry (localEvents acidState) (methodTag event, encoded) $ return ()
+              let action = do writeIORef (localCopy acidState) st'
+                              putMVar mvar result
+              return (st', action)
+         -- this is the action to update state for queries and release the
+         -- result into the supplied mvar
+         return act
+    where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event
+
 scheduleLocalColdUpdate :: LocalState st -> Tagged ByteString -> IO (MVar ByteString)
 scheduleLocalColdUpdate acidState event
     = do mvar <- newEmptyMVar
@@ -108,6 +138,23 @@ scheduleLocalColdUpdate acidState event
          return mvar
     where coldMethod = lookupColdMethod (localCore acidState) event
 
+-- | Same as scheduleLocalColdUpdate but does not immediately change the
+-- localCopy and return the result mvar - returns an IO action to do this
+-- instead. Take care to run actions of multiple Updates in the correct order as
+-- otherwise Queries will operate on outdated state.
+scheduleLocalColdUpdate' :: LocalState st -> Tagged ByteString -> MVar ByteString -> IO (IO ())
+scheduleLocalColdUpdate' acidState event mvar
+    = do act <- modifyCoreState (localCore acidState) $ \st ->
+           do let !(result, !st') = runState coldMethod st
+              -- Schedule the log entry. Very important that it happens when 'localCore' is locked
+              -- to ensure that events are logged in the same order that they are executed.
+              pushEntry (localEvents acidState) event $ return ()
+              let action = do writeIORef (localCopy acidState) st'
+                              putMVar mvar result
+              return (st', action)
+         return act
+    where coldMethod = lookupColdMethod (localCore acidState) event
+
 -- | Issue a Query event and wait for its result. Events may be issued in parallel.
 localQuery  :: QueryEvent event  => LocalState (EventState event) -> event -> IO (EventResult event)
 localQuery acidState event

src/Data/Acid/Log.hs

@@ -3,7 +3,7 @@
 -- extendible array of entries.
 --
 module Data.Acid.Log
-    ( FileLog
+    ( FileLog(..)
     , LogKey(..)
     , EntryId
     , openFileLog