{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hero.Keep ( HeroKeep, GetComics(..), getComics, NewComic(..), newComic, openLocal, ) where import Alpha import qualified Data.Acid as Acid import Data.Acid (Update, makeAcidic) import Data.Data (Data, Typeable) import qualified Data.IxSet as IxSet import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet) import Data.SafeCopy (base, deriveSafeCopy) import qualified Data.Text as Text import Hero.App -- * Keep -- | Main database. newtype HeroKeep = HeroKeep {_comics :: (IxSet Comic)} deriving (Data, Typeable) $(deriveSafeCopy 0 'base ''HeroKeep) -- * Index @Comic@ $(deriveSafeCopy 0 'base ''Comic) $(deriveSafeCopy 0 'base ''ComicId) instance Indexable Comic where empty = ixSet [ ixFun $ \c -> [comicId c], ixFun $ \c -> [comicPages c], ixFun $ \c -> [comicName c], ixFun $ \c -> [comicIssue c], ixFun $ \c -> [comicDescription c] ] newComic :: Comic -> Update HeroKeep Comic newComic c = do keep <- get put $ keep {_comics = IxSet.insert c (_comics keep)} return c getComics :: Int -> Acid.Query HeroKeep [Comic] getComics n = ask /> _comics /> IxSet.toList /> take n -- * Opening the keep $(makeAcidic ''HeroKeep ['newComic, 'getComics]) initialHeroKeep :: HeroKeep initialHeroKeep = HeroKeep {_comics = IxSet.fromList [theRed] } where theRed = Comic { comicId = "1", comicPages = 42, comicName = "The Red", comicIssue = "1.0", comicDescription = Text.unlines [ "In the future, a nuclear world war has changed the course", "of history forever. A single government entity now presides", "over what's left of the world, and prohibits certain content", "that is deemed emotionall dangerous, or \"red\", in attempt", "to maintain order and keep society working..." ] } openLocal :: String -> IO (Acid.AcidState HeroKeep) openLocal dir = Acid.openLocalStateFrom dir initialHeroKeep