diff options
author | Alexander Foremny <aforemny@posteo.de> | 2024-06-05 22:47:49 +0200 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2024-06-05 23:36:34 +0200 |
commit | bfb98d7675515394e1b9a0417bfafc83d775611c (patch) | |
tree | dec841dc2ca6b79f8eaa777b90b3b1473f369c9d /frontend | |
parent | 2064b4e7767dca2858d8093597503a594dcd74ef (diff) |
add schema version
Diffstat (limited to 'frontend')
-rw-r--r-- | frontend/app/Api.hs | 6 | ||||
-rw-r--r-- | frontend/app/Main.hs | 86 | ||||
-rw-r--r-- | frontend/frontend.cabal | 2 |
3 files changed, 64 insertions, 30 deletions
diff --git a/frontend/app/Api.hs b/frontend/app/Api.hs index c16e269..f4e4599 100644 --- a/frontend/app/Api.hs +++ b/frontend/app/Api.hs @@ -2,6 +2,7 @@ module Api ( fetchSchema, + fetchSchemaVersion, fetchPosts, fetchPost, updatePost, @@ -25,11 +26,16 @@ import Data.Function import Miso import Safe import Schema +import Version fetchSchema :: JSM (Either String Schema) fetchSchema = A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json") +fetchSchemaVersion :: JSM (Either String Version) +fetchSchemaVersion = + A.eitherDecode <$> fetch (fromString "http://localhost:8081/schemaVersion") + fetchPosts :: JSM (Either String [A.Value]) fetchPosts = A.eitherDecode diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs index 4ef4def..37230ad 100644 --- a/frontend/app/Main.hs +++ b/frontend/app/Main.hs @@ -4,24 +4,38 @@ module Main where import Language.Javascript.JSaddle.Warp as JSaddle #endif +import Api import Data.Bifunctor import Data.Default import Data.Function -import GHC.Generics (Generic) import Miso import Miso.String (toMisoString) import NeatInterpolation qualified as Q import Page (Page, initialPage, updatePage, viewPage) import Page qualified as Page import Route (parseURI) +import Version -data Model = Model - { page :: Maybe (Either String Page) +data Model + = Loading + | Failed String + | Loaded LoadedState + deriving (Show, Eq) + +data LoadedState = LoadedState + { page :: Maybe (Either String Page), + schemaVersion :: Version } - deriving (Show, Eq, Generic, Default) + deriving (Show, Eq) + +instance Default Model where + def = Loading data Action - = NoOp + = -- Loading + SetLoaded (Either String LoadedState) + | -- Loaded + NoOp | Init URI | HandleURI URI | HandlePage Page.Action @@ -50,34 +64,43 @@ main = runApp $ do logLevel = Off updateModel :: Action -> Model -> Effect Action Model -updateModel NoOp m = noEff m -updateModel (Init uri) m = - m <# do - SetPage <$> initialPage (parseURI uri) -updateModel (HandleURI uri) m = - m <# do +updateModel _ (Failed err) = noEff (Failed err) +updateModel (Init uri) Loading = + Loading <# do + page <- Just <$> initialPage (parseURI uri) + schemaVersion' <- fetchSchemaVersion + pure $ SetLoaded do + schemaVersion <- schemaVersion' + pure LoadedState {..} +updateModel (Init _) m = noEff m +updateModel (SetLoaded (Left err)) Loading = noEff (Failed err) +updateModel (SetLoaded (Right state)) Loading = noEff (Loaded state) +updateModel (SetLoaded _) m = noEff m +updateModel _ Loading = noEff Loading +updateModel NoOp (Loaded s) = noEff (Loaded s) +updateModel (HandleURI uri) (Loaded s) = + Loaded s <# do let route = parseURI uri SetPage <$> initialPage route -updateModel (SetPage page) m = noEff m {page = Just page} -updateModel (HandlePage action) m = - case m.page of +updateModel (SetPage page) (Loaded s) = noEff (Loaded s {page = Just page}) +updateModel (HandlePage action) (Loaded s) = + case s.page of Just (Right page) -> - updatePage action page - & bimap HandlePage (\page -> m {page = Just (Right page)}) - _ -> noEff m + fmap Loaded $ + updatePage action page + & bimap HandlePage (\page -> s {page = Just (Right page)}) + _ -> noEff (Loaded s) viewModel :: Model -> View Action -viewModel model = +viewModel Loading = text ".." +viewModel (Failed s) = err s +viewModel (Loaded s) = div_ [] $ [ viewCss, - viewHeader, + viewHeader s, nav_ [] [viewCollections], main_ [] $ - [ HandlePage - <$> maybe - (text "..") - (either err viewPage) - model.page + [ HandlePage <$> maybe (text "..") (either err viewPage) s.page ] ] @@ -171,16 +194,19 @@ th, td { err :: String -> View action err = text . toMisoString . ("err! " <>) -viewHeader :: View Action -viewHeader = +viewHeader :: LoadedState -> View Action +viewHeader s = header_ [] $ [ section_ [] [h1_ [] [a_ [href_ "#"] [text "acms"]]], - section_ [] [viewBranch] + section_ [] (viewBranch s) ] -viewBranch :: View Action -viewBranch = - select_ [] [option_ [] [text "main"]] +viewBranch :: LoadedState -> [View Action] +viewBranch s = + [ text (toMisoString (versionToString s.schemaVersion)), + text " ", + select_ [] [option_ [] [text "main"]] + ] viewCollections :: View Action viewCollections = diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal index 3260c51..71c1afb 100644 --- a/frontend/frontend.cabal +++ b/frontend/frontend.cabal @@ -37,11 +37,13 @@ executable frontend attoparsec, base, bytestring, + common, containers, data-default, miso, neat-interpolation, safe, + split, text, utf8-string |