{-# 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
    , liftQuery
    , runUpdate
    , runQuery
    ) where

import Data.Acid.Core
import Data.Acid.Common

import Control.Monad.State
import Control.Monad.Reader

{-| 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 { AcidState st -> MethodMap st
localMethods :: MethodMap st
                , AcidState st -> 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 (EventState event)
-> event -> (AcidState (EventState event), EventResult event)
update AcidState (EventState event)
acidState event
event
    = case State (EventState event) (EventResult event)
-> EventState event -> (EventResult event, EventState event)
forall s a. State s a -> s -> (a, s)
runState State (EventState event) (EventResult event)
hotMethod (AcidState (EventState event) -> EventState event
forall st. AcidState st -> st
localState AcidState (EventState event)
acidState) of
        !(EventResult event
result, !EventState event
newState) -> ( AcidState (EventState event)
acidState { localState :: EventState event
localState = EventState event
newState }
                                , EventResult event
result )
    where hotMethod :: State (EventState event) (EventResult event)
hotMethod = MethodMap (EventState event)
-> event -> State (EventState event) (EventResult event)
forall method.
Method method =>
MethodMap (MethodState method)
-> method -> State (MethodState method) (MethodResult method)
lookupHotMethod (AcidState (EventState event) -> MethodMap (EventState event)
forall st. AcidState st -> MethodMap st
localMethods AcidState (EventState event)
acidState) event
event

-- | Same as 'update' but ignoring the event result.
update_ :: UpdateEvent event => AcidState (EventState event) -> event -> AcidState (EventState event)
update_ :: AcidState (EventState event)
-> event -> AcidState (EventState event)
update_ AcidState (EventState event)
acidState event
event
    = (AcidState (EventState event), MethodResult event)
-> AcidState (EventState event)
forall a b. (a, b) -> a
fst (AcidState (EventState event)
-> event -> (AcidState (EventState event), MethodResult event)
forall event.
UpdateEvent event =>
AcidState (EventState event)
-> event -> (AcidState (EventState event), EventResult event)
update AcidState (EventState event)
acidState event
event)

-- | Issue a Query event and wait for its result.
query  :: QueryEvent event  => AcidState (EventState event) -> event -> EventResult event
query :: AcidState (EventState event) -> event -> EventResult event
query AcidState (EventState event)
acidState event
event
    = case State (EventState event) (EventResult event)
-> EventState event -> (EventResult event, EventState event)
forall s a. State s a -> s -> (a, s)
runState State (EventState event) (EventResult event)
hotMethod (AcidState (EventState event) -> EventState event
forall st. AcidState st -> st
localState AcidState (EventState event)
acidState) of
        !(EventResult event
result, !EventState event
_st) -> EventResult event
result
    where hotMethod :: State (EventState event) (EventResult event)
hotMethod = MethodMap (EventState event)
-> event -> State (EventState event) (EventResult event)
forall method.
Method method =>
MethodMap (MethodState method)
-> method -> State (MethodState method) (MethodResult method)
lookupHotMethod (AcidState (EventState event) -> MethodMap (EventState event)
forall st. AcidState st -> MethodMap st
localMethods AcidState (EventState event)
acidState) event
event

-- | Create an AcidState given an initial value.
openAcidState :: IsAcidic st
              => st                          -- ^ Initial state value.
              -> AcidState st
openAcidState :: st -> AcidState st
openAcidState st
initialState
    = AcidState :: forall st. MethodMap st -> st -> AcidState st
AcidState { localMethods :: MethodMap st
localMethods = [MethodContainer st] -> MethodMap st
forall st. [MethodContainer st] -> MethodMap st
mkMethodMap ([Event st] -> [MethodContainer st]
forall st. [Event st] -> [MethodContainer st]
eventsToMethods [Event st]
forall st. IsAcidic st => [Event st]
acidEvents)
                , localState :: st
localState   = st
initialState }

-- | Execute the 'Update' monad in a pure environment.
runUpdate :: Update s r -> s -> (r, s)
runUpdate :: Update s r -> s -> (r, s)
runUpdate Update s r
update = State s r -> s -> (r, s)
forall s a. State s a -> s -> (a, s)
runState (State s r -> s -> (r, s)) -> State s r -> s -> (r, s)
forall a b. (a -> b) -> a -> b
$ Update s r -> State s r
forall st a. Update st a -> State st a
unUpdate Update s r
update

-- | Execute the 'Query' monad in a pure environment.
runQuery :: Query s r -> s -> r
runQuery :: Query s r -> s -> r
runQuery Query s r
query = Reader s r -> s -> r
forall r a. Reader r a -> r -> a
runReader (Reader s r -> s -> r) -> Reader s r -> s -> r
forall a b. (a -> b) -> a -> b
$ Query s r -> Reader s r
forall st a. Query st a -> Reader st a
unQuery Query s r
query