module Clckwrks.Media.Acid where
import Control.Monad.Reader (ask)
import Control.Monad.State (get, put)
import Data.Acid (Query, Update, makeAcidic)
import Data.IxSet (IxSet, (@=), getOne, empty, toList, updateIx)
import Data.SafeCopy (base, deriveSafeCopy)
import Clckwrks.Media.Types (Medium(..), MediumId(..))
data MediaState = MediaState
{ nextMediumId :: MediumId
, media :: IxSet Medium
}
$(deriveSafeCopy 0 'base ''MediaState)
initialMediaState :: MediaState
initialMediaState = MediaState
{ nextMediumId = MediumId 0
, media = empty
}
genMediumId :: Update MediaState MediumId
genMediumId =
do ms@MediaState{..} <- get
put $ ms { nextMediumId = MediumId $ succ $ unMediumId $ nextMediumId }
return nextMediumId
getMediumById :: MediumId -> Query MediaState (Maybe Medium)
getMediumById mid =
do MediaState{..} <- ask
return $ getOne (media @= mid)
putMedium :: Medium -> Update MediaState ()
putMedium m =
do ms@MediaState{..} <- get
put $ ms { media = updateIx (mediumId m) m media }
allMediumIds :: Query MediaState [MediumId]
allMediumIds =
do MediaState{..} <- ask
return $ map mediumId (toList media)
$(makeAcidic ''MediaState
[ 'genMediumId
, 'getMediumById
, 'putMedium
, 'allMediumIds
]
)