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

module View.App
  ( widget
  ) where

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

import           Common.Model (InitResult (..))
import qualified Common.Msg   as Msg

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 ->
            SignIn.view SignIn.EmptyMessage
          InitError error ->
            SignIn.view (SignIn.ErrorMessage error)

        signOutContent = SignIn.view (SignIn.SuccessMessage $ Msg.get Msg.SignIn_DisconnectSuccess)

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

    R.blank