diff options
author | Ben Sima <ben@bsima.me> | 2020-06-05 22:27:14 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2020-06-05 22:29:30 -0700 |
commit | 37062e1ca6c479b7cf773931aa0e797ebcfafe8b (patch) | |
tree | 56a2262621f85dc3aabe6983da1da689837b7836 /Hero/Keep.hs | |
parent | 99c0a806be7fa502394cc3b3634ce7eb43f97024 (diff) |
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.
Diffstat (limited to 'Hero/Keep.hs')
-rw-r--r-- | Hero/Keep.hs | 39 |
1 files changed, 31 insertions, 8 deletions
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 |