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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hero.Keep
( HeroKeep,
GetComics (..),
getComics,
NewComic (..),
newComic,
open,
close,
)
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.
data HeroKeep
= HeroKeep
{ _comics :: (IxSet Comic),
_users :: (IxSet User)
}
deriving (Data, Typeable)
$(deriveSafeCopy 0 'base ''HeroKeep)
-- * Index @Comic@
$(deriveSafeCopy 0 'base ''Comic)
$(deriveSafeCopy 0 'base ''User)
$(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]
]
instance Indexable User where
empty =
ixSet
[ ixFun $ \u -> [userEmail u],
ixFun $ \u -> [userName u],
ixFun $ \u -> [userLibrary u]
]
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],
_users = IxSet.fromList
[ User "a" "micheal" [],
User "b" "ben" []
]
}
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..."
]
}
open :: String -> IO (Acid.AcidState HeroKeep)
open dir = Acid.openLocalStateFrom dir initialHeroKeep
close :: Acid.AcidState HeroKeep -> IO ()
close = Acid.closeAcidState
|
