From 37062e1ca6c479b7cf773931aa0e797ebcfafe8b Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 5 Jun 2020 22:27:14 -0700
Subject: Add user datatype to keep

I also restructured some types so that I could grab a handle on the keep to
close it on shutdown, otherwise the database would be locked and I can't do
anything about it. This might mean I have to delete and start the database from
scratch when I deploy, but that's okay because I haven't stored anything yet.

I also renamed some stuff like 'deck' and 'beam' just for fun. I could make
these into more general interfaces like I always planned to.

Also I haven't really tested this yet, so... next commit will implement the user
login.
---
 Hero/Keep.hs | 39 +++++++++++++++++++++++++++++++--------
 1 file changed, 31 insertions(+), 8 deletions(-)

(limited to 'Hero/Keep.hs')

diff --git a/Hero/Keep.hs b/Hero/Keep.hs
index 9ac46fa..ee625d8 100644
--- a/Hero/Keep.hs
+++ b/Hero/Keep.hs
@@ -6,11 +6,12 @@
 
 module Hero.Keep
   ( HeroKeep,
-    GetComics(..),
+    GetComics (..),
     getComics,
-    NewComic(..),
+    NewComic (..),
     newComic,
-    openLocal,
+    open,
+    close,
   )
 where
 
@@ -27,9 +28,11 @@ import Hero.App
 -- * Keep
 
 -- | Main database.
-newtype HeroKeep
+data HeroKeep
   = HeroKeep
-      {_comics :: (IxSet Comic)}
+      { _comics :: (IxSet Comic),
+        _users :: (IxSet User)
+      }
   deriving (Data, Typeable)
 
 $(deriveSafeCopy 0 'base ''HeroKeep)
@@ -38,6 +41,8 @@ $(deriveSafeCopy 0 'base ''HeroKeep)
 
 $(deriveSafeCopy 0 'base ''Comic)
 
+$(deriveSafeCopy 0 'base ''User)
+
 $(deriveSafeCopy 0 'base ''ComicId)
 
 instance Indexable Comic where
@@ -50,6 +55,14 @@ instance Indexable Comic where
         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
@@ -64,7 +77,14 @@ getComics n = ask /> _comics /> IxSet.toList /> take n
 $(makeAcidic ''HeroKeep ['newComic, 'getComics])
 
 initialHeroKeep :: HeroKeep
-initialHeroKeep = HeroKeep {_comics = IxSet.fromList [theRed] }
+initialHeroKeep =
+  HeroKeep
+    { _comics = IxSet.fromList [theRed],
+      _users = IxSet.fromList
+        [ User "a" "micheal" [],
+          User "b" "ben" []
+        ]
+    }
   where
     theRed =
       Comic
@@ -82,5 +102,8 @@ initialHeroKeep = HeroKeep {_comics = IxSet.fromList [theRed] }
               ]
         }
 
-openLocal :: String -> IO (Acid.AcidState HeroKeep)
-openLocal dir = Acid.openLocalStateFrom dir initialHeroKeep
+open :: String -> IO (Acid.AcidState HeroKeep)
+open dir = Acid.openLocalStateFrom dir initialHeroKeep
+
+close :: Acid.AcidState HeroKeep -> IO ()
+close = Acid.closeAcidState
-- 
cgit v1.2.3