{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE InstanceSigs, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, IncoherentInstances #-}
module IHP.View.Form where
import IHP.Prelude
import IHP.ValidationSupport
import IHP.HSX.ConvertibleStrings ()
import IHP.ViewErrorMessages ()
import IHP.ViewSupport
import qualified Text.Blaze.Html5 as Html5
import IHP.HSX.ToHtml
import GHC.Types
import IHP.ModelSupport (getModelName, inputValue, isNew, Id', InputValue, didTouchField)
import IHP.HSX.QQ (hsx)
import IHP.View.Types
import IHP.View.Classes ()
import Network.Wai (pathInfo)
import IHP.Controller.Context
formFor :: forall record. (
?context :: ControllerContext
, ModelFormAction record
, HasField "meta" record MetaBag
) => record -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formFor :: forall record.
(?context::ControllerContext, ModelFormAction record,
HasField "meta" record MetaBag) =>
record
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
formFor record
record (?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody = forall record.
(?context::ControllerContext, ModelFormAction record,
HasField "meta" record MetaBag) =>
record
-> (FormContext record -> FormContext record)
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
formForWithOptions @record record
record (\FormContext record
c -> FormContext record
c) Html
(?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody
{-# INLINE formFor #-}
formForWithOptions :: forall record. (
?context :: ControllerContext
, ModelFormAction record
, HasField "meta" record MetaBag
) => record -> (FormContext record -> FormContext record) -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formForWithOptions :: forall record.
(?context::ControllerContext, ModelFormAction record,
HasField "meta" record MetaBag) =>
record
-> (FormContext record -> FormContext record)
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
formForWithOptions record
record FormContext record -> FormContext record
applyOptions (?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody = FormContext record
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
forall model.
(?context::ControllerContext) =>
FormContext model
-> ((?context::ControllerContext,
?formContext::FormContext model) =>
Html)
-> Html
buildForm (FormContext record -> FormContext record
applyOptions (record -> FormContext record
forall record.
(?context::ControllerContext, HasField "meta" record MetaBag) =>
record -> FormContext record
createFormContext record
record) { formAction = modelFormAction record }) Html
(?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody
{-# INLINE formForWithOptions #-}
formForWithoutJavascript :: forall record. (
?context :: ControllerContext
, ModelFormAction record
, HasField "meta" record MetaBag
) => record -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formForWithoutJavascript :: forall record.
(?context::ControllerContext, ModelFormAction record,
HasField "meta" record MetaBag) =>
record
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
formForWithoutJavascript record
record (?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody = forall record.
(?context::ControllerContext, ModelFormAction record,
HasField "meta" record MetaBag) =>
record
-> (FormContext record -> FormContext record)
-> ((?context::ControllerContext,
?formContext::FormContext record) =>
Html)
-> Html
formForWithOptions @record record
record (\FormContext record
formContext -> FormContext record
formContext { disableJavascriptSubmission = True }) Html
(?context::ControllerContext, ?formContext::FormContext record) =>
Html
formBody
{-# INLINE formForWithoutJavascript #-}
formFor' :: forall record. (
?context :: ControllerContext
, HasField "meta" record MetaBag
) => record -> Text -> ((?context :: ControllerContext, ?formContext :: FormContext record) => Html5.Html) -> Html5.Html
formFor' :: forall record.
(?context::ControllerContext, HasField "meta" record MetaBag) =>
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.
(?context::ControllerContext) =>
FormContext model
-> ((?context::ControllerContext,
?formContext::FormContext model) =>
Html)
-> Html
buildForm (record -> FormContext record
forall record.
(?context::ControllerContext, HasField "meta" record MetaBag) =>
record -> FormContext record
createFormContext record
record) { formAction = action }
{-# INLINE formFor' #-}
createFormContext :: forall record. (
?context :: ControllerContext
, HasField "meta" record MetaBag
) => record -> FormContext record
createFormContext :: forall record.
(?context::ControllerContext, HasField "meta" record MetaBag) =>
record -> FormContext record
createFormContext record
record =
FormContext
{ model :: record
model = record
record
, formAction :: Text
formAction = Text
""
, formMethod :: Text
formMethod = Text
"POST"
, cssFramework :: CSSFramework
cssFramework = CSSFramework
(?context::ControllerContext) => CSSFramework
theCSSFramework
, formId :: Text
formId = Text
""
, formClass :: Text
formClass = if record -> Bool
forall model. HasField "meta" model MetaBag => model -> Bool
isNew record
record then Text
"new-form" else Text
"edit-form"
, customFormAttributes :: [(Text, Text)]
customFormAttributes = []
, disableJavascriptSubmission :: Bool
disableJavascriptSubmission = Bool
False
, fieldNamePrefix :: Text
fieldNamePrefix = Text
""
}
{-# INLINE createFormContext #-}
buildForm :: forall model. (?context :: ControllerContext) => FormContext model -> ((?context :: ControllerContext, ?formContext :: FormContext model) => Html5.Html) -> Html5.Html
buildForm :: forall model.
(?context::ControllerContext) =>
FormContext model
-> ((?context::ControllerContext,
?formContext::FormContext model) =>
Html)
-> Html
buildForm FormContext model
formContext (?context::ControllerContext, ?formContext::FormContext model) =>
Html
inner = [hsx|
<form
method={formContext.formMethod}
action={formContext.formAction}
id={formContext.formId}
class={formContext.formClass}
data-disable-javascript-submission={formContext.disableJavascriptSubmission}
{...formContext.customFormAttributes}
>
{formInner}
</form>
|]
where
formInner :: Html
formInner = let ?formContext = ?formContext::FormContext model
FormContext model
formContext in Html
(?context::ControllerContext, ?formContext::FormContext model) =>
Html
inner
{-# INLINE buildForm #-}
nestedFormFor :: forall fieldName childRecord parentRecord idType. (
?context :: ControllerContext
, ?formContext :: FormContext parentRecord
, HasField fieldName parentRecord [childRecord]
, KnownSymbol fieldName
, KnownSymbol (GetModelName childRecord)
, HasField "id" childRecord idType
, InputValue idType
, HasField "meta" childRecord MetaBag
) => Proxy fieldName -> ((?context :: ControllerContext, ?formContext :: FormContext childRecord) => Html5.Html) -> Html5.Html
nestedFormFor :: forall (fieldName :: Symbol) childRecord parentRecord idType.
(?context::ControllerContext,
?formContext::FormContext parentRecord,
HasField fieldName parentRecord [childRecord],
KnownSymbol fieldName, KnownSymbol (GetModelName childRecord),
HasField "id" childRecord idType, InputValue idType,
HasField "meta" childRecord MetaBag) =>
Proxy fieldName
-> ((?context::ControllerContext,
?formContext::FormContext childRecord) =>
Html)
-> Html
nestedFormFor Proxy fieldName
field (?context::ControllerContext,
?formContext::FormContext childRecord) =>
Html
nestedRenderForm = [childRecord] -> (Element [childRecord] -> Html) -> Html
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forEach [childRecord]
children childRecord -> Html
Element [childRecord] -> Html
renderChild
where
parentFormContext :: FormContext parentRecord
parentFormContext :: FormContext parentRecord
parentFormContext = ?formContext::FormContext parentRecord
FormContext parentRecord
?formContext
renderChild :: childRecord -> Html5.Html
renderChild :: childRecord -> Html
renderChild childRecord
record = let ?formContext = childRecord -> FormContext childRecord
buildNestedFormContext childRecord
record in [hsx|
{hiddenField #id}
{nestedRenderForm}
|]
buildNestedFormContext :: childRecord -> FormContext childRecord
buildNestedFormContext :: childRecord -> FormContext childRecord
buildNestedFormContext childRecord
record = FormContext parentRecord
parentFormContext { model = record, fieldNamePrefix = symbolToText @fieldName <> "_" }
children :: [childRecord]
children :: [childRecord]
children = forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName ?formContext::FormContext parentRecord
FormContext parentRecord
?formContext.model
{-# INLINE nestedFormFor #-}
submitButton :: forall model. (?formContext :: FormContext model, HasField "meta" model MetaBag, KnownSymbol (GetModelName model)) => SubmitButton
submitButton :: forall model.
(?formContext::FormContext model, HasField "meta" model MetaBag,
KnownSymbol (GetModelName model)) =>
SubmitButton
submitButton =
let
modelName :: Text
modelName = forall model. KnownSymbol (GetModelName model) => Text
IHP.ModelSupport.getModelName @model
buttonText :: Text
buttonText = Text
modelName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
humanize
isNew :: Bool
isNew = model -> Bool
forall model. HasField "meta" model MetaBag => model -> Bool
IHP.ModelSupport.isNew (FormContext model -> model
forall model. FormContext model -> model
model ?formContext::FormContext model
FormContext model
?formContext)
in SubmitButton
{ label :: 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
buttonText
, buttonClass :: Text
buttonClass = Text
forall a. Monoid a => a
mempty
, buttonDisabled :: Bool
buttonDisabled = Bool
False
, cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
}
{-# INLINE submitButton #-}
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 :: 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 = FormField
{ fieldType :: InputType
fieldType = InputType
TextInput
, fieldName :: Text
fieldName = ?formContext::FormContext model
FormContext model
?formContext.fieldNamePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
, fieldLabel :: Text
fieldLabel = Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
, fieldValue :: Text
fieldValue = value -> Text
forall a. InputValue a => a -> Text
inputValue ((forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName model
model) :: value)
, fieldInputId :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
lcfirst (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)
, validatorResult :: Maybe Violation
validatorResult = Proxy fieldName -> model -> Maybe Violation
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy fieldName
field model
model
, fieldClass :: Text
fieldClass = Text
""
, labelClass :: Text
labelClass = Text
""
, disabled :: Bool
disabled = Bool
False
, disableLabel :: Bool
disableLabel = Bool
False
, disableGroup :: Bool
disableGroup = Bool
False
, disableValidationResult :: Bool
disableValidationResult = Bool
False
, additionalAttributes :: [(Text, Text)]
additionalAttributes = []
, cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
, helpText :: Text
helpText = Text
""
, placeholder :: Text
placeholder = Text
""
, required :: Bool
required = Bool
False
, autofocus :: 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 :: forall model. FormContext model -> model
model :: model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE textField #-}
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 :: 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
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) { fieldType = NumberInput }
{-# INLINE numberField #-}
urlField :: 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
urlField :: 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
urlField 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) { fieldType = UrlInput }
{-# INLINE urlField #-}
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 :: 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
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) { fieldType = TextareaInput }
{-# INLINE textareaField #-}
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 :: 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
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) { fieldType = ColorInput }
{-# INLINE colorField #-}
emailField :: forall fieldName model value.
( ?formContext :: FormContext model
, HasField fieldName model value
, HasField "meta" model MetaBag
, KnownSymbol fieldName
, KnownSymbol (GetModelName model)
, InputValue value
) => Proxy fieldName -> FormField
emailField :: forall (fieldName :: Symbol) model value.
(?formContext::FormContext model, HasField fieldName model value,
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model), InputValue value) =>
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) { fieldType = EmailInput }
{-# INLINE emailField #-}
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 :: 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
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) { fieldType = DateInput }
{-# INLINE dateField #-}
passwordField :: forall fieldName model.
( ?formContext :: FormContext model
, HasField fieldName model Text
, HasField "meta" model MetaBag
, KnownSymbol fieldName
, KnownSymbol (GetModelName model)
) => Proxy fieldName -> FormField
passwordField :: forall (fieldName :: Symbol) model.
(?formContext::FormContext model, HasField fieldName model Text,
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model)) =>
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) { fieldType = PasswordInput }
{-# INLINE passwordField #-}
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 :: 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
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) { fieldType = DateTimeInput }
{-# INLINE dateTimeField #-}
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 :: 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
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) { fieldType = HiddenInput, disableLabel = True, disableGroup = True, disableValidationResult = True }
{-# INLINE hiddenField #-}
fileField :: 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
fileField :: 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
fileField 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) { fieldType = FileInput }
{-# INLINE fileField #-}
checkboxField :: forall fieldName model.
( ?formContext :: FormContext model
, HasField fieldName model Bool
, HasField "meta" model MetaBag
, KnownSymbol fieldName
, KnownSymbol (GetModelName model)
) => Proxy fieldName -> FormField
checkboxField :: forall (fieldName :: Symbol) model.
(?formContext::FormContext model, HasField fieldName model Bool,
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model)) =>
Proxy fieldName -> FormField
checkboxField Proxy fieldName
field = FormField
{ fieldType :: InputType
fieldType = InputType
CheckboxInput
, fieldName :: Text
fieldName = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
, fieldLabel :: Text
fieldLabel = Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
, fieldValue :: Text
fieldValue = if forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName model
model then Text
"yes" else Text
"no"
, fieldInputId :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
lcfirst (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)
, validatorResult :: Maybe Violation
validatorResult = Proxy fieldName -> model -> Maybe Violation
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy fieldName
field model
model
, fieldClass :: Text
fieldClass = Text
""
, labelClass :: Text
labelClass = Text
""
, disabled :: Bool
disabled = Bool
False
, disableLabel :: Bool
disableLabel = Bool
False
, disableGroup :: Bool
disableGroup = Bool
False
, disableValidationResult :: Bool
disableValidationResult = Bool
False
, additionalAttributes :: [(Text, Text)]
additionalAttributes = []
, cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
, helpText :: Text
helpText = Text
""
, placeholder :: Text
placeholder = Text
""
, required :: Bool
required = Bool
False
, autofocus :: 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 :: forall model. FormContext model -> model
model :: model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE checkboxField #-}
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)
, Typeable model
, Eq (SelectValue item)
) => Proxy fieldName -> [item] -> FormField
selectField :: forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
HasField fieldName model (SelectValue item),
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model), CanSelect item,
InputValue (SelectValue item), Typeable model,
Eq (SelectValue item)) =>
Proxy fieldName -> [item] -> FormField
selectField Proxy fieldName
field [item]
items = FormField
{ fieldType :: 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)
, fieldName :: Text
fieldName = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
, fieldLabel :: 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)
, fieldValue :: Text
fieldValue = if Proxy fieldName -> model -> Bool
forall (fieldName :: Symbol) fieldValue record.
(KnownSymbol fieldName, HasField fieldName record fieldValue,
HasField "meta" record MetaBag, Eq fieldValue, Typeable record) =>
Proxy fieldName -> record -> Bool
IHP.ModelSupport.didTouchField Proxy fieldName
field model
model Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ model -> Bool
forall model. HasField "meta" model MetaBag => model -> Bool
isNew model
model)
then SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName model
model :: SelectValue item)
else Text
""
, fieldInputId :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
lcfirst (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)
, validatorResult :: Maybe Violation
validatorResult = Proxy fieldName -> model -> Maybe Violation
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy fieldName
field model
model
, fieldClass :: Text
fieldClass = Text
""
, labelClass :: Text
labelClass = Text
""
, disabled :: Bool
disabled = Bool
False
, disableLabel :: Bool
disableLabel = Bool
False
, disableGroup :: Bool
disableGroup = Bool
False
, disableValidationResult :: Bool
disableValidationResult = Bool
False
, additionalAttributes :: [(Text, Text)]
additionalAttributes = []
, cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
, helpText :: Text
helpText = Text
""
, placeholder :: Text
placeholder = Text
"Please select"
, required :: Bool
required = Bool
False
, autofocus :: 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 :: forall model. FormContext model -> model
model :: model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE selectField #-}
radioField :: 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)
, Typeable model
, Eq (SelectValue item)
) => Proxy fieldName -> [item] -> FormField
radioField :: forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
HasField fieldName model (SelectValue item),
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model), CanSelect item,
InputValue (SelectValue item), Typeable model,
Eq (SelectValue item)) =>
Proxy fieldName -> [item] -> FormField
radioField Proxy fieldName
field [item]
items = (Proxy fieldName -> [item] -> FormField
forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
HasField fieldName model (SelectValue item),
HasField "meta" model MetaBag, KnownSymbol fieldName,
KnownSymbol (GetModelName model), CanSelect item,
InputValue (SelectValue item), Typeable model,
Eq (SelectValue item)) =>
Proxy fieldName -> [item] -> FormField
selectField Proxy fieldName
field [item]
items)
{ fieldType =
let
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
RadioInput (map itemToTuple items)
, placeholder = ""
}
{-# INLINE radioField #-}
class CanSelect model where
type SelectValue model :: GHC.Types.Type
selectLabel :: model -> Text
default selectLabel :: Show model => model -> Text
selectLabel = model -> Text
forall a. Show a => a -> Text
tshow
selectValue :: model -> SelectValue model
default selectValue :: HasField "id" model (SelectValue model) => model -> SelectValue model
selectValue = (.id)
instance ToHtml FormField where
{-# INLINE toHtml #-}
toHtml :: FormField -> Html5.Html
toHtml :: FormField -> Html
toHtml formField :: FormField
formField@(FormField { CSSFramework
cssFramework :: FormField -> CSSFramework
cssFramework :: 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 :: SubmitButton -> CSSFramework
cssFramework :: CSSFramework
cssFramework }) = CSSFramework -> CSSFramework -> SubmitButton -> Html
styledSubmitButton CSSFramework
cssFramework CSSFramework
cssFramework SubmitButton
submitButton
class ModelFormAction record where
modelFormAction :: (?context :: ControllerContext) => record -> Text
instance
( HasField "id" record (Id' (GetTableName record))
, HasField "meta" record MetaBag
, KnownSymbol (GetModelName record)
, Show (Id' (GetTableName record))
) => ModelFormAction record where
modelFormAction :: (?context::ControllerContext) => record -> Text
modelFormAction record
record =
let
path :: [Text]
path = Request
(?context::ControllerContext) => Request
theRequest.pathInfo
action :: Text
action = if record -> Bool
forall model. HasField "meta" model MetaBag => model -> Bool
isNew record
record
then Text
"Create" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall model. KnownSymbol (GetModelName model) => Text
getModelName @record
else Text
"Update" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 (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' (GetTableName record) -> Text
forall a. Show a => a -> Text
tshow record
record.id
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
"/"
validationResult :: forall fieldName model fieldType.
( ?formContext :: FormContext model
, HasField fieldName model fieldType
, HasField "meta" model MetaBag
, KnownSymbol fieldName
, InputValue fieldType
, KnownSymbol (GetModelName model)
) => Proxy fieldName -> Html
validationResult :: forall (fieldName :: Symbol) model fieldType.
(?formContext::FormContext model,
HasField fieldName model fieldType, HasField "meta" model MetaBag,
KnownSymbol fieldName, InputValue fieldType,
KnownSymbol (GetModelName model)) =>
Proxy fieldName -> Html
validationResult Proxy fieldName
field = CSSFramework -> CSSFramework -> FormField -> Html
styledValidationResult CSSFramework
cssFramework CSSFramework
cssFramework (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)
where
result :: Maybe Text
result = 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
model :: model
model = ?formContext::FormContext model
FormContext model
?formContext.model
cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
validationResultMaybe :: forall fieldName model fieldType.
( ?formContext :: FormContext model
, HasField fieldName model fieldType
, HasField "meta" model MetaBag
, KnownSymbol fieldName
, KnownSymbol (GetModelName model)
) => Proxy fieldName -> Maybe Text
validationResultMaybe :: forall (fieldName :: Symbol) model fieldType.
(?formContext::FormContext model,
HasField fieldName model fieldType, HasField "meta" model MetaBag,
KnownSymbol fieldName, KnownSymbol (GetModelName model)) =>
Proxy fieldName -> Maybe Text
validationResultMaybe Proxy fieldName
field = Proxy fieldName -> model -> Maybe Text
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Text
getValidationFailure Proxy fieldName
field ?formContext::FormContext model
FormContext model
?formContext.model