Forms.hs

{-# 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,
    requiredTextInput',
    optionalTextInput',
    requiredTextArea',
    optionalTextArea',
  )
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 action' fieldName = section
  $ H.form
  ! action (fromString . T.unpack $ action')
  ! method "POST"
  ! enctype "multipart/form-data"
  $ do
    select ! onchange "this.form.submit()" ! name (fromString . T.unpack $ fieldName) $ mapM_ mkOption entries
    noscript $ button ! type_ "submit" $ "submit"
  where
    mkOption :: (Text, Text) -> Html
    mkOption o =
      option
        !? (fst o == sortOrder ^. #value, selected "true")
        ! value (fromString . T.unpack $ fst o)
        $ text ("↕  " <> snd o)
    entries =
      [ ("display-name-asc", (^. #sortings % #alphabeticalAsc) |##| language),
        ("display-name-desc", (^. #sortings % #alphabeticalDesc) |##| language),
        ("created-at-asc", (^. #sortings % #createdAtAsc) |##| language),
        ("created-at-desc", (^. #sortings % #createdAtDesc) |##| language)
      ]

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

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

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

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

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

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

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

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

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

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

formInput :: Text -> Text -> Bool -> AttributeValue -> Maybe Text -> Html
formInput name' displayLabel isRequired type' content' = do
  H.div ! class_ "flex direction-column gap-medium margin-top-small" $ do
    H.div $ do
      H.label ! A.for name'' $ fromString . T.unpack $ displayLabel
      mapM_ (H.span ! class_ "color-error") (if isRequired then Just "*" else Nothing)
    H.input ! class_ "" !? (isRequired, required "") ! A.name name'' ! A.id name'' ! type_ type' ! A.value (fromString . T.unpack $ fromMaybe "" content')
  where
    name'' = fromString . T.unpack $ name'

formArea :: Text -> Text -> Bool -> AttributeValue -> Maybe Text -> Html
formArea name' displayLabel isRequired type' content' = do
  H.div ! class_ "flex direction-column gap-medium margin-top-small" $ do
    H.div $ do
      H.label ! A.for name'' $ fromString . T.unpack $ displayLabel
      mapM_ (H.span ! class_ "color-error") (if isRequired then Just "*" else Nothing)
    H.textarea ! class_ "" !? (isRequired, required "") ! A.name name'' ! A.id name'' ! type_ type' $ (fromString . T.unpack $ fromMaybe "" content')
  where
    name'' = fromString . T.unpack $ name'

submitButton :: Language -> Html
submitButton language =
  button ! A.class_ "background-success border-success align-self-flex-end" ! type_ "submit" $ do
    H.span "✓"
    text $ (^. #forms % #submit) |##| language

postForm :: Text -> Html -> Html
postForm action' =
  H.form
    ! class_ "margin-top-large flex direction-column align-items-flex-start"
    ! method "POST"
    ! action (fromString . T.unpack $ action')
    ! enctype "multipart/form-data"

postForm' :: Text -> Text -> Html -> Html
postForm' action' class' =
  H.form
    ! class_ (fromString . T.unpack $ class')
    ! method "POST"
    ! action (fromString . T.unpack $ action')
    ! enctype "multipart/form-data"