add schema version

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

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 =

frontend/frontend.cabal

@@ -37,11 +37,13 @@ executable frontend
         attoparsec,
         base,
         bytestring,
+        common,
         containers,
         data-default,
         miso,
         neat-interpolation,
         safe,
+        split,
         text,
         utf8-string