diff options
Diffstat (limited to 'frontend/app/Main.hs')
| -rw-r--r-- | frontend/app/Main.hs | 23 |
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 ".." |