From 898e7ed11ab0958fcdaf65b99b33f7b04787630a Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 24 Sep 2017 22:14:48 +0200 Subject: Bootstrap with GHCJS and reflex: - setup login and logout, - first draft of payment view. --- src/client/View/App.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 src/client/View/App.hs (limited to 'src/client/View/App.hs') diff --git a/src/client/View/App.hs b/src/client/View/App.hs new file mode 100644 index 0000000..1466811 --- /dev/null +++ b/src/client/View/App.hs @@ -0,0 +1,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 -- cgit v1.2.3