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
|
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Keep is a database built on Data.Acid.
--
-- If this proves useful, maybe we could make it a more general thing. Like
-- `Biz.Keep`. I could wrap all the safecopy stuff in my own template haskell
-- like `$(keep ''MyType)`.
--
module Biz.Ibb.Keep where
import Biz.Ibb.Core (Person(..), Book(..))
import Control.Monad.State (get, put)
import Data.Acid (Update)
import Data.Data (Data, Typeable)
import Data.IxSet (Indexable(..), IxSet, ixFun, ixSet)
import qualified Data.IxSet as IxSet
import Data.SafeCopy
import Data.Text (Text)
import qualified Data.Text as Text
-- * Keep
-- | Main database. Need to think of a better name for this.
data IbbKeep = IbbKeep
{ _people :: IxSet Person
}
deriving (Data, Typeable)
$(deriveSafeCopy 0 'base ''IbbKeep)
initialIbbKeep :: IbbKeep
initialIbbKeep = IbbKeep
{ _people = empty
}
-- * Index @Person@
$(deriveSafeCopy 0 'base ''Person)
newtype PersonName =
PersonName Text deriving (Eq, Ord, Data, Typeable)
newtype PersonBlurb =
PersonBlurb Text deriving (Eq, Ord, Data, Typeable)
instance Indexable Person where
empty = ixSet
[ ixFun $ \p -> [ PersonName $ _name p ]
, ixFun $ \p -> [ _pic p ]
, ixFun $ \p -> [ _twitter p ]
, ixFun $ \p -> [ _website p ]
, ixFun $ \p -> [ _books p ]
, ixFun $ \p -> [ PersonBlurb $ _blurb p ]
]
-- | updates the `IbbKeep` with a new `Person`
newPerson :: Text -> Text -> Update IbbKeep Person
newPerson name blurb = do
k <- get
put $ k { _people = IxSet.insert p (_people k)
}
return p
where
p = Person
{ _name = name
, _pic = Text.empty
, _twitter = Text.empty
, _website = Text.empty
, _books = []
, _blurb = blurb
}
-- * Index @Book@
$(deriveSafeCopy 0 'base ''Book)
newtype BookTitle =
BookTitle Text deriving (Eq, Ord, Data, Typeable)
newtype BookAuthor =
BookAuthor Text deriving (Eq, Ord, Data, Typeable)
instance Indexable Book where
empty = ixSet
[ ixFun $ \b -> [ BookTitle $ _title b ]
, ixFun $ \b -> [ BookAuthor $ _author b ]
, ixFun $ \b -> [ _amznref b ]
]
-- | updates the `IbbKeep` with a new `Book`
--newBook :: Text -> Text -> Text -> Update IbbKeep Book
--newBook title author amznref = do
-- ibbKeep <- get
-- put $ ibbKeep { _books = IxSet.insert b (_books ibbKeep)
-- , _people = _people ibbKeep
-- }
-- return b
-- where
-- b = Book { _title = title
-- , _author = author
-- , _amznref = amznref
-- }
|
