diff options
author | Joris | 2020-01-30 11:35:31 +0000 |
---|---|---|
committer | Joris | 2020-01-30 11:35:31 +0000 |
commit | 960fa7cb7ae4c57d01306f78cd349f3a8337d0ab (patch) | |
tree | 5077cc720525fb025e4dba65a9a8b631862cbcc8 /client/src/View/App.hs | |
parent | 14bdbc8c937f5d0b35c61350dba28cb41c3737cd (diff) | |
parent | 6a04e640955051616c3ad0874605830c448f2d75 (diff) | |
download | budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.gz budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.bz2 budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.zip |
Merge branch 'with-ghcjs' into 'master'
Use Haskell on the frontend
See merge request guyonvarch/shared-cost!2
Diffstat (limited to 'client/src/View/App.hs')
-rw-r--r-- | client/src/View/App.hs | 108 |
1 files changed, 108 insertions, 0 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs new file mode 100644 index 0000000..71f0234 --- /dev/null +++ b/client/src/View/App.hs @@ -0,0 +1,108 @@ +module View.App + ( widget + ) where + +import qualified Data.Text as T +import Prelude hiding (error, init) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (Currency, Init (..), UserId) +import qualified Common.Msg as Msg + +import Model.Route (Route (..)) +import qualified Util.Reflex as ReflexUtil +import qualified Util.Router as Router +import qualified View.Category.Category as Category +import qualified View.Header as Header +import qualified View.Income.Income as Income +import qualified View.NotFound as NotFound +import qualified View.Payment.Payment as Payment +import qualified View.SignIn as SignIn +import qualified View.Statistics.Statistics as Statistics + +widget :: Maybe Init -> IO () +widget init = + R.mainWidget $ R.divClass "app" $ do + + route <- getRoute + + rec + header <- Header.view $ Header.In + { Header._in_init = initState + , Header._in_route = route + } + + initState <- + R.foldDyn + const + init + (R.leftmost $ + [ initEvent + , Nothing <$ (Header._out_signOut header) + ]) + + initEvent <- + (R.dyn . R.ffor initState $ \case + Nothing -> do + signIn <- SignIn.view + return (Just <$> SignIn._out_success signIn) + + Just i -> do + signedWidget i route + return R.never) >>= ReflexUtil.flatten + + return () + +signedWidget :: forall t m. MonadWidget t m => Init -> Dynamic t Route -> m () +signedWidget init route = do + R.dyn . R.ffor route $ \case + RootRoute -> + Payment.view $ Payment.In + { Payment._in_currentUser = _init_currentUser init + , Payment._in_currency = _init_currency init + , Payment._in_users = _init_users init + } + + IncomeRoute -> + Income.view $ Income.In + { Income._in_currentUser = _init_currentUser init + , Income._in_currency = _init_currency init + , Income._in_users = _init_users init + } + + CategoryRoute -> + Category.view $ Category.In + { Category._in_currentUser = _init_currentUser init + , Category._in_currency = _init_currency init + , Category._in_users = _init_users init + } + + StatisticsRoute -> + Statistics.view $ Statistics.In + { Statistics._in_currency = _init_currency init + } + + NotFoundRoute -> + NotFound.view + + return () + +getRoute :: forall t m. MonadWidget t m => m (Dynamic t Route) +getRoute = do + r <- Router.partialPathRoute "" . R.switchPromptlyDyn =<< R.holdDyn R.never R.never + return . R.ffor r $ \case + [""] -> + RootRoute + + ["income"] -> + IncomeRoute + + ["category"] -> + CategoryRoute + + ["statistics"] -> + StatisticsRoute + + _ -> + NotFoundRoute |