{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE InstanceSigs, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, IncoherentInstances  #-}
{-|
Module: IHP.View.Form
Description: 'IHP.View.Form.formFor' and all form controls
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.View.Form where

import IHP.Prelude hiding (div)
import           Data.String.Conversions            (cs)
import           IHP.ValidationSupport
import           IHP.View.ConvertibleStrings ()
import           IHP.ViewErrorMessages
import           IHP.ViewSupport
import           Text.Blaze.Html5                   (a, body, button, code, div, docTypeHtml, footer, form, h1, h2, h3, h4, h5, h6, head, hr, html, iframe, img,
                                                     input, label, li, link, meta, nav, ol, p, pre, script, small, span, table, tbody, td, th, thead, title, tr,
                                                     ul, (!), (!?))
import qualified Text.Blaze.Html5                   as H
import qualified Text.Blaze.Html5                   as Html5
import           Text.Blaze.Html5.Attributes        (autocomplete, autofocus, charset, class_, content, href, httpEquiv, id, lang, method, name,
                                                     onclick, placeholder, rel, src, style, type_, value)
import qualified Text.Blaze.Html5.Attributes        as A

import IHP.HtmlSupport.ToHtml
import qualified IHP.NameSupport
import GHC.Types
import qualified Text.Inflections
import qualified Data.Text as Text
import Data.Maybe (fromJust)
import IHP.Controller.RequestContext
import IHP.RouterSupport hiding (get)
import IHP.ModelSupport (getModelName, inputValue, isNew, GetModelName, Id', NormalizeModel, MetaBag, InputValue)
import IHP.HtmlSupport.QQ (hsx)
import IHP.View.Types
import IHP.View.Classes 
import IHP.FrameworkConfig (ConfigProvider)
import qualified Network.Wai as Wai
import IHP.Controller.RequestContext
import IHP.Controller.Context

-- | Forms usually begin with a 'formFor' expression.
--
-- This is how a simple form can look like:
--
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {textField #title}
-- >     {textareaField #body}
-- >     {submitButton}
-- > |]
--
-- Calling this form from inside your HSX code will lead to the following HTML being generated:
--
-- > <form method="POST" action="/CreatePost" id="" class="new-form">
-- >     <div class="form-group" id="form-group-post_title">
-- >         <label for="post_title">Title</label>
-- >         <input type="text" name="title" id="post_title" class="form-control" />
-- >     </div>
-- > 
-- >     <div class="form-group" id="form-group-post_body">
-- >         <label for="post_body">Body</label>
-- >         <textarea name="body" id="post_body" class="form-control"></textarea>
-- >     </div>
-- > 
-- >     <button class="btn btn-primary">Create Post</button>
-- > </form>
--
-- You can see that the form is submitted via @POST@. The form action has also been set by default to @/CreatePost@.
--
-- All inputs have auto-generated class names and ids for styling. Also, all @name@ attributes are set as expected.
--
-- __Field Values:__
--
-- A form control is always filled with the value of the given field when rendering. For example, given a post
--
-- > let post = Post { ..., title = "Hello World" }
--
-- Rendering this, the input value will be set like:
--
-- >>> {textField #title}
-- <input ... value="Hello World" />
--
-- __Validation:__
--
-- When rendering a record that has failed validation, the validation error message will be rendered automatically.
--
-- Given a post like this:
--
-- > let post = Post { ..., title = "" }
-- >     |> validateField #title nonEmpty
--
-- Rendering @{textField #title}@, the input will have the css class @is-invalid@ and an element with the error message will be rendered below the input:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Title</label>
-- >     <input
-- >         type="text"
-- >         name="title"
-- >         placeholder=""
-- >         id="post_title"
-- >         class="form-control is-invalid "
-- >     />
-- >     <div class="invalid-feedback">This field cannot be empty</div>
-- > </div>
formFor :: forall record parent id application. (
    ?context :: ControllerContext
    , Eq record
    , Typeable record
    , ModelFormAction application record
    , HasField "id" record id
    , HasField "meta" record MetaBag
    , Default id
    , Eq id
    ) => record -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formFor :: record
-> ((?context::ControllerContext,
     ?formContext::FormContext record) =>
    Html)
-> Html
formFor record
record = FormContext record
-> ((?context::ControllerContext,
     ?formContext::FormContext record) =>
    Html)
-> Html
forall model parent id.
(?context::ControllerContext, HasField "id" model id, Default id,
 Eq id) =>
FormContext model
-> ((?context::ControllerContext,
     ?formContext::FormContext model) =>
    Html)
-> Html
buildForm (record -> FormContext record
forall record viewContext parent id application.
(?context::ControllerContext, Eq record, Typeable record,
 HasField "id" record id, HasField "meta" record MetaBag) =>
record -> FormContext record
createFormContext record
record) { $sel:formAction:FormContext :: Text
formAction = record -> Text
forall application record.
(ModelFormAction application record,
 ?context::ControllerContext) =>
record -> Text
modelFormAction @application record
record }
{-# INLINE formFor #-}

-- | Allows a custom form action (form submission url) to be set
--
-- The URL where the form is going to be submitted to is specified in HTML using the form's @action@ attribute. When using 'formFor' the @action@ attribute is automatically set to the expected path.
-- 
-- E.g. given the below 'formFor' code, the @action@ is set to @/CreatePost@ or @/UpdatePost@:
-- 
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {textField #title}
-- >     {textareaField #body}
-- >     {submitButton}
-- > |]
-- 
-- To override the auto-generated @action@ attribute use the 'formFor\'' function:
-- 
-- > renderForm :: Post -> Html
-- > renderForm post = formFor' post "/my-custom-endpoint" [hsx||]
-- 
-- If you pass an action to that, you need to wrap it with 'pathTo':
-- 
-- > renderForm :: Post -> Html
-- > renderForm post = formFor' post (pathTo CreateDraftAction) [hsx||]
--
formFor' :: forall record parent id application. (
    ?context :: ControllerContext
    , Eq record
    , Typeable record
    , HasField "id" record id
    , HasField "meta" record MetaBag
    , Default id
    , Eq id
    ) => record -> Text -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formFor' :: record
-> Text
-> ((?context::ControllerContext,
     ?formContext::FormContext record) =>
    Html)
-> Html
formFor' record
record Text
action = FormContext record
-> ((?context::ControllerContext,
     ?formContext::FormContext record) =>
    Html)
-> Html
forall model parent id.
(?context::ControllerContext, HasField "id" model id, Default id,
 Eq id) =>
FormContext model
-> ((?context::ControllerContext,
     ?formContext::FormContext model) =>
    Html)
-> Html
buildForm (record -> FormContext record
forall record viewContext parent id application.
(?context::ControllerContext, Eq record, Typeable record,
 HasField "id" record id, HasField "meta" record MetaBag) =>
record -> FormContext record
createFormContext record
record) { $sel:formAction:FormContext :: Text
formAction = Text
action }
{-# INLINE formFor' #-}

-- | Used by 'formFor' to make a new form context
createFormContext :: forall record viewContext parent id application. (
        ?context :: ControllerContext
        , Eq record
        , Typeable record
        , HasField "id" record id
        , HasField "meta" record MetaBag
        ) => record -> FormContext record
createFormContext :: record -> FormContext record
createFormContext record
record =
    FormContext :: forall model. model -> Text -> CSSFramework -> FormContext model
FormContext
        { $sel:model:FormContext :: record
model = record
record
        , $sel:formAction:FormContext :: Text
formAction = Text
""
        , $sel:cssFramework:FormContext :: CSSFramework
cssFramework = CSSFramework
(?context::ControllerContext) => CSSFramework
theCSSFramework
        }
{-# INLINE createFormContext #-}

-- | Used by 'formFor' to render the form
buildForm :: forall model  parent id. (?context :: ControllerContext, HasField "id" model id, Default id, Eq id) => FormContext model -> ((?context :: ControllerContext, ?formContext :: FormContext model) => Html5.Html) -> Html5.Html
buildForm :: FormContext model
-> ((?context::ControllerContext,
     ?formContext::FormContext model) =>
    Html)
-> Html
buildForm FormContext model
formContext (?context::ControllerContext, ?formContext::FormContext model) =>
Html
inner =
    let
        theModel :: model
theModel = FormContext model -> model
forall model. FormContext model -> model
model FormContext model
formContext
        action :: Text
action = FormContext model -> Text
forall model. FormContext model -> Text
formAction FormContext model
formContext
        isNewRecord :: Bool
isNewRecord = model -> Bool
forall model id.
(HasField "id" model id, Default id, Eq id) =>
model -> Bool
IHP.ModelSupport.isNew model
theModel
        formId :: Text
formId = if Bool
isNewRecord then Text
"" else FormContext model -> Text
forall model. FormContext model -> Text
formAction FormContext model
formContext
        Text
formClass :: Text = if Bool
isNewRecord then Text
"new-form" else Text
"edit-form"
        formInner :: Html
formInner = let ?formContext = formContext in Html
(?context::ControllerContext, ?formContext::FormContext model) =>
Html
inner
    in
        [hsx|<form method="POST" action={action} id={formId} class={formClass}>{formInner}</form>|]
{-# INLINE buildForm #-}

-- | Renders a submit button
--
-- > <button class="btn btn-primary">Create Post</button>
--
-- __Example:__
--
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {submitButton}
-- > |]
--
-- This will generate code like this:
--
-- > <form method="POST" action="/CreatePost" id="" class="new-form">
-- >     <button class="btn btn-primary">Create Post</button>
-- > </form>
--
-- __Custom Text__
--
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {submitButton { label = "Create it!" } }
-- > |]
--
-- This will generate code like this:
--
-- > <form method="POST" action="/CreatePost" id="" class="new-form">
-- >     <button class="btn btn-primary">Create it!</button>
-- > </form>
--
-- __Custom Class__
--
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {submitButton { buttonClass = "create-button" } }
-- > |]
--
-- This will generate code like this:
--
-- > <form method="POST" action="/CreatePost" id="" class="new-form">
-- >     <button class="btn btn-primary create-button">Create Post</button>
-- > </form>
submitButton :: forall model id. (?formContext :: FormContext model, HasField "id" model id, KnownSymbol (GetModelName model), Eq id, Default id) => SubmitButton
submitButton :: SubmitButton
submitButton =
    let
        modelName :: Text
modelName = KnownSymbol (GetModelName model) => Text
forall model. KnownSymbol (GetModelName model) => Text
IHP.ModelSupport.getModelName @model
        isNew :: Bool
isNew = model -> Bool
forall model id.
(HasField "id" model id, Default id, Eq id) =>
model -> Bool
IHP.ModelSupport.isNew (FormContext model -> model
forall model. FormContext model -> model
model ?formContext::FormContext model
FormContext model
?formContext)
    in SubmitButton :: Html -> Text -> CSSFramework -> SubmitButton
SubmitButton
    { $sel:label:SubmitButton :: Html
label = Text -> Html
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ (if Bool
isNew then Text
"Create " else Text
"Save ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName
    , $sel:buttonClass:SubmitButton :: Text
buttonClass = Text
forall a. Monoid a => a
mempty
    , $sel:cssFramework:SubmitButton :: CSSFramework
cssFramework = Proxy "cssFramework" -> FormContext model -> CSSFramework
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "cssFramework" (Proxy "cssFramework")
Proxy "cssFramework"
#cssFramework ?formContext::FormContext model
FormContext model
?formContext
    }
{-# INLINE submitButton #-}

-- | Renders a text input field
--
-- >>> {textField #title}
-- <div class="form-group" id="form-group-post_title">
--     <label for="post_title">Title</label>
--     <input type="text" name="title" id="post_title" class="form-control" />
-- </div>
--
-- __Example:__
--
-- > renderForm :: Post -> Html
-- > renderForm post = formFor post [hsx|
-- >     {textField #title}
-- > |]
--
-- This will generate code like this:
--
-- > <form method="POST" action="/CreatePost" id="" class="new-form">
-- >     <div class="form-group" id="form-group-post_title">
-- >         <label for="post_title">Title</label>
-- >         <input type="text" name="title" id="post_title" class="form-control" />
-- >     </div>
-- > </form>
--
-- __Help Texts:__
--
-- You can add a help text below a form control like this:
--
-- > {(textField #title) { helpText = "Max. 140 characters"} }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Title</label>
-- > 
-- >     <input type="text" name="title" id="post_title" class="form-control" />
-- >     <small class="form-text text-muted">Max. 140 characters</small>
-- > </div>
--
--
-- __Custom Field Label Text:__
--
-- By default, the field name will be used as a label text. The camel case field name will be made more human-readable of course, so @contactName@ will turn to @Contact Name@, etc. Sometimes you want to change this auto-generated input label to something custom. Use @fieldLabel@ for that, like this:
--
-- > {(textField #title) { fieldLabel = "Post Title"} }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Post Title</label>
-- >     <input type="text" name="title" id="post_title" class="form-control" />
-- > </div>
--
--
-- __Custom CSS Classes:__
--
-- You can add custom CSS classes to the input and label for better styling. Set @fieldClass@ for adding a class to the input element and @labelClass@ for the label element:
--
-- > {(textField #title) { fieldClass="title-input", labelClass = "title-label" } }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label class="title-label" for="post_title">Title</label>
-- >     <input
-- >         type="text"
-- >         name="title"
-- >         id="post_title"
-- >         class="form-control title-input"
-- >     />
-- > </div>
--
-- Of course, the CSS classes for validation are still set as expected.
--
-- __Placeholder:__
--
-- > {(textField #title) { placeholder = "Enter your title ..." } }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Title</label>
-- > 
-- >     <input
-- >         type="text"
-- >         name="title"
-- >         id="post_title"
-- >         placeholder="Enter your title ..."
-- >         class="form-control"
-- >     />
-- > </div>
--
--
-- __Required Fields:__
--
-- You can mark an input as required like this:
--
-- > {(textField #title) { required = True } }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Title</label>
-- > 
-- >     <input
-- >         type="text"
-- >         name="title"
-- >         id="post_title"
-- >         required="required"
-- >         class="form-control"
-- >     />
-- > </div>
--
-- __Autofocus:__
--
-- You can mark an input with autofocus, to ensure it will be given the input focus on page load, like this:
--
-- > {(textField #title) { autofocus = True } }
--
-- This will generate code like this:
--
-- > <div class="form-group" id="form-group-post_title">
-- >     <label for="post_title">Title</label>
-- > 
-- >     <input
-- >         type="text"
-- >         name="title"
-- >         id="post_title"
-- >         autofocus="autofocus"
-- >         class="form-control"
-- >     />
-- > </div>
textField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
textField :: Proxy fieldName -> FormField
textField Proxy fieldName
field = FormField :: InputType
-> AttributeValue
-> Text
-> Text
-> Text
-> Maybe Text
-> (FormField -> Html)
-> Text
-> Text
-> Bool
-> Bool
-> Bool
-> CSSFramework
-> Text
-> Text
-> Bool
-> Bool
-> FormField
FormField
        { $sel:fieldType:FormField :: InputType
fieldType = InputType
TextInput
        , $sel:fieldName:FormField :: AttributeValue
fieldName = String -> AttributeValue
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
        , $sel:fieldLabel:FormField :: Text
fieldLabel = Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:fieldValue:FormField :: Text
fieldValue =  value -> Text
forall a. InputValue a => a -> Text
inputValue ((model -> value
forall k (x :: k) r a. HasField x r a => r -> a
getField @fieldName model
model) :: value)
        , $sel:fieldInputId:FormField :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
IHP.NameSupport.lcfirst (KnownSymbol (GetModelName model) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @model) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:validatorResult:FormField :: Maybe Text
validatorResult = Proxy fieldName -> model -> Maybe Text
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Text
getValidationFailure Proxy fieldName
field model
model
        , $sel:fieldClass:FormField :: Text
fieldClass = Text
""
        , $sel:labelClass:FormField :: Text
labelClass = Text
""
        , $sel:disableLabel:FormField :: Bool
disableLabel = Bool
False
        , $sel:disableGroup:FormField :: Bool
disableGroup = Bool
False
        , $sel:disableValidationResult:FormField :: Bool
disableValidationResult = Bool
False
        , $sel:fieldInput:FormField :: FormField -> Html
fieldInput = Html -> FormField -> Html
forall a b. a -> b -> a
const Html
Html5.input
        , $sel:cssFramework:FormField :: CSSFramework
cssFramework = Proxy "cssFramework" -> FormContext model -> CSSFramework
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "cssFramework" (Proxy "cssFramework")
Proxy "cssFramework"
#cssFramework ?formContext::FormContext model
FormContext model
?formContext
        , $sel:helpText:FormField :: Text
helpText = Text
""
        , $sel:placeholder:FormField :: Text
placeholder = Text
""
        , $sel:required:FormField :: Bool
required = Bool
False
        , $sel:autofocus:FormField :: Bool
autofocus = Bool
False
        }
    where
        fieldName :: String
fieldName = Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy fieldName
field
        FormContext { model
model :: model
$sel:model:FormContext :: forall model. FormContext model -> model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE textField #-}

-- | Renders a number input field
--
-- >>> {numberField #maxUsers}
-- <div class="form-group" id="form-group-company_max_users">
--     <label for="company_max_users">Max Users</label>
--     <input type="number" name="maxUsers" id="company_maxUsers" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
numberField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
numberField :: Proxy fieldName -> FormField
numberField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
NumberInput }
{-# INLINE numberField #-}

-- | Renders a textarea
--
-- >>> {textareaField #body}
-- <div class="form-group" id="form-group-post_body">
--     <label for="post_body">Body</label>
--     <textarea name="body" id="post_body" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
textareaField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
textareaField :: Proxy fieldName -> FormField
textareaField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
TextareaInput, $sel:fieldInput:FormField :: FormField -> Html
fieldInput = \FormField
formField -> Html -> Html
Html5.textarea (Text -> Html
forall a b. ConvertibleStrings a b => a -> b
cs (FormField -> Text
fieldValue FormField
formField)) }
{-# INLINE textareaField #-}

-- | Renders a color field
--
-- >>> {colorField #color}
-- <div class="form-group" id="form-group-post_color">
--     <label for="post_color">Color</label>
--     <input type="color" name="color" id="post_color" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
colorField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
colorField :: Proxy fieldName -> FormField
colorField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
ColorInput }
{-# INLINE colorField #-}


-- | Renders an email field
--
-- >>> {emailField #email}
-- <div class="form-group" id="form-group-user_email">
--     <label for="user_email">Email</label>
--     <input type="email" name="email" id="user_email" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
emailField :: forall fieldName model.
    ( ?formContext :: FormContext model
    , HasField fieldName model Text
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
emailField :: Proxy fieldName -> FormField
emailField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
EmailInput }
{-# INLINE emailField #-}

-- | Renders an date field
--
-- >>> {dateField #createdAt}
-- <div class="form-group" id="form-group-user_created_at">
--     <label for="user_createdAt">Created At</label>
--     <input type="date" name="createdAt" id="user_createdAt" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
dateField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
dateField :: Proxy fieldName -> FormField
dateField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
DateInput }
{-# INLINE dateField #-}

-- | Renders an password field
--
-- >>> {passwordField #password}
-- <div class="form-group" id="form-group-user_password">
--     <label for="user_password">Password</label>
--     <input type="password" name="password" id="user_password" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
passwordField :: forall fieldName model.
    ( ?formContext :: FormContext model
    , HasField fieldName model Text
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
passwordField :: Proxy fieldName -> FormField
passwordField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
PasswordInput }
{-# INLINE passwordField #-}

-- | Renders an date-time field
--
-- >>> {dateTimeField #createdAt}
-- <div class="form-group" id="form-group-user_created_at">
--     <label for="user_createdAt">Created At</label>
--     <input type="datetime-local" name="createdAt" id="user_createdAt" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
dateTimeField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
dateTimeField :: Proxy fieldName -> FormField
dateTimeField Proxy fieldName
alpha = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
alpha) { $sel:fieldType:FormField :: InputType
fieldType = InputType
DateTimeInput }
{-# INLINE dateTimeField #-}

-- | Renders an hidden field
--
-- >>> {hiddenField #projectId}
-- <input type="hidden" name="projectId" id="checkoutSession_projectId" class="form-control" />
--
-- The hidden field is by default rendered without a form group and without a label.
hiddenField :: forall fieldName model value.
    ( ?formContext :: FormContext model
    , HasField fieldName model value
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , InputValue value
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
hiddenField :: Proxy fieldName -> FormField
hiddenField Proxy fieldName
field = (Proxy fieldName -> FormField
forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 InputValue value, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
textField Proxy fieldName
field) { $sel:fieldType:FormField :: InputType
fieldType = InputType
HiddenInput }
{-# INLINE hiddenField #-}

-- | Renders a checkbox field
--
-- >>> {checkboxField #active}
-- <div class="form-group" id="form-group-user_active">
--     <label for="user_active">Active</label>
--     <input type="checkbox" name="active" id="user_active" class="form-control" />
-- </div>
--
-- See 'textField' for examples of possible form control options.
checkboxField :: forall fieldName model.
    ( ?formContext :: FormContext model
    , HasField fieldName model Bool
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    ) => Proxy fieldName -> FormField
checkboxField :: Proxy fieldName -> FormField
checkboxField Proxy fieldName
field = FormField :: InputType
-> AttributeValue
-> Text
-> Text
-> Text
-> Maybe Text
-> (FormField -> Html)
-> Text
-> Text
-> Bool
-> Bool
-> Bool
-> CSSFramework
-> Text
-> Text
-> Bool
-> Bool
-> FormField
FormField
        { $sel:fieldType:FormField :: InputType
fieldType = InputType
CheckboxInput
        , $sel:fieldName:FormField :: AttributeValue
fieldName = String -> AttributeValue
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
        , $sel:fieldLabel:FormField :: Text
fieldLabel = Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:fieldValue:FormField :: Text
fieldValue =  if model -> Bool
forall k (x :: k) r a. HasField x r a => r -> a
getField @fieldName model
model then Text
"yes" else Text
"no"
        , $sel:fieldInputId:FormField :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
IHP.NameSupport.lcfirst (KnownSymbol (GetModelName model) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @model) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:validatorResult:FormField :: Maybe Text
validatorResult = Proxy fieldName -> model -> Maybe Text
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Text
getValidationFailure Proxy fieldName
field model
model
        , $sel:fieldClass:FormField :: Text
fieldClass = Text
""
        , $sel:labelClass:FormField :: Text
labelClass = Text
""
        , $sel:disableLabel:FormField :: Bool
disableLabel = Bool
False
        , $sel:disableGroup:FormField :: Bool
disableGroup = Bool
False
        , $sel:disableValidationResult:FormField :: Bool
disableValidationResult = Bool
False
        , $sel:fieldInput:FormField :: FormField -> Html
fieldInput = Html -> FormField -> Html
forall a b. a -> b -> a
const Html
Html5.input
        , $sel:cssFramework:FormField :: CSSFramework
cssFramework = Proxy "cssFramework" -> FormContext model -> CSSFramework
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "cssFramework" (Proxy "cssFramework")
Proxy "cssFramework"
#cssFramework ?formContext::FormContext model
FormContext model
?formContext
        , $sel:helpText:FormField :: Text
helpText = Text
""
        , $sel:placeholder:FormField :: Text
placeholder = Text
""
        , $sel:required:FormField :: Bool
required = Bool
False
        , $sel:autofocus:FormField :: Bool
autofocus = Bool
False
        }
    where
        fieldName :: String
fieldName = Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy fieldName
field
        FormContext { model
model :: model
$sel:model:FormContext :: forall model. FormContext model -> model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE checkboxField #-}

-- | Select inputs require you to pass a list of possible values to select.
--
-- > formFor project [hsx|
-- >     {selectField #userId users}
-- > |]
--
-- In the example above the variable users contains all the possible option values for the select.
--
-- You also need to define a instance @CanSelect User@:
--
-- > instance CanSelect User where
-- >     -- Here we specify that the <option> value should contain a `Id User`
-- >     type SelectValue User = Id User
-- >     -- Here we specify how to transform the model into <option>-value
-- >     selectValue = get #id
-- >     -- And here we specify the <option>-text
-- >     selectLabel = get #name
--
-- Given the above example, the rendered form will look like this:
--
-- > <!-- Assuming: users = [User { id = 1, name = "Marc" }, User { id = 2, name = "Andreas" }] -->
-- > <form ...>
-- >     <select name="user_id">
-- >         <option value="1">Marc</option>
-- >         <option value="2">Andreas</option>
-- >     </select>
-- > </form>
--
-- If you want a certain value to be preselected, set the value in the controller. For example, to have the first user be preselected in the above example:
--
-- > action NewProjectAction = do
-- >     users <- query @User |> fetch
-- >     let userId = headMay users |> maybe def (get #id)
-- >     let target = newRecord @Project |> set #userId userId
-- >     render NewView { .. }
selectField :: forall fieldName model item.
    ( ?formContext :: FormContext model
    , HasField fieldName model (SelectValue item)
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    , CanSelect item
    , InputValue (SelectValue item)
    ) => Proxy fieldName -> [item] -> FormField
selectField :: Proxy fieldName -> [item] -> FormField
selectField Proxy fieldName
field [item]
items = FormField :: InputType
-> AttributeValue
-> Text
-> Text
-> Text
-> Maybe Text
-> (FormField -> Html)
-> Text
-> Text
-> Bool
-> Bool
-> Bool
-> CSSFramework
-> Text
-> Text
-> Bool
-> Bool
-> FormField
FormField
        { $sel:fieldType:FormField :: InputType
fieldType =
            let
                itemToTuple :: item -> (Text, Text)
                itemToTuple :: item -> (Text, Text)
itemToTuple item
item = (item -> Text
forall model. CanSelect model => model -> Text
selectLabel item
item, SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue (item -> SelectValue item
forall model. CanSelect model => model -> SelectValue model
selectValue item
item))
            in
                 [(Text, Text)] -> InputType
SelectInput ((item -> (Text, Text)) -> [item] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map item -> (Text, Text)
itemToTuple [item]
items)
        , $sel:fieldName:FormField :: AttributeValue
fieldName = String -> AttributeValue
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
        , $sel:fieldLabel:FormField :: Text
fieldLabel = Text -> Text
removeIdSuffix (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:fieldValue:FormField :: Text
fieldValue = SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue ((model -> SelectValue item
forall k (x :: k) r a. HasField x r a => r -> a
getField @fieldName model
model :: SelectValue item))
        , $sel:fieldInputId:FormField :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
IHP.NameSupport.lcfirst (KnownSymbol (GetModelName model) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @model) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , $sel:validatorResult:FormField :: Maybe Text
validatorResult = Proxy fieldName -> model -> Maybe Text
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Text
getValidationFailure Proxy fieldName
field model
model
        , $sel:fieldClass:FormField :: Text
fieldClass = Text
""
        , $sel:labelClass:FormField :: Text
labelClass = Text
""
        , $sel:disableLabel:FormField :: Bool
disableLabel = Bool
False
        , $sel:disableGroup:FormField :: Bool
disableGroup = Bool
False
        , $sel:disableValidationResult:FormField :: Bool
disableValidationResult = Bool
False
        , $sel:fieldInput:FormField :: FormField -> Html
fieldInput = Html -> FormField -> Html
forall a b. a -> b -> a
const (Html -> Html
Html5.select Html
forall a. Monoid a => a
mempty)
        , $sel:cssFramework:FormField :: CSSFramework
cssFramework = Proxy "cssFramework" -> FormContext model -> CSSFramework
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "cssFramework" (Proxy "cssFramework")
Proxy "cssFramework"
#cssFramework ?formContext::FormContext model
FormContext model
?formContext
        , $sel:helpText:FormField :: Text
helpText = Text
""
        , $sel:placeholder:FormField :: Text
placeholder = Text
"Please select"
        , $sel:required:FormField :: Bool
required = Bool
False
        , $sel:autofocus:FormField :: Bool
autofocus = Bool
False
    }
    where
        fieldName :: String
fieldName = Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy fieldName
field
        FormContext { model
model :: model
$sel:model:FormContext :: forall model. FormContext model -> model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE selectField #-}

class CanSelect model where
    -- | Here we specify the type of the @<option>@ value, usually an @Id model@
    type SelectValue model :: GHC.Types.Type

    -- | Here we specify the <option>-text
    selectLabel :: model -> Text
    default selectLabel :: Show model => model -> Text
    selectLabel = model -> Text
forall a. Show a => a -> Text
tshow

    -- | Here we specify how to transform the model into @<option>@-value
    selectValue :: model -> SelectValue model
    default selectValue :: HasField "id" model (SelectValue model) => model -> SelectValue model
    selectValue = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "id" r a => r -> a
getField @"id"

instance ToHtml FormField where
    {-# INLINE toHtml #-}
    toHtml ::  FormField -> Html5.Html
    toHtml :: FormField -> Html
toHtml formField :: FormField
formField@(FormField { CSSFramework
cssFramework :: CSSFramework
$sel:cssFramework:FormField :: FormField -> CSSFramework
cssFramework }) = CSSFramework -> CSSFramework -> FormField -> Html
styledFormField CSSFramework
cssFramework CSSFramework
cssFramework FormField
formField

instance ToHtml SubmitButton where
    {-# INLINE toHtml #-}
    toHtml :: SubmitButton -> Html
toHtml submitButton :: SubmitButton
submitButton@(SubmitButton { CSSFramework
cssFramework :: CSSFramework
$sel:cssFramework:SubmitButton :: SubmitButton -> CSSFramework
cssFramework }) = CSSFramework -> CSSFramework -> SubmitButton -> Html
styledSubmitButton CSSFramework
cssFramework CSSFramework
cssFramework SubmitButton
submitButton

-- | Returns the form's action attribute for a given record.
class ModelFormAction application record where
    modelFormAction :: (?context :: ControllerContext) => record -> Text

instance (
    HasField "id" record id
    , Eq id
    , Default id
    , KnownSymbol (GetModelName record)
    , Show id
    ) => ModelFormAction application record where
    -- | Returns the form's action attribute for a given record.
    --
    -- Expects that AutoRoute is used. Otherwise you need to use @formFor'@ or specify
    -- a manual ModelFormAction instance.
    --
    -- We guess the form submitt action based on the current url
    -- It's a @New..Action@ or @Edit..Action@. We guess the corresponding
    -- @Create..Action@ name or @Update..Action@ name based on the AutoRoute rules
    --
    -- In case the routing is not based on AutoRoute, a manual ModelFormAction instance needs
    -- to be defined
    modelFormAction :: record -> Text
modelFormAction record
record =
        let
            path :: [Text]
path = Request
(?context::ControllerContext) => Request
theRequest Request -> (Request -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "pathInfo" -> Request -> [Text]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "pathInfo" (Proxy "pathInfo")
Proxy "pathInfo"
#pathInfo
            action :: Text
action = if record -> Bool
forall model id.
(HasField "id" model id, Default id, Eq id) =>
model -> Bool
isNew record
record
                then Text
"Create" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KnownSymbol (GetModelName record) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @record
                else Text
"Update" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KnownSymbol (GetModelName record) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @record Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
lcfirst (KnownSymbol (GetModelName record) => Text
forall model. KnownSymbol (GetModelName model) => Text
getModelName @record) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Id=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> id -> Text
forall a. Show a => a -> Text
tshow (Proxy "id" -> record -> id
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id record
record)
        in
            [Text] -> Maybe [Text]
forall a. [a] -> Maybe [a]
init [Text]
path
                Maybe [Text] -> (Maybe [Text] -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (\Maybe [Text]
path -> [Text
""] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
path) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
action])
                [Text] -> ([Text] -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
intercalate Text
"/"

-- | Transform a data-field name like @userName@  to a friendly human-readable name like @User name@
fieldNameToFieldLabel :: Text -> Text
fieldNameToFieldLabel :: Text -> Text
fieldNameToFieldLabel Text
fieldName = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (let (Right [SomeWord]
parts) = [Word 'Acronym]
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
Text.Inflections.parseCamelCase [] Text
fieldName in [SomeWord] -> Text
Text.Inflections.titleize [SomeWord]
parts)
{-# INLINE fieldNameToFieldLabel #-}

-- | Transform a column name like @user_name@  to a friendly human-readable name like @User name@
columnNameToFieldLabel :: Text -> Text
columnNameToFieldLabel :: Text -> Text
columnNameToFieldLabel Text
columnName = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (let (Right [SomeWord]
parts) = [Word 'Acronym]
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
Text.Inflections.parseSnakeCase [] Text
columnName in [SomeWord] -> Text
Text.Inflections.titleize [SomeWord]
parts)
{-# INLINE columnNameToFieldLabel #-}

-- | Removes @ Id@  from a string
--
-- >>> removeIdSuffix "User Id"
-- "User"
--
-- When the string does not end with @ Id@, it will just return the input string:
--
-- >>> removeIdSuffix "Project"
-- "Project"
removeIdSuffix :: Text -> Text
removeIdSuffix :: Text -> Text
removeIdSuffix Text
text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
text (Text -> Text -> Maybe Text
Text.stripSuffix Text
" Id" Text
text)
{-# INLINE removeIdSuffix #-}