Sign in with email and password

1 files changed, 29 insertions, 32 deletions

diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 460d499..b0b89fb 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -4,14 +4,14 @@ module View.App
 
 import qualified Data.Text              as T
 import           Prelude                hiding (error, init)
-import           Reflex.Dom             (Dynamic, MonadWidget)
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Currency, Init (..), InitResult (..),
-                                         UserId)
+import           Common.Model           (Currency, Init (..), UserId)
 import qualified Common.Msg             as Msg
 
 import           Model.Route            (Route (..))
+import qualified Util.Reflex            as ReflexUtil
 import qualified Util.Router            as Router
 import qualified View.Category.Category as Category
 import qualified View.Header            as Header
@@ -20,43 +20,40 @@ import qualified View.NotFound          as NotFound
 import qualified View.Payment.Payment   as Payment
 import qualified View.SignIn            as SignIn
 
-widget :: InitResult -> IO ()
-widget initResult =
+widget :: Maybe Init -> IO ()
+widget init =
   R.mainWidget $ R.divClass "app" $ do
 
     route <- getRoute
 
-    header <- Header.view $ Header.In
-      { Header._in_initResult = initResult
-      , Header._in_isInitSuccess =
-        case initResult of
-          InitSuccess _ -> True
-          _             -> False
-      , Header._in_route = route
-      }
-
-    let signOut =
-          Header._out_signOut header
-
-        mainContent =
-          case initResult of
-            InitSuccess init ->
-              signedWidget init route
-
-            InitEmpty ->
-              SignIn.view SignIn.EmptyMessage
+    rec
+      header <- Header.view $ Header.In
+        { Header._in_init = initState
+        , Header._in_route = route
+        }
 
-            InitError error ->
-              SignIn.view (SignIn.ErrorMessage error)
+      initState <-
+        R.foldDyn
+          const
+          init
+          (R.leftmost $
+            [ initEvent
+            , Nothing <$ (Header._out_signOut header)
+            ])
 
-        signOutContent =
-          SignIn.view (SignIn.SuccessMessage $ Msg.get Msg.SignIn_DisconnectSuccess)
+      initEvent <-
+        (R.dyn . R.ffor initState $ \case
+          Nothing -> do
+            signIn <- SignIn.view
+            return (Just <$> SignIn._out_success signIn)
 
-    _ <- R.widgetHold (mainContent) (signOutContent <$ signOut)
+          Just i -> do
+            signedWidget i route
+            return R.never) >>= ReflexUtil.flatten
 
-    R.blank
+    return ()
 
-signedWidget :: MonadWidget t m => Init -> Dynamic t Route -> m ()
+signedWidget :: forall t m. MonadWidget t m => Init -> Dynamic t Route -> m ()
 signedWidget init route = do
   R.dyn . R.ffor route $ \case
     RootRoute ->
@@ -85,7 +82,7 @@ signedWidget init route = do
 
   return ()
 
-getRoute :: MonadWidget t m => m (Dynamic t Route)
+getRoute :: forall t m. 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