module Data.Acid.Abstract
( AcidState(..)
, scheduleUpdate
, update
, update'
, query
, query'
, mkAnyState
, downcast
) where
import Data.Acid.Common
import Data.Acid.Core
import Control.Concurrent ( MVar, takeMVar )
import Data.ByteString.Lazy ( ByteString )
import Control.Monad.Trans ( MonadIO(liftIO) )
import Data.Typeable ( Typeable1, gcast1, typeOf1 )
data AnyState st where
AnyState :: Typeable1 sub_st => sub_st st -> AnyState st
data AcidState st
= AcidState {
_scheduleUpdate :: forall event. (UpdateEvent event, EventState event ~ st) => event -> IO (MVar (EventResult event))
, scheduleColdUpdate :: Tagged ByteString -> IO (MVar ByteString)
, _query :: (QueryEvent event, EventState event ~ st) => event -> IO (EventResult event)
, queryCold :: Tagged ByteString -> IO ByteString
,
createCheckpoint :: IO ()
,
closeAcidState :: IO ()
, acidSubState :: AnyState st
}
scheduleUpdate :: UpdateEvent event => AcidState (EventState event) -> event -> IO (MVar (EventResult event))
scheduleUpdate = _scheduleUpdate
update :: UpdateEvent event => AcidState (EventState event) -> event -> IO (EventResult event)
update acidState event = takeMVar =<< scheduleUpdate 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 = _query
query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event)
query' acidState event = liftIO (query acidState event)
mkAnyState :: Typeable1 sub_st => sub_st st -> AnyState st
mkAnyState = AnyState
downcast :: Typeable1 sub => AcidState st -> sub st
downcast AcidState{acidSubState = AnyState sub}
= case gcast1 (Just sub) of
Just (Just typed_sub_struct) -> typed_sub_struct `asTypeOf` result
Nothing -> error $ "Data.Acid: Invalid subtype cast: " ++ show tag ++ " -> " ++ show (typeOf1 result)
where result = undefined
tag = show (typeOf1 sub)