aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--frontend/app/Effect.hs5
-rw-r--r--frontend/app/Main.hs23
-rw-r--r--frontend/app/Page.hs15
-rw-r--r--frontend/app/Page/EditValue.hs11
-rw-r--r--frontend/app/Page/ListCollection.hs5
-rw-r--r--frontend/app/Page/NewCollection.hs23
-rw-r--r--frontend/frontend.cabal2
-rw-r--r--nix/sources.json2
8 files changed, 60 insertions, 26 deletions
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,
diff --git a/nix/sources.json b/nix/sources.json
index fca5e04..7ab4228 100644
--- a/nix/sources.json
+++ b/nix/sources.json
@@ -2,7 +2,7 @@
"json2sql": {
"branch": "main",
"repo": "git@code.nomath.org:~/json2sql",
- "rev": "906d9ebba1ae08ea73acb55b536ff2f49e1b55c0",
+ "rev": "58b2ef265847d005300df4b6e908734bae1a7cb4",
"type": "git"
},
"nixpkgs": {
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 09:28:04 +0000