From 2e67bf911533a66b5a5b7b50481b426adff8c7db Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Fri, 7 Jun 2024 17:08:01 +0200 Subject: reload collections when creating --- frontend/app/Effect.hs | 5 +++++ frontend/app/Main.hs | 23 +++++++++++++++++++++-- frontend/app/Page.hs | 15 ++++++++------- frontend/app/Page/EditValue.hs | 11 ++++++----- frontend/app/Page/ListCollection.hs | 5 +++-- frontend/app/Page/NewCollection.hs | 23 ++++++++++++++--------- frontend/frontend.cabal | 2 ++ 7 files changed, 59 insertions(+), 25 deletions(-) create mode 100644 frontend/app/Effect.hs (limited to 'frontend') diff --git a/frontend/app/Effect.hs b/frontend/app/Effect.hs new file mode 100644 index 0000000..ad87d72 --- /dev/null +++ b/frontend/app/Effect.hs @@ -0,0 +1,5 @@ +module Effect (Eff (..)) where + +data Eff + = ReloadCollections + deriving (Show, Eq) 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 ".." diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs index 16191dd..7c200c8 100644 --- a/frontend/app/Page.hs +++ b/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 -updatePage (HandleListCollection _) p = noEff p + & first (bimap HandleListCollection ListCollection) +updatePage (HandleListCollection _) p = (noEff p, []) updatePage (HandleEditValue action) (EditValue m) = EditValue.updateModel action m - & bimap HandleEditValue EditValue -updatePage (HandleEditValue _) p = noEff p + & first (bimap HandleEditValue EditValue) +updatePage (HandleEditValue _) p = (noEff p, []) updatePage (HandleNewCollection action) (NewCollection m) = NewCollection.updateModel action m - & bimap HandleNewCollection NewCollection -updatePage (HandleNewCollection _) p = noEff p + & first (bimap HandleNewCollection NewCollection) +updatePage (HandleNewCollection _) p = (noEff p, []) viewPage :: Page -> View Action viewPage Home = text "home" diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs index d5a87e7..43c6f17 100644 --- a/frontend/app/Page/EditValue.hs +++ b/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 NoOp m = noEff m -updateModel (FormChanged (Just -> input)) m = noEff m {input} +updateModel :: Action -> Model -> (Effect Action Model, [Eff]) +updateModel NoOp m = (noEff m, []) +updateModel (FormChanged (Just -> input)) m = (noEff m {input}, []) updateModel (FormSubmitted output) m = - m <# do EntityWritten <$> updatePost m.fileName output -updateModel (EntityWritten _) m = noEff m + (m <# do EntityWritten <$> updatePost m.fileName output, []) +updateModel (EntityWritten _) m = (noEff m, []) viewModel :: Model -> View Action viewModel m = do diff --git a/frontend/app/Page/ListCollection.hs b/frontend/app/Page/ListCollection.hs index d08e414..93ea389 100644 --- a/frontend/app/Page/ListCollection.hs +++ b/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 NoOp m = noEff m +updateModel :: Action -> Model -> (Effect Action Model, [Eff]) +updateModel NoOp m = (noEff m, []) viewModel :: Model -> View Action viewModel m = diff --git a/frontend/app/Page/NewCollection.hs b/frontend/app/Page/NewCollection.hs index 282d36e..dbc448b 100644 --- a/frontend/app/Page/NewCollection.hs +++ b/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 NoOp m = noEff m -updateModel (FormChanged input) m = noEff m {input} +updateModel :: Action -> Model -> (Effect Action Model, [Eff]) +updateModel NoOp m = (noEff m, []) +updateModel (FormChanged input) m = (noEff m {input}, []) updateModel (FormSubmitted collection) m = - m <# do - CollectionCreated <$> createCollection (T.unpack collection) + ( m <# do + CollectionCreated <$> createCollection (T.unpack collection), + [] + ) updateModel (CollectionCreated (Left err)) m = - m <# do - pure NoOp <* consoleLog (toMisoString err) --- TODO reload collections in main app -updateModel (CollectionCreated (Right _)) m = noEff m + ( m <# do + pure NoOp <* consoleLog (toMisoString err), + [] + ) +updateModel (CollectionCreated (Right _)) m = (noEff m, [E.ReloadCollections]) viewModel :: Model -> View Action viewModel m = do diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal index e4842a4..368049b 100644 --- a/frontend/frontend.cabal +++ b/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, -- cgit v1.2.3