1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
{-# 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
|
