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

module View.SignIn
  ( view
  ) where

import qualified Data.Either        as Either
import           Data.Monoid        ((<>))
import           Data.Text          (Text)
import           Data.Time          (NominalDiffTime)
import           Prelude            hiding (error)
import           Reflex.Dom         (Event, MonadWidget)
import qualified Reflex.Dom         as R

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

import           Component          (ButtonIn (..), ButtonOut (..),
                                     InputIn (..), InputOut (..))
import qualified Component          as Component

view :: forall t m. MonadWidget t m => Either Text (Maybe Text) -> m ()
view result =
  R.divClass "signIn" $ do
    rec
      input <- Component.input $ InputIn
        { _inputIn_reset = R.ffilter Either.isRight signInResult
        , _inputIn_placeHolder = Message.get Key.SignIn_EmailPlaceholder
        }

      let userWantsEmailValidation = _inputOut_enter input <> _buttonOut_clic button

      dynValidatedEmail <- R.holdDyn False . R.mergeWith (\_ _ -> False) $
        [ fmap (const True) userWantsEmailValidation
        , fmap (const False) signInResult
        ]

      uniqDynValidatedEmail <- R.holdUniqDyn dynValidatedEmail

      let validatedEmail = R.tagPromptlyDyn
            (_inputOut_value input)
            (R.ffilter (== True) . R.updated $ uniqDynValidatedEmail)

      let waiting = R.leftmost
            [ fmap (const True) validatedEmail
            , fmap (const False) signInResult
            ]

      button <- Component.button $ ButtonIn
        { _buttonIn_class = R.constDyn ""
        , _buttonIn_content = R.text (Message.get Key.SignIn_Button)
        , _buttonIn_waiting = waiting
        }

      signInResult <- askSignIn validatedEmail >>= R.debounce (0.5 :: NominalDiffTime)

    showSignInResult result signInResult

askSignIn :: forall t m. MonadWidget t m => Event t Text -> m (Event t (Either Text Text))
askSignIn email =
  fmap getResult <$> R.performRequestAsync xhrRequest
  where xhrRequest = fmap (R.postJson "/signIn" . SignIn) email
        getResult response =
          case R._xhrResponse_responseText response of
            Just key ->
              if R._xhrResponse_status response == 200 then Right key else Left key
            _ -> Left "NoKey"

showSignInResult :: forall t m. MonadWidget t m => Either Text (Maybe Text) -> Event t (Either Text Text) -> m ()
showSignInResult result signInResult = do
  _ <- R.widgetHold (showInitResult result) $ R.ffor signInResult showResult
  R.blank

  where showInitResult (Left error)           = showError error
        showInitResult (Right (Just success)) = showSuccess success
        showInitResult (Right Nothing)        = R.blank

        showResult (Left error)    = showError error
        showResult (Right success) = showSuccess success

        showError = R.divClass "error" . R.text
        showSuccess = R.divClass "success" . R.text