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 :: LoadedState -> View Action
viewCollections s = viewCollections s =
section_ [] $ section_ [] $
[ span_ [] [text "collections"], [ span_
[]
[ text "collections",
text " ",
a_ [href_ "#collection/new"] [text "+new"]
],
ol_ [] $ ol_ [] $
[ li_ [ li_
[] []

View File

@@ -13,6 +13,7 @@ import Data.Function
import Miso import Miso
import Page.EditValue qualified as EditValue import Page.EditValue qualified as EditValue
import Page.ListCollection qualified as ListCollection import Page.ListCollection qualified as ListCollection
import Page.NewCollection qualified as NewCollection
import Route (Route) import Route (Route)
import Route qualified as Route import Route qualified as Route
@@ -20,11 +21,13 @@ data Page
= Home = Home
| ListCollection ListCollection.Model | ListCollection ListCollection.Model
| EditValue EditValue.Model | EditValue EditValue.Model
| NewCollection NewCollection.Model
deriving (Show, Eq) deriving (Show, Eq)
data Action data Action
= HandleListCollection ListCollection.Action = HandleListCollection ListCollection.Action
| HandleEditValue EditValue.Action | HandleEditValue EditValue.Action
| HandleNewCollection NewCollection.Action
deriving (Show, Eq) deriving (Show, Eq)
instance Default Page where instance Default Page where
@@ -36,6 +39,8 @@ initialPage (Route.ListCollection c) =
fmap ListCollection <$> ListCollection.initialModel c fmap ListCollection <$> ListCollection.initialModel c
initialPage (Route.EditValue c f) = initialPage (Route.EditValue c f) =
fmap EditValue <$> EditValue.initialModel c f fmap EditValue <$> EditValue.initialModel c f
initialPage Route.NewCollection =
fmap NewCollection <$> NewCollection.initialModel
updatePage :: Action -> Page -> Effect Action Page updatePage :: Action -> Page -> Effect Action Page
updatePage (HandleListCollection action) (ListCollection m) = updatePage (HandleListCollection action) (ListCollection m) =
@@ -46,8 +51,13 @@ updatePage (HandleEditValue action) (EditValue m) =
EditValue.updateModel action m EditValue.updateModel action m
& bimap HandleEditValue EditValue & bimap HandleEditValue EditValue
updatePage (HandleEditValue _) p = noEff p 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 :: Page -> View Action
viewPage Home = text "home" viewPage Home = text "home"
viewPage (ListCollection m) = HandleListCollection <$> ListCollection.viewModel m viewPage (ListCollection m) = HandleListCollection <$> ListCollection.viewModel m
viewPage (EditValue m) = HandleEditValue <$> EditValue.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 = Home
| ListCollection String | ListCollection String
| EditValue String String | EditValue String String
| NewCollection
deriving (Show, Eq) deriving (Show, Eq)
instance Default Route where instance Default Route where
@@ -27,6 +28,7 @@ parseURI uri =
[ EditValue [ EditValue
<$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/")) <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/"))
<*> (P.many1 P.anyChar), <*> (P.many1 P.anyChar),
pure NewCollection <* (P.string "#collection/new"),
ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar), ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
pure Home pure Home
] ]
@@ -38,3 +40,4 @@ routeToString :: Route -> String
routeToString Home = "#" routeToString Home = "#"
routeToString (ListCollection collection) = "#collection/" <> collection routeToString (ListCollection collection) = "#collection/" <> collection
routeToString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName routeToString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
routeToString NewCollection = "#collection/new"

View File

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