acid-state 0.4.3 → 0.5.0

raw patch · 8 files changed

+320/−68 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• acid-state.cabal +4/−3
• examples/KeyValue.hs +1/−0
• examples/StressTest.hs +2/−1
• src/Data/Acid/Common.hs +78/−0
• src/Data/Acid/Core.hs +8/−5
• src/Data/Acid/Local.hs +4/−59
• src/Data/Acid/Memory.hs +136/−0
• src/Data/Acid/Memory/Pure.hs +87/−0

@@ -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.4.3+Version:             0.5.0  -- A short (one-line) description of the package. Synopsis:            Add ACID guarantees to any serializable Haskell data structure.@@ -46,12 +46,13 @@ Library   -- Modules exported by the library.   Exposed-Modules:     Data.Acid, Data.Acid.Core,-                       Data.Acid.Local+                       Data.Acid.Local, Data.Acid.Memory,+                       Data.Acid.Memory.Pure    -- Modules not exported by this package.   Other-modules:       Data.Acid.Log, Data.Acid.Archive,                        Data.Acid.CRC, Paths_acid_state,-                       Data.Acid.TemplateHaskell+                       Data.Acid.TemplateHaskell, Data.Acid.Common      -- Packages needed in order to build this package.   Build-depends:       base >= 4 && < 5, cereal >= 0.3.2.0, safecopy >= 0.5, bytestring, stm,

@@ -2,6 +2,7 @@ module Main (main) where  import Data.Acid+import qualified Data.Acid.Memory.Pure as Pure  import Control.Monad.State import Control.Monad.Reader

@@ -1,8 +1,9 @@ {-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell #-} module Main (main) where -import Data.Acid+import Data.Acid (makeAcidic) import Data.Acid.Local+import qualified Data.Acid.Memory.Pure as Pure  import Control.Monad.State import Control.Monad.Reader

@@ -0,0 +1,78 @@+{- LANGUAGE GADTs, OverloadedStrings, DeriveDataTypeable, TypeFamilies,+             FlexibleContexts, BangPatterns, CPP -}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, GADTs #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Acid.Common+-- Copyright   :  PublicDomain+--+-- Maintainer  :  lemmih@gmail.com+-- Portability :  non-portable (uses GHC extensions)+--+-- Common structures used by the various backends (local, memory).+--+module Data.Acid.Common where++import Data.Acid.Core++import Control.Monad.State+import Control.Monad.Reader+import Data.SafeCopy+import Control.Applicative++class (SafeCopy st) => IsAcidic st where+    acidEvents :: [Event st]+      -- ^ List of events capable of updating or querying the state.++-- | Context monad for Update events.+newtype Update st a = Update { unUpdate :: State st a }+#if MIN_VERSION_mtl(2,0,0)+    deriving (Monad, Functor, Applicative, MonadState st)+#else+    deriving (Monad, Functor, MonadState st)+#endif++-- | Context monad for Query events.+newtype Query st a  = Query { unQuery :: Reader st a }+#if MIN_VERSION_mtl(2,0,0)+    deriving (Monad, Functor, Applicative, MonadReader st)+#else+    deriving (Monad, Functor, MonadReader st)+#endif++-- | Run a query in the Update Monad.+runQuery :: Query st a -> Update st a+runQuery query+    = do st <- get+         return (runReader (unQuery query) st)++-- | Events return the same thing as Methods. The exact type of 'EventResult'+--   depends on the event.+type EventResult ev = MethodResult ev++type EventState ev = MethodState ev++-- | We distinguish between events that modify the state and those that do not.+--+--   UpdateEvents are executed in a MonadState context and have to be serialized+--   to disk before they are considered durable.+--+--   QueryEvents are executed in a MonadReader context and obviously do not have+--   to be serialized to disk.+data Event st where+    UpdateEvent :: UpdateEvent ev => (ev -> Update (EventState ev) (EventResult ev)) -> Event (EventState ev)+    QueryEvent  :: QueryEvent  ev => (ev -> Query (EventState ev) (EventResult ev)) -> Event (EventState ev)++-- | All UpdateEvents are also Methods.+class Method ev => UpdateEvent ev+-- | All QueryEvents are also Methods.+class Method ev => QueryEvent ev+++eventsToMethods :: [Event st] -> [MethodContainer st]+eventsToMethods = map worker+    where worker :: Event st -> MethodContainer st+          worker (UpdateEvent fn) = Method (unUpdate . fn)+          worker (QueryEvent fn)  = Method (\ev -> do st <- get+                                                      return (runReader (unQuery $ fn ev) st)+                                           )

@@ -17,7 +17,7 @@ -- \'Method\' is loosely used for state operations without ACID guarantees -- module Data.Acid.Core-    ( Core+    ( Core(coreMethods)     , Method(..)     , MethodContainer(..)     , Tagged@@ -31,6 +31,8 @@     , lookupColdMethod     , runHotMethod     , runColdMethod+    , MethodMap+    , mkMethodMap     ) where  import Control.Concurrent                 ( MVar, newMVar, withMVar@@ -149,13 +151,14 @@ runHotMethod :: Method method => Core (MethodState method) -> method -> IO (MethodResult method) runHotMethod core method     = modifyCoreState core $ \st ->-      do let (a, st') = runState (lookupHotMethod core method) st+      do let (a, st') = runState (lookupHotMethod (coreMethods core) method) st          return ( st', a)  -- | Find the state action that corresponds to an in-memory method.-lookupHotMethod :: Method method => Core (MethodState method) -> method -> State (MethodState method) (MethodResult method)-lookupHotMethod core method-    = case Map.lookup (methodTag method) (coreMethods core) of+lookupHotMethod :: Method method => MethodMap (MethodState method) -> method+                -> State (MethodState method) (MethodResult method)+lookupHotMethod methodMap method+    = case Map.lookup (methodTag method) methodMap of         Nothing -> missingMethod (methodTag method)         Just (Method methodHandler)           -> -- If the methodTag doesn't index the right methodHandler then we're in deep

