{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-do-bind -Wno-redundant-constraints #-}

module Sis.Page.Signup (page) where
import Effectful
import Data.Text (Text)
import Data.Text qualified as T
import Sis.Database
import Sis.Auth (hashPassword, verifyPassword, generateToken)
import Sis.Route
import Sis.Style
import Sis.Types
import Sis.View.Layout
import Web.Hyperbole
import Web.Hyperbole.Effect.Session
import Web.Hyperbole.HyperView.Forms
import Web.Hyperbole.Page
data SignupPage = SignupPage
    deriving stock (Generic)
    deriving anyclass (ViewId)
instance (DB :> es, IOE :> es) => HyperView SignupPage es where
    data Action SignupPage
        = SubmitSignup
        deriving stock (Generic)
        deriving anyclass (ViewAction)
    update SubmitSignup = do
        form <- formData @SignupForm
        if T.length (sfPassword form) < 8
            then pure (signupView (Just "Password must be at least 8 characters"))
            else
                if sfPassword form /= sfConfirm form
                    then pure (signupView (Just "Passwords do not match"))
                    else do
                        mExisting <- findUserByEmail (sfEmail form)
                        case mExisting of
                            Just _ -> pure (signupView (Just "Email already registered"))
                            Nothing -> do
                                pwHash <- liftIO (hashPassword (sfPassword form))
                                uid <- createUser (sfDisplayName form) (sfEmail form) pwHash
                                saveSession (UserSession (unUserId uid))
                                redirect (routeUri RouteDashboard)
                                pure (el "Redirecting...")
signupView :: Maybe Text -> View SignupPage ()
signupView mError = do
    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto" $ do
        el @ att "class" nbBoxClass @ att "style" "padding:2rem" $ do
            el @ att "class" nbFontHeading1Class $ text "Create Account"
            el @ att "style" "opacity:0.7;margin-bottom:1.5rem" $ text "Join your household chore tracker."
            case mError of
                Just err ->
                    el @ att "class" nbBoxClass @ att "style" ("border-color:" <> colorRed <> ";color:" <> colorRed <> ";padding:0.5rem;margin-bottom:1rem") $ text err
                Nothing -> none
            form SubmitSignup $ do
                el @ att "class" nbLabelClass $ text "Display Name"
                tag "input" @ att "type" "text" . att "name" "sfDisplayName" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "class" nbLabelClass $ text "Email"
                tag "input" @ att "type" "email" . att "name" "sfEmail" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "class" nbLabelClass $ text "Password (min 8 characters)"
                tag "input" @ att "type" "password" . att "name" "sfPassword" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "class" nbLabelClass $ text "Confirm Password"
                tag "input" @ att "type" "password" . att "name" "sfConfirm" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do
                    tag "input" @ att "type" "checkbox" . att "name" "sfAgree" $ none
                    text "I agree to the terms of service"
                submit (text "Sign Up") @ att "class" nbButtonClass @ att "style" "width:100%"
            route RouteLogin $ text "Already have an account? Log In"
page :: (Hyperbole :> es, DB :> es) => Eff es (View SignupPage ())
page = do
    mSession <- lookupSession @UserSession
    case mSession of
        Just _ -> do
            redirect (routeUri RouteDashboard)
            pure (el "Redirecting...")
        Nothing -> pure (signupView Nothing)