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
100
101
102
|
module View.App
( widget
) where
import qualified Data.Text as T
import Prelude hiding (error, init)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, Init (..), InitResult (..),
UserId)
import qualified Common.Msg as Msg
import Model.Route (Route (..))
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 :: InitResult -> IO ()
widget initResult =
R.mainWidget $ R.divClass "app" $ do
route <- getRoute
header <- Header.view $ Header.In
{ Header._in_initResult = initResult
, Header._in_isInitSuccess =
case initResult of
InitSuccess _ -> True
_ -> False
, Header._in_route = route
}
let signOut =
Header._out_signOut header
mainContent =
case initResult of
InitSuccess init ->
signedWidget init route
InitEmpty ->
SignIn.view SignIn.EmptyMessage
InitError error ->
SignIn.view (SignIn.ErrorMessage error)
signOutContent =
SignIn.view (SignIn.SuccessMessage $ Msg.get Msg.SignIn_DisconnectSuccess)
_ <- R.widgetHold (mainContent) (signOutContent <$ signOut)
R.blank
signedWidget :: 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 :: 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
|
