From 57b892ef54c1747953b25395bfab78835e62d2a7 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 17 Dec 2024 23:53:00 +0100
Subject: style menu
---
frontend/app/Main.hs | 63 +++++++++++++++++++++++++++++++++++--
frontend/app/Page.hs | 31 +++++++++++-------
frontend/app/Page/ListCollection.hs | 2 +-
3 files changed, 81 insertions(+), 15 deletions(-)
(limited to 'frontend')
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index e4729b4..eb05983 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -7,6 +7,7 @@ import Language.Javascript.JSaddle.Warp as JSaddle
#endif
import ACMS.API.REST as API.REST
+import Control.Monad (join)
import Control.Monad.Catch
import Control.Monad.Trans
import Data.Bifunctor
@@ -20,6 +21,7 @@ import NeatInterpolation qualified as Q
import Page (Page, initialPage, updatePage, viewPage)
import Page qualified as Page
import Route (parseURI)
+import Route qualified
import Version
data Model
@@ -189,7 +191,7 @@ header {
nav, main {
min-height: 100%; }
nav {
- flex: 0 0 200px; }
+ flex: 0 0 260px; }
main {
flex: 1 1 auto; }
@@ -236,6 +238,52 @@ table {
th, td {
border-top: 1px solid gray;
border-bottom: 1px solid gray; }
+
+/* menu */
+nav {
+ padding: 16px 0 0; }
+
+nav ol {
+ list-style-type: none;
+ line-height: 32px;
+ padding: 0;
+ margin: 0; }
+
+nav {
+ display: flex;
+ flex-flow: column nowrap;
+ height: calc(100vh - 64px); }
+
+nav section {
+ display: flex;
+ flex-flow: column nowrap; }
+
+nav section > span {
+ line-height: 32px;
+ padding-left: 8px; }
+
+nav section > span:not(:first-child) {
+ margin-top: 24px; }
+
+nav li {
+ white-space: pre;
+ overflow: hidden;
+ text-overflow: ellipsis; }
+
+nav li {
+ display: flex; }
+
+nav li a {
+ flex: 0 0 100%;
+ padding: 4px 8px 4px;
+ color: black;
+ text-decoration: none; }
+
+nav li a.active {
+ background-color: lightgray; }
+
+nav li a:hover, nav li a:active {
+ background-color: whitesmoke; }
|]
)
]
@@ -270,7 +318,18 @@ viewCollections s =
[ li_
[]
[ a_
- [href_ (toMisoString ("#collection/" <> collection))]
+ ( concat
+ [ [href_ (toMisoString ("#collection/" <> collection))],
+ if ( fmap Page.route
+ . join
+ . fmap (either (\_ -> Nothing) Just)
+ $ s.page
+ )
+ == Just (Route.ListCollection collection)
+ then [class_ "active"]
+ else []
+ ]
+ )
[text (toMisoString collection)]
]
| collection <- s.collections
diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs
index e1c8415..ed1e44d 100644
--- a/frontend/app/Page.hs
+++ b/frontend/app/Page.hs
@@ -4,6 +4,7 @@ module Page
initialPage,
updatePage,
viewPage,
+ route,
)
where
@@ -13,8 +14,8 @@ import Data.Bifunctor
import Data.Default
import Data.Function
import Effect (Eff)
-import Miso
-import Miso.String (fromMisoString)
+import Miso hiding (route)
+import Miso.String (MisoString, fromMisoString)
import Page.EditValue qualified as EditValue
import Page.ListCollection qualified as ListCollection
import Page.NewCollection qualified as NewCollection
@@ -23,8 +24,8 @@ import Route qualified as Route
data Page
= Home
- | ListCollection ListCollection.Model
- | EditValue EditValue.Model
+ | ListCollection MisoString ListCollection.Model
+ | EditValue MisoString MisoString EditValue.Model
| NewCollection NewCollection.Model
deriving (Show, Eq)
@@ -36,24 +37,30 @@ instance Default Page where
initialPage :: Route -> JSM (Either SomeException Page)
initialPage Route.Home = pure (Right Home)
initialPage (Route.ListCollection c) =
- fmap ListCollection <$> ListCollection.initialModel (Collection (fromMisoString c))
+ fmap (ListCollection c) <$> ListCollection.initialModel (Collection (fromMisoString c))
initialPage (Route.EditValue c f) =
- fmap EditValue <$> EditValue.initialModel (CollectionItem (Collection (fromMisoString c)) (fromMisoString f))
+ fmap (EditValue c f) <$> EditValue.initialModel (CollectionItem (Collection (fromMisoString c)) (fromMisoString f))
initialPage Route.NewCollection =
fmap NewCollection <$> NewCollection.initialModel
+route :: Page -> Route
+route Home = Route.Home
+route (ListCollection c _) = Route.ListCollection c
+route (EditValue c f _) = Route.EditValue c f
+route (NewCollection _) = Route.NewCollection
+
update__handleListCollection :: ListCollection.Action -> Action
update__handleListCollection action = Action $ \case
- ListCollection m ->
+ ListCollection c m ->
ListCollection.updateModel action m
- & first (bimap update__handleListCollection ListCollection)
+ & first (bimap update__handleListCollection (ListCollection c))
p -> (noEff p, [])
update__handleEditValue :: EditValue.Action -> Action
update__handleEditValue action = Action $ \case
- EditValue m ->
+ EditValue c f m ->
EditValue.updateModel action m
- & first (bimap update__handleEditValue EditValue)
+ & first (bimap update__handleEditValue (EditValue c f))
p -> (noEff p, [])
update__handleNewCollection :: NewCollection.Action -> Action
@@ -68,6 +75,6 @@ updatePage (Action f) m = f m
viewPage :: Page -> View Action
viewPage Home = text "home"
-viewPage (ListCollection m) = update__handleListCollection <$> ListCollection.viewModel m
-viewPage (EditValue m) = update__handleEditValue <$> EditValue.viewModel m
+viewPage (ListCollection _ m) = update__handleListCollection <$> ListCollection.viewModel m
+viewPage (EditValue _ _ m) = update__handleEditValue <$> EditValue.viewModel m
viewPage (NewCollection m) = update__handleNewCollection <$> NewCollection.viewModel m
diff --git a/frontend/app/Page/ListCollection.hs b/frontend/app/Page/ListCollection.hs
index 6b999f0..ff659af 100644
--- a/frontend/app/Page/ListCollection.hs
+++ b/frontend/app/Page/ListCollection.hs
@@ -41,7 +41,7 @@ updateModel (Action f) m = f m
viewModel :: Model -> View Action
viewModel m =
div_ [] $
- [ h3_ [] [text "entities"],
+ [ h3_ [] [text m.collection.name],
schemaTable m.collection.name m.schema m.posts,
h3_ [] [text "schema"],
viewSchema m.schema
--
cgit v1.2.3