@@ -38,11 +38,11 @@  import Data.Acid.Log as Log import Data.Acid.Core+import Data.Acid.Common  import Control.Concurrent             ( newEmptyMVar, putMVar, takeMVar, MVar ) --import Control.Exception              ( evaluate )-import Control.Monad.State            ( MonadState, State, get, runState )-import Control.Monad.Reader           ( Reader, runReader, MonadReader )+import Control.Monad.State            ( runState ) import Control.Monad.Trans            ( MonadIO(liftIO) ) import Control.Applicative            ( (<$>), (<*>) ) import Data.ByteString.Lazy           ( ByteString )@@ -55,38 +55,7 @@ import Data.Typeable                  ( Typeable, typeOf ) import System.FilePath                ( (</>) ) -import Control.Applicative            (Applicative(..)) --- | Events return the same thing as Methods. The exact type of 'EventResult'---   depends on the event.-type EventResult ev = MethodResult ev--type EventState ev = MethodState ev---- | We distinguish between events that modify the state and those that do not.------   UpdateEvents are executed in a MonadState context and have to be serialized---   to disk before they are considered durable.------   QueryEvents are executed in a MonadReader context and obviously do not have---   to be serialized to disk.-data Event st where-    UpdateEvent :: UpdateEvent ev => (ev -> Update (EventState ev) (EventResult ev)) -> Event (EventState ev)-    QueryEvent  :: QueryEvent  ev => (ev -> Query (EventState ev) (EventResult ev)) -> Event (EventState ev)---- | All UpdateEvents are also Methods.-class Method ev => UpdateEvent ev--- | All QueryEvents are also Methods.-class Method ev => QueryEvent ev---eventsToMethods :: [Event st] -> [MethodContainer st]-eventsToMethods = map worker-    where worker :: Event st -> MethodContainer st-          worker (UpdateEvent fn) = Method (unUpdate . fn)-          worker (QueryEvent fn)  = Method (\ev -> do st <- get-                                                      return (runReader (unQuery $ fn ev) st)-                                           ) {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability)     guarantees. @@ -106,28 +75,7 @@                 , localCheckpoints :: FileLog Checkpoint                 } --- | Context monad for Update events.-newtype Update st a = Update { unUpdate :: State st a }-#if MIN_VERSION_mtl(2,0,0)-    deriving (Monad, Functor, Applicative, MonadState st)-#else-    deriving (Monad, Functor, MonadState st)-#endif --- | Context monad for Query events.-newtype Query st a  = Query { unQuery :: Reader st a }-#if MIN_VERSION_mtl(2,0,0)-    deriving (Monad, Functor, Applicative, MonadReader st)-#else-    deriving (Monad, Functor, MonadReader st)-#endif---- | Run a query in the Update Monad.-runQuery :: Query st a -> Update st a-runQuery query-    = do st <- get-         return (runReader (unQuery query) st)- -- | Issue an Update event and wait for its result. Once this call returns, you are --   guaranteed that the changes to the state are durable. Events may be issued in --   parallel.@@ -160,7 +108,7 @@               pushEntry (localEvents acidState) (methodTag event, encoded) $ putMVar mvar result               return st'          return mvar-    where hotMethod = lookupHotMethod (localCore acidState) event+    where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event  -- | Same as 'update' but lifted into any monad capable of doing IO. update' :: (UpdateEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)@@ -178,7 +126,7 @@               pushAction (localEvents acidState) $                 putMVar mvar result          takeMVar mvar-    where hotMethod = lookupHotMethod (localCore acidState) event+    where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event  -- | Same as 'query' but lifted into any monad capable of doing IO. query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)@@ -226,9 +174,6 @@              safePut content     getCopy = contain $ Checkpoint <$> safeGet <*> safeGet -class (SafeCopy st) => IsAcidic st where-    acidEvents :: [Event st]-      -- ^ List of events capable of updating or querying the state.  -- | Create an AcidState given an initial value. --

