1 files changed, 86 insertions, 0 deletions
diff --git a/Hero/Keep.hs b/Hero/Keep.hs
new file mode 100644
index 0000000..9ac46fa
--- /dev/null
+++ b/Hero/Keep.hs
@@ -0,0 +1,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