module IHP.View.CSSFramework where
import IHP.Prelude
import IHP.FlashMessages.Types
import qualified Text.Blaze.Html5 as Blaze
import IHP.HSX.QQ (hsx)
import IHP.HSX.ToHtml ()
import IHP.View.Types
import IHP.View.Classes
import IHP.ModelSupport
import IHP.Breadcrumb.Types
import IHP.Pagination.Helpers
import IHP.Pagination.Types
instance Default CSSFramework where
def :: CSSFramework
def = CSSFramework
{
styledFlashMessage :: CSSFramework -> FlashMessage -> MarkupM ()
styledFlashMessage = \CSSFramework
cssFramework -> \case
SuccessFlashMessage Text
message -> [hsx|<div>{message}</div>|]
ErrorFlashMessage Text
message -> [hsx|<div>{message}</div>|]
, CSSFramework -> [FlashMessage] -> MarkupM ()
forall {mono} {m :: * -> *} {t}.
(MonoFoldable mono, Applicative m,
HasField "styledFlashMessage" t (t -> Element mono -> m ())) =>
t -> mono -> m ()
styledFlashMessages :: forall {mono} {m :: * -> *} {t}.
(MonoFoldable mono, Applicative m,
HasField "styledFlashMessage" t (t -> Element mono -> m ())) =>
t -> mono -> m ()
styledFlashMessages :: CSSFramework -> [FlashMessage] -> MarkupM ()
styledFlashMessages
, CSSFramework -> FormField -> MarkupM ()
styledFormField :: CSSFramework -> FormField -> MarkupM ()
styledFormField :: CSSFramework -> FormField -> MarkupM ()
styledFormField
, CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField
, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField
, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField
, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField
, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField
, CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup :: CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup :: CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup
, CSSFramework -> SubmitButton -> MarkupM ()
forall {r}.
HasField "styledSubmitButtonClass" r Text =>
r -> SubmitButton -> MarkupM ()
styledSubmitButton :: forall {r}.
HasField "styledSubmitButtonClass" r Text =>
r -> SubmitButton -> MarkupM ()
styledSubmitButton :: CSSFramework -> SubmitButton -> MarkupM ()
styledSubmitButton
, Text
styledSubmitButtonClass :: Text
styledSubmitButtonClass :: Text
styledSubmitButtonClass
, CSSFramework -> FormField -> MarkupM ()
forall {p}. p -> FormField -> MarkupM ()
styledFormFieldHelp :: forall {p}. p -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp
, CSSFramework -> FormField -> Text
forall {a} {p} {p}. IsString a => p -> p -> a
styledInputClass :: forall {a} {p} {p}. IsString a => p -> p -> a
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass
, CSSFramework -> FormField -> Text
forall {a} {p} {p}. IsString a => p -> p -> a
styledInputInvalidClass :: forall {a} {p} {p}. IsString a => p -> p -> a
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass
, Text
styledFormGroupClass :: Text
styledFormGroupClass :: Text
styledFormGroupClass
, CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult
, Text
styledValidationResultClass :: Text
styledValidationResultClass :: Text
styledValidationResultClass
, CSSFramework -> PaginationView -> MarkupM ()
styledPagination :: CSSFramework -> PaginationView -> MarkupM ()
styledPagination :: CSSFramework -> PaginationView -> MarkupM ()
styledPagination
, CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink
, CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot :: CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot :: CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot
, CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector
, CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious
, CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext
, CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb
, CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem :: CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem :: CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem
}
where
styledFlashMessages :: t -> mono -> m ()
styledFlashMessages t
cssFramework mono
flashMessages = mono -> (Element mono -> m ()) -> m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forEach mono
flashMessages (t
cssFramework.styledFlashMessage t
cssFramework)
styledFormField :: CSSFramework -> FormField -> Blaze.Html
styledFormField :: CSSFramework -> FormField -> MarkupM ()
styledFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult, CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework
-> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField} FormField
formField =
MarkupM () -> MarkupM ()
formGroup MarkupM ()
renderInner
where
renderInner :: MarkupM ()
renderInner = case FormField
formField.fieldType of
InputType
TextInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"text" FormField
formField MarkupM ()
validationResult
InputType
NumberInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"number" FormField
formField MarkupM ()
validationResult
InputType
UrlInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"url" FormField
formField MarkupM ()
validationResult
InputType
PasswordInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"password" FormField
formField MarkupM ()
validationResult
InputType
ColorInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"color" FormField
formField MarkupM ()
validationResult
InputType
EmailInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"email" FormField
formField MarkupM ()
validationResult
InputType
DateInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"date" FormField
formField MarkupM ()
validationResult
InputType
DateTimeInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"datetime-local" FormField
formField MarkupM ()
validationResult
InputType
CheckboxInput -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
InputType
HiddenInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"hidden" FormField
formField MarkupM ()
validationResult
InputType
TextareaInput -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
SelectInput {} -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
RadioInput {} -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
InputType
FileInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"file" FormField
formField MarkupM ()
validationResult
validationResult :: Blaze.Html
validationResult :: MarkupM ()
validationResult = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless FormField
formField.disableValidationResult (CSSFramework -> FormField -> MarkupM ()
styledValidationResult CSSFramework
cssFramework FormField
formField)
formGroup :: Blaze.Html -> Blaze.Html
formGroup :: MarkupM () -> MarkupM ()
formGroup MarkupM ()
renderInner = case FormField
formField of
FormField { disableGroup :: FormField -> Bool
disableGroup = Bool
True } -> MarkupM ()
renderInner
FormField { Text
fieldInputId :: Text
fieldInputId :: FormField -> Text
fieldInputId } -> CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup CSSFramework
cssFramework Text
fieldInputId MarkupM ()
renderInner
styledFormGroup :: CSSFramework -> Text -> Blaze.Html -> Blaze.Html
styledFormGroup :: CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup cssFramework :: CSSFramework
cssFramework@CSSFramework {Text
styledFormGroupClass :: CSSFramework -> Text
styledFormGroupClass :: Text
styledFormGroupClass} Text
fieldInputId MarkupM ()
renderInner =
[hsx|<div class={styledFormGroupClass} id={"form-group-" <> fieldInputId}>{renderInner}</div>|]
styledCheckboxFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: InputType
fieldType :: FormField -> InputType
fieldType, Text
fieldName :: Text
fieldName :: FormField -> Text
fieldName, Text
fieldLabel :: Text
fieldLabel :: FormField -> Text
fieldLabel, Text
fieldValue :: Text
fieldValue :: FormField -> Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult, Text
fieldClass :: Text
fieldClass :: FormField -> Text
fieldClass, Bool
disabled :: Bool
disabled :: FormField -> Bool
disabled, Bool
disableLabel :: Bool
disableLabel :: FormField -> Bool
disableLabel, Bool
disableValidationResult :: Bool
disableValidationResult :: FormField -> Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes, Text
labelClass :: Text
labelClass :: FormField -> Text
labelClass, Bool
required :: Bool
required :: FormField -> Bool
required, Bool
autofocus :: Bool
autofocus :: FormField -> Bool
autofocus } MarkupM ()
validationResult = do
[hsx|<div class="form-check">{element}</div>|]
where
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
theInput :: MarkupM ()
theInput = [hsx|
<input
type="checkbox"
name={fieldName}
class={classes ["form-check-input", (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
id={fieldInputId}
checked={fieldValue == "yes"}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
<input type="hidden" name={fieldName} value={inputValue False} />
|]
element :: MarkupM ()
element = if Bool
disableLabel
then [hsx|<div>
{theInput}
{validationResult}
{helpText}
</div>
|]
else [hsx|
{theInput}
<label
class={classes [("form-check-label", labelClass == ""), (labelClass, labelClass /= "")]}
for={fieldInputId}
>
{fieldLabel}
</label>
{validationResult}
{helpText}
|]
styledTextFormField :: CSSFramework -> Text -> FormField -> Blaze.Html -> Blaze.Html
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} Text
inputType formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: Text
placeholder :: FormField -> Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<input
type={inputType}
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={maybeValue}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
maybeValue :: Maybe Text
maybeValue = if Text
fieldValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldValue
styledSelectFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<select
name={fieldName}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={fieldValue}
disabled={disabled}
required={required}
autofocus={autofocus}
{...additionalAttributes}
>
<option value="" selected={not isValueSelected} disabled={True}>{placeholder}</option>
{forEach (options fieldType) (getOption)}
</select>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
isValueSelected :: Bool
isValueSelected = ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
_, Text
optionValue) -> Text
optionValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldValue) (InputType -> [(Text, Text)]
options InputType
fieldType)
getOption :: (Text, Text) -> MarkupM ()
getOption (Text
optionLabel, Text
optionValue) = [hsx|
<option value={optionValue} selected={optionValue == fieldValue}>
{optionLabel}
</option>
|]
styledRadioFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<fieldset>
{forEach (options fieldType) (getRadio)}
</fieldset>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
getRadio :: (Text, Text) -> MarkupM ()
getRadio (Text
optionLabel, Text
optionValue) = [hsx|
<div class="form-check">
<input
class={classes ["form-check-input", (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
type="radio"
id={optionId}
name={fieldName}
value={optionValue}
checked={optionValue == fieldValue}
disabled={disabled}
required={required}
autofocus={autofocus}
{...additionalAttributes}
/>
{label}
</div>
|]
where
optionId :: Text
optionId = Text
fieldInputId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
optionValue
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-check-label", (labelClass, labelClass /= "")]} for={optionId}>{optionLabel}</label>|]
styledTextareaFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<textarea
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
>{fieldValue}</textarea>{validationResult}{helpText}|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
styledValidationResult :: CSSFramework -> FormField -> Blaze.Html
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult CSSFramework
cssFramework formField :: FormField
formField@FormField { validatorResult :: FormField -> Maybe Violation
validatorResult = Just Violation
violation } =
let
Text
className :: Text = CSSFramework
cssFramework.styledValidationResultClass
message :: MarkupM ()
message = case Violation
violation of
TextViolation Text
text -> [hsx|{text}|]
HtmlViolation Text
html -> Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
Blaze.preEscapedToHtml Text
html
in
[hsx|<div class={className}>{message}</div>|]
styledValidationResult CSSFramework
_ FormField
_ = MarkupM ()
forall a. Monoid a => a
mempty
styledValidationResultClass :: Text
styledValidationResultClass = Text
""
styledSubmitButton :: r -> SubmitButton -> MarkupM ()
styledSubmitButton r
cssFramework SubmitButton { MarkupM ()
label :: MarkupM ()
label :: SubmitButton -> MarkupM ()
label, Text
buttonClass :: Text
buttonClass :: SubmitButton -> Text
buttonClass, Bool
buttonDisabled :: Bool
buttonDisabled :: SubmitButton -> Bool
buttonDisabled } =
let Text
className :: Text = r
cssFramework.styledSubmitButtonClass
in [hsx|<button class={classes [(className, True), (buttonClass, not (null buttonClass))]} disabled={buttonDisabled} type="submit">{label}</button>|]
styledInputClass :: p -> p -> a
styledInputClass p
_ p
_ = a
""
styledInputInvalidClass :: p -> p -> a
styledInputInvalidClass p
_ p
_ = a
"invalid"
styledFormGroupClass :: Text
styledFormGroupClass = Text
""
styledFormFieldHelp :: p -> FormField -> MarkupM ()
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = MarkupM ()
forall a. Monoid a => a
mempty
styledFormFieldHelp p
_ FormField { Text
helpText :: FormField -> Text
helpText :: Text
helpText } = [hsx|<p>{helpText}</p>|]
styledSubmitButtonClass :: Text
styledSubmitButtonClass = Text
""
styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
styledPagination :: CSSFramework -> PaginationView -> MarkupM ()
styledPagination CSSFramework
_ PaginationView
paginationView =
[hsx|
<div class="d-flex justify-content-md-center">
<nav aria-label="Page Navigator" class="mr-2">
<ul class="pagination">
{paginationView.linkPrevious}
{paginationView.pageDotDotItems}
{paginationView.linkNext}
</ul>
</nav>
<div class="form-row">
<div class="col-auto mr-2">
<select class="custom-select" id="maxItemsSelect" onchange="window.location.href = this.options[this.selectedIndex].dataset.url">
{paginationView.itemsPerPageSelector}
</select>
</div>
</div>
</div>
|]
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Blaze.Html
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Int
currentPage :: Pagination -> Int
currentPage} ByteString
pageUrl Int
pageNumber =
let
linkClass :: Text
linkClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"active", Int
pageNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
currentPage)]
in
[hsx|<li class={linkClass}><a class="page-link" href={pageUrl}>{show pageNumber}</a></li>|]
styledPaginationDotDot :: CSSFramework -> Pagination -> Blaze.Html
styledPaginationDotDot :: CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot CSSFramework
_ Pagination
_ =
[hsx|<li class="page-item"><a class="page-link">…</a></li>|]
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Blaze.Html
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
pageSize :: Int
pageSize :: Pagination -> Int
pageSize} Int -> ByteString
itemsPerPageUrl =
let
oneOption :: Int -> Blaze.Html
oneOption :: Int -> MarkupM ()
oneOption Int
n = [hsx|<option value={show n} selected={n == pageSize} data-url={itemsPerPageUrl n}>{n} items per page</option>|]
in
[hsx|{forEach [10,20,50,100,200] oneOption}|]
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
prevClass :: Text
prevClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasPreviousPage Pagination
pagination)]
url :: ByteString
url = if Pagination -> Bool
hasPreviousPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<li class={prevClass}>
<a class="page-link" href={url} aria-label="Previous">
<span aria-hidden="true">«</span>
<span class="sr-only">Previous</span>
</a>
</li>
|]
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
nextClass :: Text
nextClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasNextPage Pagination
pagination)]
url :: ByteString
url = if Pagination -> Bool
hasNextPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<li class={nextClass}>
<a class="page-link" href={url} aria-label="Next">
<span aria-hidden="true">»</span>
<span class="sr-only">Next</span>
</a>
</li>
|]
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem]-> BreadcrumbsView -> Blaze.Html
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb CSSFramework
_ [BreadcrumbItem]
_ BreadcrumbsView
breadcrumbsView = [hsx|
<nav>
<ol class="breadcrumb">
{breadcrumbsView.breadcrumbItems}
</ol>
</nav>
|]
styledBreadcrumbItem :: CSSFramework -> [ BreadcrumbItem ]-> BreadcrumbItem -> Bool -> Blaze.Html
styledBreadcrumbItem :: CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem CSSFramework
_ [BreadcrumbItem]
breadcrumbItems breadcrumbItem :: BreadcrumbItem
breadcrumbItem@BreadcrumbItem {MarkupM ()
breadcrumbLabel :: MarkupM ()
breadcrumbLabel :: BreadcrumbItem -> MarkupM ()
breadcrumbLabel, Maybe Text
url :: Maybe Text
url :: BreadcrumbItem -> Maybe Text
url} Bool
isLast =
let
breadcrumbsClasses :: Text
breadcrumbsClasses = [(Text, Bool)] -> Text
classes [(Text, Bool)
"breadcrumb-item", (Text
"active", Bool
isLast)]
in
case Maybe Text
url of
Maybe Text
Nothing -> [hsx|<li class={breadcrumbsClasses}>{breadcrumbLabel}</li>|]
Just Text
url -> [hsx|<li class={breadcrumbsClasses}><a href={url}>{breadcrumbLabel}</a></li>|]
bootstrap :: CSSFramework
bootstrap :: CSSFramework
bootstrap = CSSFramework
forall a. Default a => a
def
{ styledFlashMessage
, styledSubmitButtonClass
, styledFormGroupClass
, styledFormFieldHelp
, styledInputClass
, styledInputInvalidClass
, styledValidationResultClass
}
where
styledFlashMessage :: p -> FlashMessage -> MarkupM ()
styledFlashMessage p
_ (SuccessFlashMessage Text
message) = [hsx|<div class="alert alert-success">{message}</div>|]
styledFlashMessage p
_ (ErrorFlashMessage Text
message) = [hsx|<div class="alert alert-danger">{message}</div>|]
styledInputClass :: p -> FormField -> a
styledInputClass p
_ FormField { fieldType :: FormField -> InputType
fieldType = InputType
FileInput } = a
"form-control-file"
styledInputClass p
_ FormField {} = a
"form-control"
styledInputInvalidClass :: p -> p -> a
styledInputInvalidClass p
_ p
_ = a
"is-invalid"
styledFormFieldHelp :: p -> FormField -> MarkupM ()
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = MarkupM ()
forall a. Monoid a => a
mempty
styledFormFieldHelp p
_ FormField { Text
helpText :: FormField -> Text
helpText :: Text
helpText } = [hsx|<small class="form-text">{helpText}</small>|]
styledFormGroupClass :: Text
styledFormGroupClass = Text
"mb-3"
styledValidationResultClass :: Text
styledValidationResultClass = Text
"invalid-feedback"
styledSubmitButtonClass :: Text
styledSubmitButtonClass = Text
"btn btn-primary"
bootstrap4 :: CSSFramework
bootstrap4 :: CSSFramework
bootstrap4 = CSSFramework
forall a. Default a => a
def
{ styledFlashMessage
, styledFormField
, styledTextFormField
, styledTextareaFormField
, styledCheckboxFormField
, styledSelectFormField
, styledFormGroup
, styledSubmitButton
, styledSubmitButtonClass
, styledFormFieldHelp
, styledInputClass
, styledInputInvalidClass
, styledFormGroupClass
, styledValidationResult
, styledValidationResultClass
, styledPagination
, styledPaginationPageLink
, styledPaginationDotDot
, styledPaginationItemsPerPageSelector
, styledPaginationLinkPrevious
, styledPaginationLinkNext
, styledBreadcrumb
, styledBreadcrumbItem
}
where
styledFlashMessage :: p -> FlashMessage -> MarkupM ()
styledFlashMessage p
_ (SuccessFlashMessage Text
message) = [hsx|<div class="alert alert-success">{message}</div>|]
styledFlashMessage p
_ (ErrorFlashMessage Text
message) = [hsx|<div class="alert alert-danger">{message}</div>|]
styledInputClass :: p -> FormField -> a
styledInputClass p
_ FormField { fieldType :: FormField -> InputType
fieldType = InputType
FileInput } = a
"form-control-file"
styledInputClass p
_ FormField {} = a
"form-control"
styledInputInvalidClass :: p -> p -> a
styledInputInvalidClass p
_ p
_ = a
"is-invalid"
styledFormFieldHelp :: p -> FormField -> MarkupM ()
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = MarkupM ()
forall a. Monoid a => a
mempty
styledFormFieldHelp p
_ FormField { Text
helpText :: FormField -> Text
helpText :: Text
helpText } = [hsx|<small class="form-text text-muted">{helpText}</small>|]
styledFormGroupClass :: Text
styledFormGroupClass = Text
"form-group"
styledValidationResultClass :: Text
styledValidationResultClass = Text
"invalid-feedback"
styledSubmitButtonClass :: Text
styledSubmitButtonClass = Text
"btn btn-primary"
styledFormField :: CSSFramework -> FormField -> Blaze.Html
styledFormField :: CSSFramework -> FormField -> MarkupM ()
styledFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult, CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework
-> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField, CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework
-> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField} FormField
formField =
MarkupM () -> MarkupM ()
formGroup MarkupM ()
renderInner
where
renderInner :: MarkupM ()
renderInner = case FormField
formField.fieldType of
InputType
TextInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"text" FormField
formField MarkupM ()
validationResult
InputType
NumberInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"number" FormField
formField MarkupM ()
validationResult
InputType
PasswordInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"password" FormField
formField MarkupM ()
validationResult
InputType
ColorInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"color" FormField
formField MarkupM ()
validationResult
InputType
EmailInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"email" FormField
formField MarkupM ()
validationResult
InputType
DateInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"date" FormField
formField MarkupM ()
validationResult
InputType
DateTimeInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"datetime-local" FormField
formField MarkupM ()
validationResult
InputType
CheckboxInput -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
InputType
HiddenInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"hidden" FormField
formField { disableLabel = True, disableGroup = True, disableValidationResult = True } MarkupM ()
validationResult
InputType
TextareaInput -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
SelectInput {} -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
RadioInput {} -> CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField CSSFramework
cssFramework FormField
formField MarkupM ()
validationResult
InputType
FileInput -> CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField CSSFramework
cssFramework Text
"file" FormField
formField MarkupM ()
validationResult
validationResult :: Blaze.Html
validationResult :: MarkupM ()
validationResult = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless FormField
formField.disableValidationResult (CSSFramework -> FormField -> MarkupM ()
styledValidationResult CSSFramework
cssFramework FormField
formField)
formGroup :: Blaze.Html -> Blaze.Html
formGroup :: MarkupM () -> MarkupM ()
formGroup MarkupM ()
renderInner = case FormField
formField of
FormField { disableGroup :: FormField -> Bool
disableGroup = Bool
True } -> MarkupM ()
renderInner
FormField { Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId } -> CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup CSSFramework
cssFramework Text
fieldInputId MarkupM ()
renderInner
styledFormGroup :: CSSFramework -> Text -> Blaze.Html -> Blaze.Html
styledFormGroup :: CSSFramework -> Text -> MarkupM () -> MarkupM ()
styledFormGroup cssFramework :: CSSFramework
cssFramework@CSSFramework {Text
styledFormGroupClass :: CSSFramework -> Text
styledFormGroupClass :: Text
styledFormGroupClass} Text
fieldInputId MarkupM ()
renderInner =
[hsx|<div class={styledFormGroupClass} id={"form-group-" <> fieldInputId}>{renderInner}</div>|]
styledCheckboxFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult = do
[hsx|<div class="form-check">{element}</div>|]
where
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
theInput :: MarkupM ()
theInput = [hsx|
<input
type="checkbox"
name={fieldName}
class={classes ["form-check-input", (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
id={fieldInputId}
checked={fieldValue == "yes"}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
<input type="hidden" name={fieldName} value={inputValue False} />
|]
element :: MarkupM ()
element = if Bool
disableLabel
then [hsx|<div>
{theInput}
{validationResult}
{helpText}
</div>
|]
else [hsx|
{theInput}
<label
class={classes [("form-check-label", labelClass == ""), (labelClass, labelClass /= "")]}
for={fieldInputId}
>
{fieldLabel}
</label>
{validationResult}
{helpText}
|]
styledTextFormField :: CSSFramework -> Text -> FormField -> Blaze.Html -> Blaze.Html
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} Text
inputType formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<input
type={inputType}
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={maybeValue}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={labelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
maybeValue :: Maybe Text
maybeValue = if Text
fieldValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldValue
styledSelectFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<select
name={fieldName}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={fieldValue}
disabled={disabled}
required={required}
autofocus={autofocus}
{...additionalAttributes}
>
<option selected={not isValueSelected} disabled={True}>{placeholder}</option>
{forEach (options fieldType) (getOption)}
</select>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={labelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
isValueSelected :: Bool
isValueSelected = ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
_, Text
optionValue) -> Text
optionValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldValue) (InputType -> [(Text, Text)]
options InputType
fieldType)
getOption :: (Text, Text) -> MarkupM ()
getOption (Text
optionLabel, Text
optionValue) = [hsx|
<option value={optionValue} selected={optionValue == fieldValue}>
{optionLabel}
</option>
|]
styledTextareaFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<textarea
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
>{fieldValue}</textarea>{validationResult}{helpText}|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={labelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
styledValidationResult :: CSSFramework -> FormField -> Blaze.Html
styledValidationResult :: CSSFramework -> FormField -> MarkupM ()
styledValidationResult CSSFramework
cssFramework formField :: FormField
formField@FormField { validatorResult :: FormField -> Maybe Violation
validatorResult = Just Violation
violation } =
let
Text
className :: Text = CSSFramework
cssFramework.styledValidationResultClass
message :: MarkupM ()
message = case Violation
violation of
TextViolation Text
text -> [hsx|{text}|]
HtmlViolation Text
html -> Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
Blaze.preEscapedToHtml Text
html
in
[hsx|<div class={className}>{message}</div>|]
styledValidationResult CSSFramework
_ FormField
_ = MarkupM ()
forall a. Monoid a => a
mempty
styledSubmitButton :: r -> SubmitButton -> MarkupM ()
styledSubmitButton r
cssFramework SubmitButton { MarkupM ()
label :: SubmitButton -> MarkupM ()
label :: MarkupM ()
label, Text
buttonClass :: SubmitButton -> Text
buttonClass :: Text
buttonClass, Bool
buttonDisabled :: SubmitButton -> Bool
buttonDisabled :: Bool
buttonDisabled } =
let Text
className :: Text = r
cssFramework.styledSubmitButtonClass
in [hsx|<button class={classes [(className, True), (buttonClass, not (null buttonClass))]} disabled={buttonDisabled} type="submit">{label}</button>|]
styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
styledPagination :: CSSFramework -> PaginationView -> MarkupM ()
styledPagination CSSFramework
_ PaginationView
paginationView =
[hsx|
<div class="d-flex justify-content-md-center">
<nav aria-label="Page Navigator" class="mr-2">
<ul class="pagination">
{paginationView.linkPrevious}
{paginationView.pageDotDotItems}
{paginationView.linkNext}
</ul>
</nav>
<div class="form-row">
<div class="col-auto mr-2">
<select class="custom-select" id="maxItemsSelect" onchange="window.location.href = this.options[this.selectedIndex].dataset.url">
{paginationView.itemsPerPageSelector}
</select>
</div>
</div>
</div>
|]
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Blaze.Html
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl Int
pageNumber =
let
linkClass :: Text
linkClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"active", Int
pageNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
currentPage)]
in
[hsx|<li class={linkClass}><a class="page-link" href={pageUrl}>{show pageNumber}</a></li>|]
styledPaginationDotDot :: CSSFramework -> Pagination -> Blaze.Html
styledPaginationDotDot :: CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot CSSFramework
_ Pagination
_ =
[hsx|<li class="page-item"><a class="page-link">…</a></li>|]
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Blaze.Html
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
pageSize :: Pagination -> Int
pageSize :: Int
pageSize} Int -> ByteString
itemsPerPageUrl =
let
oneOption :: Int -> Blaze.Html
oneOption :: Int -> MarkupM ()
oneOption Int
n = [hsx|<option value={show n} selected={n == pageSize} data-url={itemsPerPageUrl n}>{n} items per page</option>|]
in
[hsx|{forEach [10,20,50,100,200] oneOption}|]
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
prevClass :: Text
prevClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasPreviousPage Pagination
pagination)]
url :: ByteString
url = if Pagination -> Bool
hasPreviousPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<li class={prevClass}>
<a class="page-link" href={url} aria-label="Previous">
<span aria-hidden="true">«</span>
<span class="sr-only">Previous</span>
</a>
</li>
|]
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
nextClass :: Text
nextClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"page-item", (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasNextPage Pagination
pagination)]
url :: ByteString
url = if Pagination -> Bool
hasNextPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<li class={nextClass}>
<a class="page-link" href={url} aria-label="Next">
<span aria-hidden="true">»</span>
<span class="sr-only">Next</span>
</a>
</li>
|]
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem]-> BreadcrumbsView -> Blaze.Html
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb CSSFramework
_ [BreadcrumbItem]
_ BreadcrumbsView
breadcrumbsView = [hsx|
<nav>
<ol class="breadcrumb">
{breadcrumbsView.breadcrumbItems}
</ol>
</nav>
|]
styledBreadcrumbItem :: CSSFramework -> [ BreadcrumbItem ]-> BreadcrumbItem -> Bool -> Blaze.Html
styledBreadcrumbItem :: CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem CSSFramework
_ [BreadcrumbItem]
breadcrumbItems breadcrumbItem :: BreadcrumbItem
breadcrumbItem@BreadcrumbItem {MarkupM ()
breadcrumbLabel :: BreadcrumbItem -> MarkupM ()
breadcrumbLabel :: MarkupM ()
breadcrumbLabel, Maybe Text
url :: BreadcrumbItem -> Maybe Text
url :: Maybe Text
url} Bool
isLast =
let
breadcrumbsClasses :: Text
breadcrumbsClasses = [(Text, Bool)] -> Text
classes [(Text, Bool)
"breadcrumb-item", (Text
"active", Bool
isLast)]
in
case Maybe Text
url of
Maybe Text
Nothing -> [hsx|<li class={breadcrumbsClasses}>{breadcrumbLabel}</li>|]
Just Text
url -> [hsx|<li class={breadcrumbsClasses}><a href={url}>{breadcrumbLabel}</a></li>|]
tailwind :: CSSFramework
tailwind :: CSSFramework
tailwind = CSSFramework
forall a. Default a => a
def
{ styledFlashMessage
, styledTextFormField
, styledTextareaFormField
, styledCheckboxFormField
, styledSelectFormField
, styledRadioFormField
, styledSubmitButtonClass
, styledFormGroupClass
, styledFormFieldHelp
, styledInputClass
, styledInputInvalidClass
, styledValidationResultClass
, styledPagination
, styledPaginationLinkPrevious
, styledPaginationLinkNext
, styledPaginationPageLink
, styledPaginationDotDot
, styledPaginationItemsPerPageSelector
, styledBreadcrumb
, styledBreadcrumbItem
}
where
styledFlashMessage :: p -> FlashMessage -> MarkupM ()
styledFlashMessage p
_ (SuccessFlashMessage Text
message) = [hsx|<div class="bg-green-100 border border-green-500 text-green-900 px-4 py-3 rounded relative">{message}</div>|]
styledFlashMessage p
_ (ErrorFlashMessage Text
message) = [hsx|<div class="bg-red-100 border border-red-400 text-red-700 px-4 py-3 rounded relative">{message}</div>|]
styledCheckboxFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledCheckboxFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledCheckboxFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult = do
[hsx|<div class="form-check">{element}</div>|]
where
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
theInput :: MarkupM ()
theInput = [hsx|
<div>
<input
type="checkbox"
name={fieldName}
class={classes ["form-check-input", (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
id={fieldInputId}
checked={fieldValue == "yes"}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
<input type="hidden" name={fieldName} value={inputValue False} />
</div>
|]
element :: MarkupM ()
element = if Bool
disableLabel
then [hsx|<div class="flex flex-row space-x-2">
{theInput}
<div class="flex flex-col space-y-2">
{validationResult}
{helpText}
</div>
</div>
|]
else [hsx|
<div class="flex flex-row space-x-2">
{theInput}
<div class="flex flex-col">
<label
class={classes ["font-medium text-gray-700", ("form-check-label", labelClass == ""), (labelClass, labelClass /= "")]}
for={fieldInputId}
>
{fieldLabel}
</label>
{validationResult}
{helpText}
</div>
</div>
|]
styledTextFormField :: CSSFramework -> Text -> FormField -> Blaze.Html -> Blaze.Html
styledTextFormField :: CSSFramework -> Text -> FormField -> MarkupM () -> MarkupM ()
styledTextFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} Text
inputType formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<input
type={inputType}
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={maybeValue}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
/>
{validationResult}
{helpText}
|]
where
twLabelClass :: Text
twLabelClass = Text
"font-medium text-gray-700" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelClass
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={twLabelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
maybeValue :: Maybe Text
maybeValue = if Text
fieldValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldValue
styledTextareaFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledTextareaFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledTextareaFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<textarea
name={fieldName}
placeholder={placeholder}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
required={required}
disabled={disabled}
autofocus={autofocus}
{...additionalAttributes}
>{fieldValue}</textarea>{validationResult}{helpText}
|]
where
twLabelClass :: Text
twLabelClass = [(Text, Bool)] -> Text
classes [(Text, Bool)
"font-medium text-gray-700", (Text
labelClass, Bool -> Bool
not (Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
labelClass))]
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
disableLabel Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
fieldLabel) [hsx|<label class={twLabelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
styledSelectFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledSelectFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledSelectFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<select
name={fieldName}
id={fieldInputId}
class={classes [inputClass, (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
value={fieldValue}
disabled={disabled}
required={required}
autofocus={autofocus}
{...additionalAttributes}
>
<option selected={not isValueSelected} disabled={True}>{placeholder}</option>
{forEach (options fieldType) (getOption)}
</select>
{validationResult}
{helpText}
|]
where
twLabelClass :: Text
twLabelClass = Text
"font-medium text-gray-700" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelClass
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={twLabelClass} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
isValueSelected :: Bool
isValueSelected = ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
_, Text
optionValue) -> Text
optionValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldValue) (InputType -> [(Text, Text)]
options InputType
fieldType)
getOption :: (Text, Text) -> MarkupM ()
getOption (Text
optionLabel, Text
optionValue) = [hsx|
<option value={optionValue} selected={optionValue == fieldValue}>
{optionLabel}
</option>
|]
styledRadioFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
styledRadioFormField :: CSSFramework -> FormField -> MarkupM () -> MarkupM ()
styledRadioFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputClass :: CSSFramework -> FormField -> Text
styledInputClass, CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp :: CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: FormField -> Text
placeholder :: Text
placeholder, Text
fieldLabel :: FormField -> Text
fieldLabel :: Text
fieldLabel, Text
fieldValue :: FormField -> Text
fieldValue :: Text
fieldValue, Text
fieldInputId :: FormField -> Text
fieldInputId :: Text
fieldInputId, Maybe Violation
validatorResult :: FormField -> Maybe Violation
validatorResult :: Maybe Violation
validatorResult, Text
fieldClass :: FormField -> Text
fieldClass :: Text
fieldClass, Bool
disabled :: FormField -> Bool
disabled :: Bool
disabled, Bool
disableLabel :: FormField -> Bool
disableLabel :: Bool
disableLabel, Bool
disableValidationResult :: FormField -> Bool
disableValidationResult :: Bool
disableValidationResult, [(Text, Text)]
additionalAttributes :: FormField -> [(Text, Text)]
additionalAttributes :: [(Text, Text)]
additionalAttributes, Text
labelClass :: FormField -> Text
labelClass :: Text
labelClass, Bool
required :: FormField -> Bool
required :: Bool
required, Bool
autofocus :: FormField -> Bool
autofocus :: Bool
autofocus } MarkupM ()
validationResult =
[hsx|
{label}
<fieldset
class={classes ["flex flex-col gap-2", (inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
autofocus={autofocus}
{...additionalAttributes}
>
{forEach (options fieldType) (getRadio)}
</fieldset>
{validationResult}
{helpText}
|]
where
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
inputClass :: (Text, Bool)
inputClass = (CSSFramework -> FormField -> Text
styledInputClass CSSFramework
cssFramework FormField
formField, Bool
True)
inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
helpText :: MarkupM ()
helpText = CSSFramework -> FormField -> MarkupM ()
styledFormFieldHelp CSSFramework
cssFramework FormField
formField
getRadio :: (Text, Text) -> MarkupM ()
getRadio (Text
optionLabel, Text
optionValue) = [hsx|
<div class="flex flex-row gap-2 items-center">
<input
class={classes [(inputInvalidClass, isJust validatorResult), (fieldClass, not (null fieldClass))]}
type="radio"
id={optionId}
name={fieldName}
value={optionValue}
checked={optionValue == fieldValue}
disabled={disabled}
required={required}
autofocus={autofocus}
{...additionalAttributes}
/>
{label}
</div>
|]
where
optionId :: Text
optionId = Text
fieldInputId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
optionValue
label :: MarkupM ()
label = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-label", (labelClass, labelClass /= "")]} for={optionId}>{optionLabel}</label>|]
styledInputClass :: p -> FormField -> a
styledInputClass p
_ FormField {} = a
"focus:ring-blue-500 focus:border-blue-500 block w-full border-gray-300 rounded-md"
styledInputInvalidClass :: p -> p -> a
styledInputInvalidClass p
_ p
_ = a
"is-invalid"
styledSubmitButtonClass :: Text
styledSubmitButtonClass = Text
"bg-blue-500 hover:bg-blue-700 text-white font-bold py-2 px-4 rounded"
styledFormFieldHelp :: p -> FormField -> MarkupM ()
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = MarkupM ()
forall a. Monoid a => a
mempty
styledFormFieldHelp p
_ FormField { Text
helpText :: FormField -> Text
helpText :: Text
helpText } = [hsx|<p class="text-gray-600 text-xs italic">{helpText}</p>|]
styledFormGroupClass :: Text
styledFormGroupClass = Text
"flex flex-col my-6 space-y-2"
styledValidationResultClass :: Text
styledValidationResultClass = Text
"text-red-500 text-xs italic"
styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
styledPagination :: CSSFramework -> PaginationView -> MarkupM ()
styledPagination CSSFramework
_ paginationView :: PaginationView
paginationView@PaginationView {Int -> ByteString
pageUrl :: Int -> ByteString
pageUrl :: PaginationView -> Int -> ByteString
pageUrl, Pagination
pagination :: Pagination
pagination :: PaginationView -> Pagination
pagination} =
let
currentPage :: Int
currentPage = Pagination
pagination.currentPage
previousPageUrl :: ByteString
previousPageUrl = if Pagination -> Bool
hasPreviousPage Pagination
pagination then Int -> ByteString
pageUrl (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
currentPage Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else ByteString
"#"
nextPageUrl :: ByteString
nextPageUrl = if Pagination -> Bool
hasNextPage Pagination
pagination then Int -> ByteString
pageUrl (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
currentPage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else ByteString
"#"
defaultClass :: (Text, Bool)
defaultClass = (Text, Bool)
"relative inline-flex items-center px-4 py-2 border border-gray-300 text-sm font-medium rounded-md text-gray-700 bg-white hover:bg-gray-50"
previousClass :: Text
previousClass = [(Text, Bool)] -> Text
classes
[ (Text, Bool)
defaultClass
, (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasPreviousPage Pagination
pagination)
]
nextClass :: Text
nextClass = [(Text, Bool)] -> Text
classes
[ (Text, Bool)
defaultClass
, (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasNextPage Pagination
pagination)
]
previousMobileOnly :: MarkupM ()
previousMobileOnly =
[hsx|
<a href={previousPageUrl} class={previousClass}>
Previous
</a>
|]
nextMobileOnly :: MarkupM ()
nextMobileOnly =
[hsx|
<a href={nextPageUrl} class={nextClass}>
Next
</a>
|]
in
[hsx|
<div class="bg-white px-4 py-3 flex items-center justify-between border-t border-gray-200 sm:px-6">
<div class="flex-1 flex justify-between sm:hidden">
{previousMobileOnly}
{nextMobileOnly}
</div>
<div class="hidden sm:flex-1 sm:flex sm:items-center sm:justify-between">
<div class="text-sm text-gray-700">
<select class="px-4 py-3" id="maxItemsSelect" onchange="window.location.href = this.options[this.selectedIndex].dataset.url">
{paginationView.itemsPerPageSelector}
</select>
</div>
<div>
<nav class="relative z-0 inline-flex rounded-md shadow-sm -space-x-px" aria-label="Pagination">
{paginationView.linkPrevious}
{paginationView.pageDotDotItems}
{paginationView.linkNext}
</nav>
</div>
</div>
</div>
|]
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkPrevious CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
prevClass :: Text
prevClass = [(Text, Bool)] -> Text
classes
[ (Text, Bool)
"relative inline-flex items-center px-2 py-2 rounded-l-md border border-gray-300 bg-white text-sm font-medium text-gray-500 hover:bg-gray-50"
, (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasPreviousPage Pagination
pagination)
]
url :: ByteString
url = if Pagination -> Bool
hasPreviousPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<a href={url} class={prevClass}>
<span class="sr-only">Previous</span>
<!-- Heroicon name: solid/chevron-left -->
<svg class="h-5 w-5" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 20 20" fill="currentColor" aria-hidden="true">
<path fill-rule="evenodd" d="M12.707 5.293a1 1 0 010 1.414L9.414 10l3.293 3.293a1 1 0 01-1.414 1.414l-4-4a1 1 0 010-1.414l4-4a1 1 0 011.414 0z" clip-rule="evenodd" />
</svg>
</a>
|]
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> MarkupM ()
styledPaginationLinkNext CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl =
let
nextClass :: Text
nextClass = [(Text, Bool)] -> Text
classes
[ (Text, Bool)
"relative inline-flex items-center px-2 py-2 rounded-r-md border border-gray-300 bg-white text-sm font-medium text-gray-500 hover:bg-gray-50"
, (Text
"disabled", Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pagination -> Bool
hasNextPage Pagination
pagination)
]
url :: ByteString
url = if Pagination -> Bool
hasNextPage Pagination
pagination then ByteString
pageUrl else ByteString
"#"
in
[hsx|
<a href={url} class={nextClass}>
<span class="sr-only">Next</span>
<!-- Heroicon name: solid/chevron-right -->
<svg class="h-5 w-5" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 20 20" fill="currentColor" aria-hidden="true">
<path fill-rule="evenodd" d="M7.293 14.707a1 1 0 010-1.414L10.586 10 7.293 6.707a1 1 0 011.414-1.414l4 4a1 1 0 010 1.414l-4 4a1 1 0 01-1.414 0z" clip-rule="evenodd" />
</svg>
</a>
|]
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Blaze.Html
styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> MarkupM ()
styledPaginationPageLink CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
currentPage :: Pagination -> Int
currentPage :: Int
currentPage} ByteString
pageUrl Int
pageNumber =
let
linkClass :: Text
linkClass = [(Text, Bool)] -> Text
classes
[ (Text, Bool)
"relative inline-flex items-center px-4 py-2 border text-sm font-medium"
, (Text
"z-10 bg-blue-50 border-blue-500 text-blue-600", Int
pageNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
currentPage)
, (Text
"bg-white border-gray-300 text-gray-500 hover:bg-gray-50", Int
pageNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
currentPage)
]
in
[hsx|
<a href={pageUrl} aria-current={pageNumber == currentPage} class={linkClass}>
{show pageNumber}
</a>
|]
styledPaginationDotDot :: CSSFramework -> Pagination -> Blaze.Html
styledPaginationDotDot :: CSSFramework -> Pagination -> MarkupM ()
styledPaginationDotDot CSSFramework
_ Pagination
_ =
[hsx|
<span class="relative inline-flex items-center px-4 py-2 border border-gray-300 bg-white text-sm font-medium text-gray-700">
...
</span>
|]
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Blaze.Html
styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> MarkupM ()
styledPaginationItemsPerPageSelector CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
pageSize :: Pagination -> Int
pageSize :: Int
pageSize} Int -> ByteString
itemsPerPageUrl =
let
oneOption :: Int -> Blaze.Html
oneOption :: Int -> MarkupM ()
oneOption Int
n = [hsx|<option value={show n} selected={n == pageSize} data-url={itemsPerPageUrl n}>{n} items per page</option>|]
in
[hsx|{forEach [10,20,50,100,200] oneOption}|]
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem]-> BreadcrumbsView -> Blaze.Html
styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> MarkupM ()
styledBreadcrumb CSSFramework
_ [BreadcrumbItem]
_ BreadcrumbsView
breadcrumbsView = [hsx|
<nav class="breadcrumbs bg-white my-4" aria-label="Breadcrumb">
<ol class="flex items-center space-x-2" role="list">
{breadcrumbsView.breadcrumbItems}
</ol>
</nav>
|]
styledBreadcrumbItem :: CSSFramework -> [ BreadcrumbItem ]-> BreadcrumbItem -> Bool -> Blaze.Html
styledBreadcrumbItem :: CSSFramework
-> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> MarkupM ()
styledBreadcrumbItem CSSFramework
_ [BreadcrumbItem]
breadcrumbItems breadcrumbItem :: BreadcrumbItem
breadcrumbItem@BreadcrumbItem {MarkupM ()
breadcrumbLabel :: BreadcrumbItem -> MarkupM ()
breadcrumbLabel :: MarkupM ()
breadcrumbLabel, Maybe Text
url :: BreadcrumbItem -> Maybe Text
url :: Maybe Text
url} Bool
isLast =
let
breadcrumbsClasses :: Text
breadcrumbsClasses = [(Text, Bool)] -> Text
classes [(Text, Bool)
"flex flex-row space-x-2 text-gray-600 items-center", (Text
"active", Bool
isLast)]
chevronRight :: MarkupM ()
chevronRight = Bool -> MarkupM () -> MarkupM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isLast [hsx|
<!-- heroicons.com chevron-right -->
<svg xmlns="http://www.w3.org/2000/svg" class="flex-shrink-0 h-4 w-4 text-gray-500" fill="none" viewBox="0 0 24 24" stroke="currentColor">
<path stroke-linecap="round" stroke-linejoin="round" stroke-width="2" d="M9 5l7 7-7 7" />
</svg>
|]
in
case Maybe Text
url of
Maybe Text
Nothing -> [hsx|
<li class={breadcrumbsClasses}>
{breadcrumbLabel}
{chevronRight}
</li>
|]
Just Text
url -> [hsx|
<li class={breadcrumbsClasses}>
<a class="hover:text-gray-700" href={url}>{breadcrumbLabel}</a>
{chevronRight}
</li>
|]