@@ -0,0 +1,136 @@+{-# LANGUAGE GADTs, OverloadedStrings, DeriveDataTypeable, TypeFamilies,+             GeneralizedNewtypeDeriving, BangPatterns, CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Acid.Memory+-- Copyright   :  PublicDomain+--+-- Maintainer  :  lemmih@gmail.com+-- Portability :  non-portable (uses GHC extensions)+--+-- AcidState container without a transaction log. Mostly used for testing. +--++module Data.Acid.Memory+    ( IsAcidic(..)+    , AcidState+    , Event(..)+    , EventResult+    , EventState+    , UpdateEvent+    , QueryEvent+    , Update+    , Query+    , openAcidState+    , closeAcidState+    , createCheckpoint+    , createCheckpointAndClose+    , update+    , scheduleUpdate+    , query+    , update'+    , query'+    , runQuery+    ) where++import Data.Acid.Core+import Data.Acid.Common++import Control.Concurrent             ( newEmptyMVar, putMVar, takeMVar, MVar )+import Control.Monad.State            ( runState )+import Control.Monad.Trans            ( MonadIO(liftIO) )+++import Data.SafeCopy                  ( SafeCopy(..) )+++{-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability)+    guarantees.++    [@Atomicity@]  State changes are all-or-nothing. This is what you'd expect of any state+                   variable in Haskell and AcidState doesn't change that.++    [@Consistency@] No event or set of events will break your data invariants.++    [@Isolation@] Transactions cannot interfere with each other even when issued in parallel.++    [@Durability@] Successful transaction are guaranteed to survive system failure (both+                   hardware and software).+-}+data AcidState st+    = AcidState { localCore    :: Core st+                }++-- | Issue an Update event and wait for its result. Once this call returns, you are+--   guaranteed that the changes to the state are durable. Events may be issued in+--   parallel.+--+--   It's a run-time error to issue events that aren't supported by the AcidState.+update :: UpdateEvent event => AcidState (EventState event) -> event -> IO (EventResult event)+update acidState event+    = takeMVar =<< scheduleUpdate acidState event++-- | Issue an Update event and return immediately. The event is not durable+--   before the MVar has been filled but the order of events is honored.+--   The behavior in case of exceptions is exactly the same as for 'update'.+--+--   If EventA is scheduled before EventB, EventA /will/ be executed before EventB:+--+--   @+--do scheduleUpdate acid EventA+--   scheduleUpdate acid EventB+--   @+scheduleUpdate :: UpdateEvent event => AcidState (EventState event) -> event -> IO (MVar (EventResult event))+scheduleUpdate acidState event+    = do mvar <- newEmptyMVar+         modifyCoreState_ (localCore acidState) $ \st ->+           do let !(result, !st') = runState hotMethod st+              putMVar mvar result+              return st'+         return mvar+    where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event++-- | Same as 'update' but lifted into any monad capable of doing IO.+update' :: (UpdateEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)+update' acidState event+    = liftIO (update acidState event)++-- | Issue a Query event and wait for its result. Events may be issued in parallel.+query  :: QueryEvent event  => AcidState (EventState event) -> event -> IO (EventResult event)+query acidState event+    = do mvar <- newEmptyMVar+         withCoreState (localCore acidState) $ \st ->+           do let (result, _st) = runState hotMethod st+              putMVar mvar result+         takeMVar mvar+    where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event++-- | Same as 'query' but lifted into any monad capable of doing IO.+query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)+query' acidState event+    = liftIO (query acidState event)++-- | This is a nop with the memory backend.+createCheckpoint :: SafeCopy st => AcidState st -> IO ()+createCheckpoint acidState+    = return ()++-- | This is an alias for 'closeAcidState' when using the memory backend.+createCheckpointAndClose :: SafeCopy st => AcidState st -> IO ()+createCheckpointAndClose = closeAcidState+++-- | Create an AcidState given an initial value.+openAcidState :: (IsAcidic st)+              => st                          -- ^ Initial state value. +              -> IO (AcidState st)+openAcidState initialState+    = do core <- mkCore (eventsToMethods acidEvents) initialState+         return AcidState { localCore = core }++-- | Close an AcidState and associated logs.+--   Any subsequent usage of the AcidState will throw an exception.+closeAcidState :: AcidState st -> IO ()+closeAcidState acidState+    = closeCore (localCore acidState)+

@@ -0,0 +1,87 @@+{-# LANGUAGE GADTs, OverloadedStrings, DeriveDataTypeable, TypeFamilies,+             GeneralizedNewtypeDeriving, BangPatterns, CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Acid.Memory.Pure+-- Copyright   :  PublicDomain+--+-- Maintainer  :  lemmih@gmail.com+-- Portability :  non-portable (uses GHC extensions)+--+-- AcidState container without a transaction log. Mostly used for testing. +--++module Data.Acid.Memory.Pure+    ( IsAcidic(..)+    , AcidState+    , Event(..)+    , EventResult+    , EventState+    , UpdateEvent+    , QueryEvent+    , Update+    , Query+    , openAcidState+    , update+    , update_+    , query+    , runQuery+    ) where++import Data.Acid.Core+import Data.Acid.Common++import Control.Monad.State            ( runState )+++{-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability)+    guarantees.++    [@Atomicity@]  State changes are all-or-nothing. This is what you'd expect of any state+                   variable in Haskell and AcidState doesn't change that.++    [@Consistency@] No event or set of events will break your data invariants.++    [@Isolation@] Transactions cannot interfere with each other even when issued in parallel.++    [@Durability@] Successful transaction are guaranteed to survive system failure (both+                   hardware and software).+-}+data AcidState st+    = AcidState { localMethods :: MethodMap st+                , localState   :: st+                }++-- | Issue an Update event and wait for its result. Once this call returns, you are+--   guaranteed that the changes to the state are durable. Events may be issued in+--   parallel.+--+--   It's a run-time error to issue events that aren't supported by the AcidState.+update :: UpdateEvent event => AcidState (EventState event) -> event -> ( AcidState (EventState event)+                                                                        , EventResult event)+update acidState event+    = case runState hotMethod (localState acidState) of+        !(result, !newState) -> ( acidState { localState = newState }+                                , result )+    where hotMethod = lookupHotMethod (localMethods acidState) event++-- | Same as 'update' but ignoring the event result.+update_ :: UpdateEvent event => AcidState (EventState event) -> event -> AcidState (EventState event)+update_ acidState event+    = fst (update acidState event)++-- | Issue a Query event and wait for its result.+query  :: QueryEvent event  => AcidState (EventState event) -> event -> EventResult event+query acidState event+    = case runState hotMethod (localState acidState) of+        !(result, !_st) -> result+    where hotMethod = lookupHotMethod (localMethods acidState) event++-- | Create an AcidState given an initial value.+openAcidState :: (IsAcidic st)+              => st                          -- ^ Initial state value. +              -> (AcidState st)+openAcidState initialState+    = AcidState { localMethods = mkMethodMap (eventsToMethods acidEvents) +                , localState   = initialState }+