From 378e007141c699945080bbf944aeef4abf67d75c Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Thu, 6 Jun 2024 23:05:41 +0200
Subject: add new collection page

---
 frontend/app/Main.hs               |  7 +++++-
 frontend/app/Page.hs               | 10 +++++++++
 frontend/app/Page/NewCollection.hs | 44 ++++++++++++++++++++++++++++++++++++++
 frontend/app/Route.hs              |  3 +++
 4 files changed, 63 insertions(+), 1 deletion(-)
 create mode 100644 frontend/app/Page/NewCollection.hs

(limited to 'frontend/app')

diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index f5ec4b6..3a2c5a6 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -214,7 +214,12 @@ viewBranch s =
 viewCollections :: LoadedState -> View Action
 viewCollections s =
   section_ [] $
-    [ span_ [] [text "collections"],
+    [ span_
+        []
+        [ text "collections",
+          text " ",
+          a_ [href_ "#collection/new"] [text "+new"]
+        ],
       ol_ [] $
         [ li_
             []
diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs
index 762ae90..16191dd 100644
--- a/frontend/app/Page.hs
+++ b/frontend/app/Page.hs
@@ -13,6 +13,7 @@ import Data.Function
 import Miso
 import Page.EditValue qualified as EditValue
 import Page.ListCollection qualified as ListCollection
+import Page.NewCollection qualified as NewCollection
 import Route (Route)
 import Route qualified as Route
 
@@ -20,11 +21,13 @@ data Page
   = Home
   | ListCollection ListCollection.Model
   | EditValue EditValue.Model
+  | NewCollection NewCollection.Model
   deriving (Show, Eq)
 
 data Action
   = HandleListCollection ListCollection.Action
   | HandleEditValue EditValue.Action
+  | HandleNewCollection NewCollection.Action
   deriving (Show, Eq)
 
 instance Default Page where
@@ -36,6 +39,8 @@ initialPage (Route.ListCollection c) =
   fmap ListCollection <$> ListCollection.initialModel c
 initialPage (Route.EditValue c f) =
   fmap EditValue <$> EditValue.initialModel c f
+initialPage Route.NewCollection =
+  fmap NewCollection <$> NewCollection.initialModel
 
 updatePage :: Action -> Page -> Effect Action Page
 updatePage (HandleListCollection action) (ListCollection m) =
@@ -46,8 +51,13 @@ updatePage (HandleEditValue action) (EditValue m) =
   EditValue.updateModel action m
     & bimap HandleEditValue EditValue
 updatePage (HandleEditValue _) p = noEff p
+updatePage (HandleNewCollection action) (NewCollection m) =
+  NewCollection.updateModel action m
+    & bimap HandleNewCollection NewCollection
+updatePage (HandleNewCollection _) p = noEff p
 
 viewPage :: Page -> View Action
 viewPage Home = text "home"
 viewPage (ListCollection m) = HandleListCollection <$> ListCollection.viewModel m
 viewPage (EditValue m) = HandleEditValue <$> EditValue.viewModel m
+viewPage (NewCollection m) = HandleNewCollection <$> NewCollection.viewModel m
diff --git a/frontend/app/Page/NewCollection.hs b/frontend/app/Page/NewCollection.hs
new file mode 100644
index 0000000..b105689
--- /dev/null
+++ b/frontend/app/Page/NewCollection.hs
@@ -0,0 +1,44 @@
+module Page.NewCollection
+  ( Model,
+    initialModel,
+    Action,
+    updateModel,
+    viewModel,
+  )
+where
+
+import Data.Text qualified as T
+import Form qualified as F
+import Miso
+
+data Model = Model
+  { input :: T.Text
+  }
+  deriving (Show, Eq)
+
+initialModel :: JSM (Either String Model)
+initialModel = do
+  pure (Right (Model {input = ""}))
+
+data Action
+  = NoOp
+  | FormChanged T.Text
+  | FormSubmitted T.Text
+  deriving (Eq, Show)
+
+updateModel :: Action -> Model -> Effect Action Model
+updateModel NoOp m = noEff m
+updateModel (FormChanged input) m = noEff m {input}
+updateModel (FormSubmitted _) m = noEff m
+
+viewModel :: Model -> View Action
+viewModel m = do
+  div_ [] $
+    [ h3_ [] [text "new collection"],
+      either FormChanged FormSubmitted
+        <$> F.runForm collectionForm m.input
+    ]
+
+collectionForm :: F.Form T.Text T.Text
+collectionForm =
+  F.input "name"
diff --git a/frontend/app/Route.hs b/frontend/app/Route.hs
index 546939c..d683b76 100644
--- a/frontend/app/Route.hs
+++ b/frontend/app/Route.hs
@@ -14,6 +14,7 @@ data Route
   = Home
   | ListCollection String
   | EditValue String String
+  | NewCollection
   deriving (Show, Eq)
 
 instance Default Route where
@@ -27,6 +28,7 @@ parseURI uri =
           [ EditValue
               <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/"))
               <*> (P.many1 P.anyChar),
+            pure NewCollection <* (P.string "#collection/new"),
             ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
             pure Home
           ]
@@ -38,3 +40,4 @@ routeToString :: Route -> String
 routeToString Home = "#"
 routeToString (ListCollection collection) = "#collection/" <> collection
 routeToString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
+routeToString NewCollection = "#collection/new"
-- 
cgit v1.2.3