reload collections when creating

1 files changed, 21 insertions, 2 deletions

diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index 3a2c5a6..67f1938 100644
--- a/frontend/app/Main.hs
+++ b/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
-          & bimap HandlePage (\page -> s {page = Just (Right page)})
+        ( case updatePage action 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 ".."