reload collections when creating
This commit is contained in:
@@ -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 ".."
|
||||
|
||||
Reference in New Issue
Block a user