client/src/View/App.hs


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

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo       #-}

module View.App
  ( widget
  ) where

import           Prelude            hiding (error, init)
import qualified Reflex.Dom         as R

import qualified Common.Message     as Message
import qualified Common.Message.Key as Key
import           Common.Model       (InitResult (..))

import           View.Header        (HeaderIn (..))
import qualified View.Header        as Header
import           View.Payment       (PaymentIn (..))
import qualified View.Payment       as Payment
import qualified View.SignIn        as SignIn

widget :: InitResult -> IO ()
widget initResult =
  R.mainWidget $ do
    headerOut <- Header.view $ HeaderIn
      { _headerIn_initResult = initResult
      }

    let signOut = Header._headerOut_signOut headerOut

        initialContent = case initResult of
          InitSuccess initSuccess -> do
            _ <- Payment.widget $ PaymentIn
              { _paymentIn_init = initSuccess
              }
            return ()
          InitEmpty result ->
            SignIn.view result

        signOutContent = SignIn.view (Right . Just $ Message.get Key.SignIn_DisconnectSuccess)

    _ <- R.widgetHold initialContent (fmap (const signOutContent) signOut)

    R.blank