reload collections when creating

frontend/app/Effect.hs

@@ -0,0 +1,5 @@
+module Effect (Eff (..)) where
+
+data Eff
+  = ReloadCollections
+  deriving (Show, Eq)

frontend/app/Main.hs

@@ -5,9 +5,12 @@ import Language.Javascript.JSaddle.Warp as JSaddle
 #endif
 
 import Api
+import Control.Monad.Trans
 import Data.Bifunctor
 import Data.Default
 import Data.Function
+import Effect (Eff)
+import Effect qualified as E
 import Miso
 import Miso.String (toMisoString)
 import NeatInterpolation qualified as Q
@@ -41,6 +44,8 @@ data Action
   | HandleURI URI
   | HandlePage Page.Action
   | SetPage (Either String Page)
+  | HandleEff Eff
+  | SetCollections (Either String [String])
   deriving (Show, Eq)
 
 #ifndef ghcjs_HOST_OS
@@ -90,9 +95,23 @@ updateModel (HandlePage action) (Loaded s) =
   case s.page of
     Just (Right page) ->
       fmap Loaded $
-        updatePage action page
+        ( case updatePage action page
-          & bimap HandlePage (\page -> s {page = Just (Right page)})
+            & first (bimap HandlePage (\page -> s {page = Just (Right page)}))
+            & second (map HandleEff)
+            & second (map (\eff -> (\sink -> liftIO (sink eff)))) of
+            (Effect s' ss, ss') ->
+              Effect s' (ss ++ ss')
+        )
     _ -> noEff (Loaded s)
+updateModel (HandleEff eff) (Loaded s) = Loaded s <# handleEff eff
+updateModel (SetCollections (Left err)) (Loaded s) =
+  Loaded s <# do
+    pure NoOp <* consoleLog (toMisoString err)
+updateModel (SetCollections (Right collections)) (Loaded s) =
+  noEff (Loaded s {collections})
+
+handleEff :: Eff -> JSM Action
+handleEff E.ReloadCollections = SetCollections <$> fetchCollections
 
 viewModel :: Model -> View Action
 viewModel Loading = text ".."

frontend/app/Page.hs

@@ -16,6 +16,7 @@ import Page.ListCollection qualified as ListCollection
 import Page.NewCollection qualified as NewCollection
 import Route (Route)
 import Route qualified as Route
+import Effect (Eff)
 
 data Page
   = Home
@@ -42,19 +43,19 @@ initialPage (Route.EditValue c f) =
 initialPage Route.NewCollection =
   fmap NewCollection <$> NewCollection.initialModel
 
-updatePage :: Action -> Page -> Effect Action Page
+updatePage :: Action -> Page -> (Effect Action Page, [Eff])
 updatePage (HandleListCollection action) (ListCollection m) =
   ListCollection.updateModel action m
-    & bimap HandleListCollection ListCollection
+    & first (bimap HandleListCollection ListCollection)
-updatePage (HandleListCollection _) p = noEff p
+updatePage (HandleListCollection _) p = (noEff p, [])
 updatePage (HandleEditValue action) (EditValue m) =
   EditValue.updateModel action m
-    & bimap HandleEditValue EditValue
+    & first (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
+    & first (bimap HandleNewCollection NewCollection)
-updatePage (HandleNewCollection _) p = noEff p
+updatePage (HandleNewCollection _) p = (noEff p, [])
 
 viewPage :: Page -> View Action
 viewPage Home = text "home"

frontend/app/Page/EditValue.hs

@@ -15,6 +15,7 @@ import Data.Maybe
 import Form qualified as F
 import Miso
 import Miso.String (toMisoString)
+import Effect (Eff)
 import Schema
 
 data Model = Model
@@ -41,12 +42,12 @@ data Action
   | EntityWritten (Either String ())
   deriving (Eq, Show)
 
-updateModel :: Action -> Model -> Effect Action Model
+updateModel :: Action -> Model -> (Effect Action Model, [Eff])
-updateModel NoOp m = noEff m
+updateModel NoOp m = (noEff m, [])
-updateModel (FormChanged (Just -> input)) m = noEff m {input}
+updateModel (FormChanged (Just -> input)) m = (noEff m {input}, [])
 updateModel (FormSubmitted output) m =
-  m <# do EntityWritten <$> updatePost m.fileName output
+  (m <# do EntityWritten <$> updatePost m.fileName output, [])
-updateModel (EntityWritten _) m = noEff m
+updateModel (EntityWritten _) m = (noEff m, [])
 
 viewModel :: Model -> View Action
 viewModel m = do

frontend/app/Page/ListCollection.hs

@@ -12,6 +12,7 @@ import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as AM
 import Miso
 import Schema
+import Effect (Eff)
 
 data Model = Model
   { collection :: String,
@@ -34,8 +35,8 @@ data Action
   = NoOp
   deriving (Eq, Show)
 
-updateModel :: Action -> Model -> Effect Action Model
+updateModel :: Action -> Model -> (Effect Action Model, [Eff])
-updateModel NoOp m = noEff m
+updateModel NoOp m = (noEff m, [])
 
 viewModel :: Model -> View Action
 viewModel m =

frontend/app/Page/NewCollection.hs

@@ -10,6 +10,8 @@ where
 import Api
 import Data.Aeson qualified as A
 import Data.Text qualified as T
+import Effect (Eff)
+import Effect qualified as E
 import Form qualified as F
 import Miso
 import Miso.String (toMisoString)
@@ -30,17 +32,20 @@ data Action
   | CollectionCreated (Either String ())
   deriving (Eq, Show)
 
-updateModel :: Action -> Model -> Effect Action Model
+updateModel :: Action -> Model -> (Effect Action Model, [Eff])
-updateModel NoOp m = noEff m
+updateModel NoOp m = (noEff m, [])
-updateModel (FormChanged input) m = noEff m {input}
+updateModel (FormChanged input) m = (noEff m {input}, [])
 updateModel (FormSubmitted collection) m =
-  m <# do
+  ( m <# do
-    CollectionCreated <$> createCollection (T.unpack collection)
+      CollectionCreated <$> createCollection (T.unpack collection),
+    []
+  )
 updateModel (CollectionCreated (Left err)) m =
-  m <# do
+  ( m <# do
-    pure NoOp <* consoleLog (toMisoString err)
+      pure NoOp <* consoleLog (toMisoString err),
--- TODO reload collections in main app
+    []
-updateModel (CollectionCreated (Right _)) m = noEff m
+  )
+updateModel (CollectionCreated (Right _)) m = (noEff m, [E.ReloadCollections])
 
 viewModel :: Model -> View Action
 viewModel m = do

frontend/frontend.cabal

@@ -13,6 +13,7 @@ executable frontend
     hs-source-dirs:     app
     other-modules:
         Api
+        Effect
         Form
         Form.Input
         Form.Internal
@@ -42,6 +43,7 @@ executable frontend
         containers,
         data-default,
         miso,
+        mtl,
         neat-interpolation,
         safe,
         split,

nix/sources.json

@@ -2,7 +2,7 @@
     "json2sql": {
         "branch": "main",
         "repo": "git@code.nomath.org:~/json2sql",
-        "rev": "906d9ebba1ae08ea73acb55b536ff2f49e1b55c0",
+        "rev": "58b2ef265847d005300df4b6e908734bae1a7cb4",
         "type": "git"
     },
     "nixpkgs": {