{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.SSR.View.OtherHtml where

import Data.Text qualified as T
import Principium
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.View.Components.Forms
import WikiMusic.SSR.View.HtmlUtil

errorPage' :: (MonadIO m) => Env -> ViewVars -> Maybe Int -> Maybe Text -> m Html
errorPage' :: forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> Maybe Int -> Maybe Text -> m Html
errorPage' Env
env ViewVars
vv Maybe Int
_ Maybe Text
maybeMessage = do
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle (Text -> SimplePageTitle) -> Text -> SimplePageTitle
forall a b. (a -> b) -> a -> b
$ (ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Titles
  Titles
#titles Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Titles
  Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Titles Titles DictTerm DictTerm
#songsPage) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
h3 (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
messageCauses
    let maybeDecoded :: Maybe (Either String ByteString)
maybeDecoded = (Text -> Either String ByteString)
-> Maybe Text -> Maybe (Either String ByteString)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either String ByteString
maybeDecodeBase16 Maybe Text
maybeMessage
    Html -> Html
H.pre
      (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        case Maybe (Either String ByteString)
maybeDecoded of
          Maybe (Either String ByteString)
Nothing -> Text -> Html
text Text
"Unexpected Error!"
          Just Either String ByteString
maybeDecodedError -> (String -> Html)
-> (ByteString -> Html) -> Either String ByteString -> Html
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Html -> String -> Html
forall a. a -> String -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> String -> Html) -> Html -> String -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text Text
"Unexpected Error!") (Text -> Html
text (Text -> Html) -> (ByteString -> Text) -> ByteString -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8) Either String ByteString
maybeDecodedError
  where
    messageCauses :: Text
messageCauses = Text -> [Text] -> Text
T.intercalate Text
" - " [Text]
causeStrings
    causeStrings :: [Text]
causeStrings = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Error", if Text -> Text -> Bool
T.isInfixOf Text
"504" (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Error ocurred!" Maybe Text
maybeMessage) then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Gateway Timeout" else Maybe Text
forall a. Maybe a
Nothing]

loginPage' :: (MonadIO m) => Env -> ViewVars -> m Html
loginPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html
loginPage' Env
env ViewVars
vv = do
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle (Text -> SimplePageTitle) -> Text -> SimplePageTitle
forall a b. (a -> b) -> a -> b
$ (ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#loginNav) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
section (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"justify-center"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Html -> Html
postForm' Text
"/login" [Text
"flex", Text
"flex-col", Text
"gap-4"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"gap-8"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html
requiredEmailInput Text
"email" ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms
#forms Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms
-> Optic A_Lens NoIx Forms Forms DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Forms Forms DictTerm DictTerm
#email) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
        Text -> Text -> Html
requiredPasswordInput Text
"password" ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms
#forms Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms
-> Optic A_Lens NoIx Forms Forms DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Forms Forms DictTerm DictTerm
#password) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
      ViewVars -> Html
submitButton ViewVars
vv
    Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssLink ViewVars
vv) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/passwords/request-reset" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"forgot password ?"

doPasswordResetPage' :: (MonadIO m) => Env -> ViewVars -> Maybe Text -> m Html
doPasswordResetPage' :: forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> Maybe Text -> m Html
doPasswordResetPage' Env
env ViewVars
vv Maybe Text
t = do
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle Text
"Reset password") (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
postForm Text
"/passwords/do-reset" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Html
requiredEmailInput Text
"email" Text
"email"
      Text -> Text -> Html
requiredPasswordInput Text
"password" Text
"password"
      Text -> Text -> Html
requiredPasswordInput Text
"passwordConfirm" Text
"password again"
      Text -> Text -> Maybe Text -> Html
requiredTextInput' Text
"token" Text
"token" Maybe Text
t
      ViewVars -> Html
submitButton ViewVars
vv

requestPasswordResetPage' :: (MonadIO m) => Env -> ViewVars -> m Html
requestPasswordResetPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html
requestPasswordResetPage' Env
env ViewVars
vv = do
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle Text
"Request password reset ?") (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
postForm Text
"/passwords/request-reset" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Html
requiredEmailInput Text
"email" Text
"email"
      ViewVars -> Html
submitButton ViewVars
vv

inviteUserPage' :: (MonadIO m) => Env -> ViewVars -> m Html
inviteUserPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html
inviteUserPage' Env
env ViewVars
vv = do
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle Text
"Invite user") (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
postForm Text
"/users/invite" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Html
requiredEmailInput Text
"email" Text
"email"
      Text -> Text -> Html
requiredTextInput Text
"displayName" Text
"name"
      Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
for AttributeValue
"role" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"role"
      Html -> Html
select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssSelect ViewVars
vv) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
required AttributeValue
"" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"role" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"role" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"wm::demo" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"demo user"
        Html -> Html
option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"wm::lowrank" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"average user"
        Html -> Html
option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"wm::maintainer" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"wiki maintainer"
        Html -> Html
option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"wm::superuser" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"super user"
      Text -> Text -> Html
optionalTextArea Text
"description" Text
"description"
      ViewVars -> Html
submitButton ViewVars
vv