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

module WikiMusic.SSR.View.Components.Forms
  ( mkSortingForm,
    requiredTextInput,
    formInput,
    optionalTextInput,
    requiredEmailInput,
    requiredPasswordInput,
    submitButton,
    postForm,
    postForm',
    formArea,
    optionalTextArea,
    requiredTextArea,
  )
where

import Data.Text qualified as T
import Optics
import Relude
import Text.Blaze.Html
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.Language
import WikiMusic.SSR.Model.Api

mkSortingForm :: Language -> SortOrder -> Text -> Text -> Html
mkSortingForm :: Language -> SortOrder -> Text -> Text -> Html
mkSortingForm Language
language SortOrder
sortOrder Text
action' Text
fieldName = Html -> Html
section
  (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.form
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
action')
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST"
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data"
  (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onchange AttributeValue
"this.form.submit()" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
fieldName) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Html) -> [(Text, Text)] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, Text) -> Html
mkOption [(Text, Text)]
entries
    Html -> Html
noscript (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"submit"
  where
    mkOption :: (Text, Text) -> Html
    mkOption :: (Text, Text) -> Html
mkOption (Text, Text)
o =
      Html -> Html
option
        (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
!? ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
o Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== SortOrder
sortOrder SortOrder -> Optic' An_Iso NoIx SortOrder Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SortOrder Text
#value, AttributeValue -> Attribute
selected AttributeValue
"true")
        (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
o)
        (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text (Text
"↕  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
o)
    entries :: [(Text, Text)]
entries =
      [ (Text
"display-name-asc", LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
#sortings Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
-> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict 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 Sortings Sortings DictTerm DictTerm
#alphabeticalAsc DictTerm -> Language -> Text
|##| Language
language),
        (Text
"display-name-desc", LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
#sortings Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
-> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict 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 Sortings Sortings DictTerm DictTerm
#alphabeticalDesc DictTerm -> Language -> Text
|##| Language
language),
        (Text
"created-at-asc", LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
#sortings Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
-> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict 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 Sortings Sortings DictTerm DictTerm
#createdAtAsc DictTerm -> Language -> Text
|##| Language
language),
        (Text
"created-at-desc", LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
#sortings Optic A_Lens NoIx LanguageDict LanguageDict Sortings Sortings
-> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict 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 Sortings Sortings DictTerm DictTerm
#createdAtDesc DictTerm -> Language -> Text
|##| Language
language)
      ]

requiredTextInput :: Text -> Text -> Html
requiredTextInput :: Text -> Text -> Html
requiredTextInput Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formInput Text
name' Text
displayLabel Bool
True AttributeValue
"text"

requiredTextArea :: Text -> Text -> Html
requiredTextArea :: Text -> Text -> Html
requiredTextArea Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formArea Text
name' Text
displayLabel Bool
True AttributeValue
"text"

optionalTextInput :: Text -> Text -> Html
optionalTextInput :: Text -> Text -> Html
optionalTextInput Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formInput Text
name' Text
displayLabel Bool
False AttributeValue
"text"

optionalTextArea :: Text -> Text -> Html
optionalTextArea :: Text -> Text -> Html
optionalTextArea Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formArea Text
name' Text
displayLabel Bool
False AttributeValue
"text"

requiredEmailInput :: Text -> Text -> Html
requiredEmailInput :: Text -> Text -> Html
requiredEmailInput Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formInput Text
name' Text
displayLabel Bool
True AttributeValue
"email"

requiredPasswordInput :: Text -> Text -> Html
requiredPasswordInput :: Text -> Text -> Html
requiredPasswordInput Text
name' Text
displayLabel = Text -> Text -> Bool -> AttributeValue -> Html
formInput Text
name' Text
displayLabel Bool
True AttributeValue
"password"

formInput :: Text -> Text -> Bool -> AttributeValue -> Html
formInput :: Text -> Text -> Bool -> AttributeValue -> Html
formInput Text
name' Text
displayLabel Bool
isRequired AttributeValue
type' = do
  Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"flex direction-column gap-medium margin-top-small" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.for AttributeValue
name'' (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
displayLabel
      (Html -> Html) -> Maybe Html -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"color-error") (if Bool
isRequired then Html -> Maybe Html
forall a. a -> Maybe a
Just Html
"*" else Maybe Html
forall a. Maybe a
Nothing)
    Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"" Html -> (Bool, Attribute) -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
!? (Bool
isRequired, AttributeValue -> Attribute
required AttributeValue
"") Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name AttributeValue
name'' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
name'' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
type'
  where
    name'' :: AttributeValue
name'' = String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
name'

formArea :: Text -> Text -> Bool -> AttributeValue -> Html
formArea :: Text -> Text -> Bool -> AttributeValue -> Html
formArea Text
name' Text
displayLabel Bool
isRequired AttributeValue
type' = do
  Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"flex direction-column gap-medium margin-top-small" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.for AttributeValue
name'' (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
displayLabel
      (Html -> Html) -> Maybe Html -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"color-error") (if Bool
isRequired then Html -> Maybe Html
forall a. a -> Maybe a
Just Html
"*" else Maybe Html
forall a. Maybe a
Nothing)
    Html -> Html
H.textarea (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"" (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
!? (Bool
isRequired, AttributeValue -> Attribute
required AttributeValue
"") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name AttributeValue
name'' (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
name'' (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
type' (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
  where
    name'' :: AttributeValue
name'' = String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
name'

submitButton :: Language -> Html
submitButton :: Language -> Html
submitButton Language
language =
  Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"background-success border-success align-self-flex-end" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.span Html
"✓"
    Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Forms Forms
#forms Optic A_Lens NoIx LanguageDict LanguageDict Forms Forms
-> Optic A_Lens NoIx Forms Forms DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict 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
#submit DictTerm -> Language -> Text
|##| Language
language

postForm :: Text -> Html -> Html
postForm :: Text -> Html -> Html
postForm Text
action' =
  Html -> Html
H.form
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"margin-top-large flex direction-column align-items-flex-start"
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST"
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
action')
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data"

postForm' :: Text -> Text -> Html -> Html
postForm' :: Text -> Text -> Html -> Html
postForm' Text
action' Text
class' =
  Html -> Html
H.form
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
class')
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST"
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
action')
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data"