add new collection page

This commit is contained in:
Alexander Foremny
2024-06-06 23:05:41 +02:00
parent 3add980b73
commit 378e007141
5 changed files with 64 additions and 1 deletions

View File

@@ -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_
[]

View File

@@ -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

View File

@@ -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"

View File

@@ -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"

View File

@@ -19,6 +19,7 @@ executable frontend
Page
Page.EditValue
Page.ListCollection
Page.NewCollection
Route
Schema