summaryrefslogtreecommitdiff
path: root/Biz/Ibb/Keep.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Ibb/Keep.hs')
-rw-r--r--Biz/Ibb/Keep.hs131
1 files changed, 0 insertions, 131 deletions
diff --git a/Biz/Ibb/Keep.hs b/Biz/Ibb/Keep.hs
deleted file mode 100644
index 074a42a..0000000
--- a/Biz/Ibb/Keep.hs
+++ /dev/null
@@ -1,131 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# 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 Alpha
-import Biz.Ibb.Core (Book (..), Person (..))
-import qualified Biz.Ibb.Influencers as Influencers
-import Control.Monad.Reader (ask)
-import Control.Monad.State (get, put)
-import Data.Acid (Update, makeAcidic)
-import qualified Data.Acid as Acid
-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.
-newtype IbbKeep = IbbKeep
- { _people :: IxSet Person
- }
- deriving (Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''IbbKeep)
-
--- * 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
- keep <- 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
- }
-
-getPeople :: Int -> Acid.Query IbbKeep [Person]
-getPeople n = ask /> _people /> IxSet.toList /> take n
-
--- * 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
--- }
-
--- * Opening the keep
-
--- defines @NewPerson@ for us.
-$(makeAcidic ''IbbKeep ['newPerson, 'getPeople])
-
-initialIbbKeep :: IbbKeep
-initialIbbKeep =
- IbbKeep
- { _people = IxSet.fromList Influencers.allPeople
- }
-
-openLocal :: String -> IO (Acid.AcidState IbbKeep)
-openLocal dir =
- Acid.openLocalStateFrom dir initialIbbKeep