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
44

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

module View.App
  ( widget
  ) where

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

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

import View.Header (HeaderIn(..))
import View.Payment (PaymentIn(..))
import qualified View.Header as Header
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