diff --git a/acid-state.cabal b/acid-state.cabal --- a/acid-state.cabal +++ b/acid-state.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.7.8 +Version: 0.7.9 -- A short (one-line) description of the package. Synopsis: Add ACID guarantees to any serializable Haskell data structure. diff --git a/examples/HelloDatabase.hs b/examples/HelloDatabase.hs --- a/examples/HelloDatabase.hs +++ b/examples/HelloDatabase.hs @@ -2,7 +2,6 @@ module Main (main) where import Data.Acid -import Data.Acid.Local import Control.Monad.State ( get, put ) import Control.Monad.Reader ( ask ) @@ -32,11 +31,10 @@ main :: IO () main = do args <- getArgs - database <- continueLocalStateFrom "myDatabase/" (Database ["Welcome to the acid-state database."]) - case args of - [] -> do messages <- query database (ViewMessages 10) - putStrLn "Last 10 messages:" - mapM_ putStrLn [ " " ++ message | message <- messages ] - ["checkpoint"] -> createCheckpoint database - _ -> do update database (AddMessage (unwords args)) + database <- openLocalStateFrom "myDatabase/" (Database ["Welcome to the acid-state database."]) + if null args + then do messages <- query database (ViewMessages 10) + putStrLn "Last 10 messages:" + mapM_ putStrLn [ " " ++ message | message <- messages ] + else do update database (AddMessage (unwords args)) putStrLn "Your message has been added to the database." diff --git a/examples/RemoteClient.hs b/examples/RemoteClient.hs --- a/examples/RemoteClient.hs +++ b/examples/RemoteClient.hs @@ -31,7 +31,6 @@ -> do acid <- open n <- query acid QueryState putStrLn $ "State value: " ++ show n - closeAcidState acid ["poke"] -> do acid <- open putStr "Issuing 100k transactions... " diff --git a/examples/RemoteServer.hs b/examples/RemoteServer.hs --- a/examples/RemoteServer.hs +++ b/examples/RemoteServer.hs @@ -2,7 +2,6 @@ module Main (main) where import Data.Acid -import Data.Acid.Local import Data.Acid.Remote (acidServer) import Control.Exception (bracket) @@ -17,6 +16,6 @@ main :: IO () main = bracket - (continueLocalState $ StressState 0) + (openLocalState $ StressState 0) closeAcidState (\s -> acidServer s (PortNumber 8080)) diff --git a/src/Data/Acid/Local.hs b/src/Data/Acid/Local.hs --- a/src/Data/Acid/Local.hs +++ b/src/Data/Acid/Local.hs @@ -17,6 +17,8 @@ , openLocalStateFrom , continueLocalState , continueLocalStateFrom + , prepareLocalState + , prepareLocalStateFrom , createArchive , createCheckpointAndClose ) where @@ -29,6 +31,7 @@ import Control.Concurrent ( newEmptyMVar, putMVar, takeMVar, MVar, threadDelay ) import Control.Exception ( SomeException, handle ) import Control.Monad.State ( runState ) +import Control.Monad ( join ) import Control.Applicative ( (<$>), (<*>) ) import Data.ByteString.Lazy ( ByteString ) --import qualified Data.ByteString.Lazy as Lazy ( length ) @@ -172,20 +175,33 @@ => st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> IO (AcidState st) -openLocalState initialState - = openLocalStateFrom ("state" show (typeOf initialState)) initialState +openLocalState initialState = + openLocalStateFrom ("state" show (typeOf initialState)) initialState -- | Create an AcidState given an initial value. -- -- This will create or resume a log found in the \"state\/[typeOf state]\/\" directory. -- If another application has already opened the AcidState, this call will block until it has been closed. continueLocalState :: (Typeable st, IsAcidic st) - => st -- ^ Initial state value. This value is only used if no checkpoint is - -- found. - -> IO (AcidState st) -continueLocalState initialState - = continueLocalStateFrom ("state" show (typeOf initialState)) initialState + => st -- ^ Initial state value. This value is only used if no checkpoint is + -- found. + -> IO (AcidState st) +continueLocalState initialState = + continueLocalStateFrom ("state" show (typeOf initialState)) initialState +-- | Create an AcidState given an initial value. +-- +-- This will create or resume a log found in the \"state\/[typeOf state]\/\" directory. +-- The most recent checkpoint will be loaded immediately but the AcidState will not be opened +-- until the returned function is executed. +prepareLocalState :: (Typeable st, IsAcidic st) + => st -- ^ Initial state value. This value is only used if no checkpoint is + -- found. + -> IO (IO (AcidState st)) +prepareLocalState initialState = + prepareLocalStateFrom ("state" show (typeOf initialState)) initialState + + -- | Create an AcidState given a log directory and an initial value. -- -- This will create or resume a log found in @directory@. @@ -197,7 +213,7 @@ -- found. -> IO (AcidState st) openLocalStateFrom directory initialState = - resumeLocalStateFrom directory initialState False + join $ resumeLocalStateFrom directory initialState False -- | Create an AcidState given a log directory and an initial value. -- @@ -209,15 +225,30 @@ -- found. -> IO (AcidState st) continueLocalStateFrom directory initialState = + join $ resumeLocalStateFrom directory initialState True + + +-- | Create an AcidState given an initial value. +-- +-- This will create or resume a log found in @directory@. +-- The most recent checkpoint will be loaded immediately but the AcidState will not be opened +-- until the returned function is executed. +prepareLocalStateFrom :: (IsAcidic st) + => FilePath -- ^ Location of the checkpoint and transaction files. + -> st -- ^ Initial state value. This value is only used if no checkpoint is + -- found. + -> IO (IO (AcidState st)) +prepareLocalStateFrom directory initialState = resumeLocalStateFrom directory initialState True + resumeLocalStateFrom :: (IsAcidic st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> Bool -- ^ True if we should wait for the lock to be released. - -> IO (AcidState st) + -> IO (IO (AcidState st)) resumeLocalStateFrom directory initialState doWaitForLock = do firstLock <- if not doWaitForLock then obtainPrefixLock lockFile else return undefined @@ -231,23 +262,23 @@ Left msg -> checkpointRestoreError msg Right val -> return val) return eventCutOff - - secondLock <- if doWaitForLock then waitForLock lockFile else return undefined + return $ do + secondLock <- if doWaitForLock then waitForLock lockFile else return undefined - eventsLog <- openFileLog eventsLogKey - events <- readEntriesFrom eventsLog n - mapM_ (runColdMethod core) events - ensureLeastEntryId eventsLog n - checkpointsLog <- openFileLog checkpointsLogKey - stateCopy <- newIORef undefined - withCoreState core (writeIORef stateCopy) + eventsLog <- openFileLog eventsLogKey + events <- readEntriesFrom eventsLog n + mapM_ (runColdMethod core) events + ensureLeastEntryId eventsLog n + checkpointsLog <- openFileLog checkpointsLogKey + stateCopy <- newIORef undefined + withCoreState core (writeIORef stateCopy) - return $ toAcidState LocalState { localCore = core - , localCopy = stateCopy - , localEvents = eventsLog - , localCheckpoints = checkpointsLog - , localLock = if doWaitForLock then secondLock else firstLock - } + return $ toAcidState LocalState { localCore = core + , localCopy = stateCopy + , localEvents = eventsLog + , localCheckpoints = checkpointsLog + , localLock = if doWaitForLock then secondLock else firstLock + } where lockFile = directory "open" eventsLogKey = LogKey { logDirectory = directory