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(..) )
data AcidState st
= AcidState { localCore :: Core st
}
update :: UpdateEvent event => AcidState (EventState event) -> event -> IO (EventResult event)
update acidState event
= takeMVar =<< scheduleUpdate acidState event
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
update' :: (UpdateEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)
update' acidState event
= liftIO (update acidState event)
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
query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)
query' acidState event
= liftIO (query acidState event)
createCheckpoint :: SafeCopy st => AcidState st -> IO ()
createCheckpoint acidState
= return ()
createCheckpointAndClose :: SafeCopy st => AcidState st -> IO ()
createCheckpointAndClose = closeAcidState
openAcidState :: (IsAcidic st)
=> st
-> IO (AcidState st)
openAcidState initialState
= do core <- mkCore (eventsToMethods acidEvents) initialState
return AcidState { localCore = core }
closeAcidState :: AcidState st -> IO ()
closeAcidState acidState
= closeCore (localCore acidState)