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/App.hs | 59 ++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 40 insertions(+), 19 deletions(-)

(limited to 'Hero/App.hs')

diff --git a/Hero/App.hs b/Hero/App.hs
index 3aca8be..da2289c 100644
--- a/Hero/App.hs
+++ b/Hero/App.hs
@@ -37,7 +37,6 @@ import Miso
 import qualified Miso (for_)
 import Miso.String
 import Network.RemoteData
-import Protolude hiding (replace)
 import Servant.API
   ( (:<|>) (..),
     (:>),
@@ -99,6 +98,29 @@ instance CanSnakeCase Text where
 comicSlug :: Comic -> Text
 comicSlug Comic {..} = snake comicName <> "-" <> comicIssue
 
+data User
+  = User
+      { userEmail :: Text,
+        userName :: Text,
+        userLibrary :: [Comic]
+      }
+  deriving (Show, Eq, Generic, Data, Ord)
+
+instance Semigroup User where
+  a <> b = User
+    (userEmail a <> userEmail b)
+    (userName a <> userName b)
+    (userLibrary a <> userLibrary b)
+
+instance Monoid User where
+  mempty = User mempty mempty mempty
+
+instance ToJSON User where
+  toJSON = genericToJSON Data.Aeson.defaultOptions
+
+instance FromJSON User where
+  parseJSON = genericParseJSON Data.Aeson.defaultOptions
+
 data Comic
   = Comic
       { comicId :: ComicId,
@@ -122,10 +144,10 @@ class IsMediaObject o where
   thumbnail :: o -> View Action
 
   -- | Render a featured banner.
-  feature :: o -> Library -> View Action
+  feature :: o -> User -> View Action
 
   -- | Media info view
-  info :: o -> Library -> View Action
+  info :: o -> User -> View Action
 
 instance IsMediaObject Comic where
   thumbnail c@Comic {..} =
@@ -200,8 +222,8 @@ type ZoomModel = Int
 data Button
   = Watch Comic
   | Read Comic
-  | Save Comic Library
-  | SaveIcon Comic Library
+  | Save Comic User
+  | SaveIcon Comic User
   | ZoomIcon ZoomModel Comic Page
   | PlayPause MisoString AudioState
   | Arrow Action
@@ -231,8 +253,8 @@ instance Elemental Button where
         PrevPage -> "prev-page"
         NextPage -> "next-page"
         _ -> "prev-page"
-  el (Save c lib) =
-    if c `elem` lib -- in library
+  el (Save c u) =
+    if c `elem` (userLibrary u) -- in library
       then
         a_
           [class_ "wrs-button saved", onClick $ ToggleInLibrary c]
@@ -246,8 +268,8 @@ instance Elemental Button where
           [ img_ [src_ $ ms $ Assets.icon <> "save.svg"],
             span_ [] [text "save"]
           ]
-  el (SaveIcon c lib) =
-    if c `elem` lib -- in library
+  el (SaveIcon c u) =
+    if c `elem` (userLibrary u) -- in library
       then
         button_
           [ class_ "button is-large has-background-black",
@@ -297,8 +319,6 @@ instance Elemental Button where
 data AudioState = Playing | Paused
   deriving (Show, Eq)
 
-type Library = [Comic]
-
 data ComicReaderState
   = NotReading
   | Cover ComicId
@@ -318,7 +338,7 @@ data Model
   = Model
       { uri :: URI,
         appComics :: RemoteData MisoString [Comic],
-        userLibrary :: Library,
+        user :: User,
         dMediaInfo :: Maybe Comic,
         cpState :: ComicReaderState,
         cpAudioState :: AudioState,
@@ -332,7 +352,7 @@ initModel uri_ =
     { uri = uri_,
       appComics = NotAsked,
       dMediaInfo = Nothing,
-      userLibrary = Protolude.empty,
+      user = mempty,
       cpState = detectPlayerState uri_,
       cpAudioState = Paused,
       zoomModel = 100
@@ -466,7 +486,7 @@ home :: Model -> View Action
 home = login
 
 discover :: Model -> View Action
-discover model@Model {userLibrary = lib} =
+discover model@Model {user = u} =
   template
     "discover"
     [ topbar,
@@ -476,9 +496,9 @@ discover model@Model {userLibrary = lib} =
         Failure _ -> [nocomics]
         Success [] -> [nocomics]
         Success (comic : rest) ->
-          [ feature comic lib,
+          [ feature comic u,
             shelf "Recent Releases" (comic : rest),
-            maybeView (`info` lib) $ dMediaInfo model
+            maybeView (`info` u) $ dMediaInfo model
           ],
       appmenu,
       discoverFooter
@@ -488,9 +508,10 @@ discover model@Model {userLibrary = lib} =
 maybeView :: (a -> View action) -> Maybe a -> View action
 maybeView = maybe (text "")
 
-mediaInfo :: Maybe Comic -> Library -> View Action
+mediaInfo :: Maybe Comic -> User -> View Action
 mediaInfo Nothing _ = text ""
-mediaInfo (Just comic) lib = div_ [class_ "media-info"] [info comic lib]
+mediaInfo (Just comic) user =
+  div_ [class_ "media-info"] [info comic user]
 
 appmenu :: View Action
 appmenu = aside_ [id_ "appmenu"] $ btn </ links
@@ -712,7 +733,7 @@ comicControls comic page model =
         ],
       div_
         [class_ "comic-controls-share"]
-        [ el $ SaveIcon comic $ userLibrary model,
+        [ el $ SaveIcon comic $ user model,
           el $ ZoomIcon (zoomModel model) comic page,
           button_
             [class_ "button icon is-large", onClick ToggleFullscreen]
-- 
cgit v1.2.3