aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/App.hs
blob: 3292336715e60e2ca399792e6fcf302fffd69516 (plain)
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
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         (Init, InitResult (..))
import qualified Common.Msg           as Msg

import           Model.Route          (Route (..))
import qualified Util.Router          as Router
import           View.Header          (HeaderIn (..))
import qualified View.Header          as Header
import           View.Income.Income   (IncomeIn (..))
import qualified View.Income.Income   as Income
import qualified View.NotFound        as NotFound
import           View.Payment.Payment (PaymentIn (..))
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

    headerOut <- Header.view $ HeaderIn
      { _headerIn_initResult = initResult
      , _headerIn_isInitSuccess =
        case initResult of
          InitSuccess _ -> True
          _             -> False
      , _headerIn_route = route
      }

    let signOut =
          Header._headerOut_signOut headerOut

        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 $ PaymentIn
        { _paymentIn_init = init
        }

    IncomeRoute ->
      Income.view $ IncomeIn
        { _incomeIn_init = 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

    _ ->
      NotFoundRoute