1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
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
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
}
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
_ ->
NotFoundRoute
|
