diff options
Diffstat (limited to 'frontend/app/Main.hs')
| -rw-r--r-- | frontend/app/Main.hs | 49 |
1 files changed, 25 insertions, 24 deletions
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs index f3d40c8..9f30708 100644 --- a/frontend/app/Main.hs +++ b/frontend/app/Main.hs @@ -1,10 +1,13 @@ +{-# LANGUAGE ViewPatterns #-} + module Main where #ifndef ghcjs_HOST_OS import Language.Javascript.JSaddle.Warp as JSaddle #endif -import Api +import ACMS.API.REST as API.REST +import Control.Monad.Catch import Control.Monad.Trans import Data.Bifunctor import Data.Default @@ -12,7 +15,7 @@ import Data.Function import Effect (Eff) import Effect qualified as E import Miso -import Miso.String (toMisoString) +import Miso.String (MisoString, toMisoString) import NeatInterpolation qualified as Q import Page (Page, initialPage, updatePage, viewPage) import Page qualified as Page @@ -21,14 +24,14 @@ import Version data Model = Loading - | Failed String + | Failed MisoString | Loaded LoadedState deriving (Show, Eq) data LoadedState = LoadedState - { collections :: [String], + { collections :: [MisoString], schemaVersion :: Version, - page :: Maybe (Either String Page) + page :: Maybe (Either MisoString Page) } deriving (Show, Eq) @@ -37,11 +40,6 @@ instance Default Model where newtype Action = Action (Model -> Effect Action Model) --- TODO -instance Show Action - -instance Eq Action - #ifndef ghcjs_HOST_OS runApp :: JSM () -> IO () runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp @@ -67,18 +65,20 @@ update__init :: URI -> Action update__init uri = Action $ \case Loading -> Loading <# do - page <- Just <$> initialPage (parseURI uri) - schemaVersion' <- fetchSchemaVersion - collections' <- fetchCollections + page <- + Just . first (toMisoString . displayException) + <$> initialPage (parseURI uri) + schemaVersion' <- try API.REST.schemaVersion + collections' <- try API.REST.listCollections pure $ update__setLoaded do schemaVersion <- schemaVersion' collections <- collections' pure LoadedState {..} m -> noEff m -update__setLoaded :: Either String LoadedState -> Action +update__setLoaded :: Either SomeException LoadedState -> Action update__setLoaded (Left e) = Action $ \case - Loading -> noEff (Failed e) + Loading -> noEff (Failed (toMisoString (displayException e))) m -> noEff m update__setLoaded (Right s) = Action $ \case Loading -> noEff (Loaded s) @@ -95,10 +95,11 @@ update__handleURI uri = Action $ \case update__setPage <$> initialPage route m -> noEff m -update__setPage :: Either String Page -> Action -update__setPage (Just -> page) = Action $ \case - Loaded s -> noEff (Loaded s {page}) - m -> noEff m +update__setPage :: Either SomeException Page -> Action +update__setPage + ((Just . first (toMisoString . displayException)) -> page) = Action $ \case + Loaded s -> noEff (Loaded s {page = page}) + m -> noEff m update__handlePage :: Page.Action -> Action update__handlePage action = Action $ \case @@ -121,18 +122,18 @@ update__handleEff eff = Action $ \case Loaded s -> Loaded s <# handleEff eff m -> noEff m -update__setCollections :: Either String [String] -> Action +update__setCollections :: Either SomeException [MisoString] -> Action update__setCollections (Left err) = Action $ \case Loaded s -> Loaded s <# do - pure update__noOp <* consoleLog (toMisoString err) + pure update__noOp <* consoleLog (toMisoString (displayException err)) m -> noEff m update__setCollections (Right collections) = Action $ \case Loaded s -> noEff (Loaded s {collections}) m -> noEff m handleEff :: Eff -> JSM Action -handleEff E.ReloadCollections = update__setCollections <$> fetchCollections +handleEff E.ReloadCollections = update__setCollections <$> try API.REST.listCollections viewModel :: Model -> View Action viewModel Loading = text ".." @@ -234,8 +235,8 @@ th, td { ) ] -err :: String -> View action -err = text . toMisoString . ("err! " <>) +err :: MisoString -> View action +err = text . ("err! " <>) viewHeader :: LoadedState -> View Action viewHeader s = |