diff options
| -rw-r--r-- | frontend/app/Main.hs | 63 | ||||
| -rw-r--r-- | frontend/app/Page.hs | 31 | ||||
| -rw-r--r-- | frontend/app/Page/ListCollection.hs | 2 |
3 files changed, 81 insertions, 15 deletions
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 |