Pure.hs

{-# LANGUAGE DeriveDataTypeable, BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- 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 }