module Serokell.AcidState.ExtendedState
( ExtendedState (..)
, closeExtendedState
, extendedStateToAcid
, openLocalExtendedState
, openMemoryExtendedState
, queryExtended
, tidyExtendedState
, updateExtended
) where
import Control.Monad.Extra (whenM)
import Control.Monad.Trans (MonadIO (liftIO))
import Data.Acid (AcidState, EventResult, EventState, IsAcidic,
QueryEvent, UpdateEvent, closeAcidState,
openLocalStateFrom)
import Data.Acid.Advanced (query', update')
import Data.Acid.Memory (openMemoryState)
import Data.Typeable (Typeable)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import Serokell.AcidState.Util (tidyLocalState)
data ExtendedState st
= ESLocal (AcidState st)
FilePath
| ESMemory (AcidState st)
extendedStateToAcid :: ExtendedState st -> AcidState st
extendedStateToAcid (ESLocal s _) = s
extendedStateToAcid (ESMemory s) = s
queryExtended
:: (EventState event ~ st, QueryEvent event, MonadIO m)
=> ExtendedState st -> event -> m (EventResult event)
queryExtended st = query' (extendedStateToAcid st)
updateExtended
:: (EventState event ~ st, UpdateEvent event, MonadIO m)
=> ExtendedState st -> event -> m (EventResult event)
updateExtended st = update' (extendedStateToAcid st)
openLocalExtendedState
:: (IsAcidic st, Typeable st, MonadIO m)
=> Bool -> FilePath -> st -> m (ExtendedState st)
openLocalExtendedState deleteIfExists fp st = do
whenM ((deleteIfExists &&) <$> liftIO (doesDirectoryExist fp)) $
liftIO $ removeDirectoryRecursive fp
liftIO $ flip ESLocal fp <$> openLocalStateFrom fp st
openMemoryExtendedState
:: (IsAcidic st, Typeable st, MonadIO m)
=> st -> m (ExtendedState st)
openMemoryExtendedState st = liftIO $ ESMemory <$> openMemoryState st
closeExtendedState :: MonadIO m => ExtendedState st -> m ()
closeExtendedState = liftIO . closeAcidState . extendedStateToAcid
tidyExtendedState :: MonadIO m => ExtendedState st -> m ()
tidyExtendedState (ESLocal st fp) = tidyLocalState st fp
tidyExtendedState (ESMemory _) = return ()