diff options
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 |