Classless CustomCSSFramework for IHP

CustomCSSFramework.hs

module Web.View.CustomCSSFramework (customMissing) where

import IHP.View.CSSFramework -- This is the only import not copied from IHP/View/CSSFramework.hs
import IHP.Prelude
import IHP.FlashMessages.Types
import qualified Text.Blaze.Html5 as Blaze
import Text.Blaze.Html.Renderer.Text (renderHtml)
import IHP.HSX.QQ (hsx)
import IHP.HSX.ToHtml ()
import IHP.View.Types
import IHP.View.Classes

import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5 ((!), (!?))
import qualified Text.Blaze.Html5.Attributes as A
import IHP.ModelSupport
import IHP.Breadcrumb.Types
import IHP.Pagination.Helpers
import IHP.Pagination.Types
import IHP.View.Types (PaginationView(linkPrevious, pagination))

customMissing :: CSSFramework
customMissing = def
    { styledFlashMessage
    , styledTextFormField
    , styledTextareaFormField
    , styledCheckboxFormField
    , styledSelectFormField
    , styledSubmitButtonClass
    , styledFormGroup
    , styledFormGroupClass
    , styledFormFieldHelp
    , styledInputClass
    , styledInputInvalidClass
    , styledValidationResultClass
    , styledPagination
    , styledPaginationLinkPrevious
    , styledPaginationLinkNext
    , styledPaginationPageLink
    , styledPaginationDotDot
    , styledPaginationItemsPerPageSelector
    , styledBreadcrumb
    , styledBreadcrumbItem
    }
    where
        styledFlashMessage _ (SuccessFlashMessage message) = 
            [hsx|
            <div class="box ok flash">
                <strong class="block titlebar">
                    Success
                </strong>
                {message}
            </div>
            |]
        styledFlashMessage _ (ErrorFlashMessage message) = 
            [hsx|
            <div class="box bad flash">
                <strong class="block titlebar">
                    Error
                </strong>
                {message}
            </div>
            |]

        styledCheckboxFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
        styledCheckboxFormField cssFramework@CSSFramework {styledInputInvalidClass, styledFormFieldHelp} formField@FormField {fieldType, fieldName, fieldLabel, fieldValue, fieldInputId, validatorResult, fieldClass, disabled, disableLabel, disableValidationResult, additionalAttributes, labelClass, required, autofocus } validationResult = do
            [hsx|{element}|]
            where
                inputInvalidClass = styledInputInvalidClass cssFramework formField
                helpText = styledFormFieldHelp cssFramework formField

                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 = if disableLabel
                    then [hsx|
                        <span>
                            {theInput}
                            {validationResult}
                            {helpText}
                        </span>
                        |]
                    else [hsx|
                        <label for={fieldInputId}>
                            {fieldLabel}
                        </label>
                        <span>
                            {theInput}
                            {validationResult}
                            {helpText}
                        </span>
                        |]

        styledTextFormField :: CSSFramework -> Text -> FormField -> Blaze.Html -> Blaze.Html
        styledTextFormField cssFramework@CSSFramework {styledInputClass, styledInputInvalidClass, styledFormFieldHelp} inputType formField@FormField {fieldType, fieldName, fieldLabel, fieldValue, fieldInputId, validatorResult, fieldClass, disabled, disableLabel, disableValidationResult, additionalAttributes, labelClass, placeholder, required, autofocus } validationResult =
            [hsx|
                {label}
                <span>
                    <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}
                </span>
            |]
            where
                label = unless (disableLabel || null fieldLabel) [hsx|<label class={labelClass} for={fieldInputId}>{fieldLabel}</label>|]
                inputClass = (styledInputClass cssFramework formField, True)
                inputInvalidClass = styledInputInvalidClass cssFramework formField
                helpText = styledFormFieldHelp cssFramework formField
                -- If there's no value, then we want to hide the "value" attribute.
                maybeValue = if fieldValue == "" then Nothing else Just fieldValue


        styledTextareaFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
        styledTextareaFormField cssFramework@CSSFramework {styledInputClass, styledInputInvalidClass, styledFormFieldHelp} formField@FormField {fieldType, fieldName, fieldLabel, fieldValue, fieldInputId, validatorResult, fieldClass, disabled, disableLabel, disableValidationResult, additionalAttributes, labelClass, placeholder, required, autofocus } validationResult =
            [hsx|
            {label}
            {helpText}
            <span>
                <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}
            </span>
            |]
            where
                
                label = unless (disableLabel || null fieldLabel) [hsx|<label for={fieldInputId}>{fieldLabel}</label>|]
                inputClass = (styledInputClass cssFramework formField, True)
                inputInvalidClass = styledInputInvalidClass cssFramework formField
                helpText = styledFormFieldHelp cssFramework formField


        styledSelectFormField :: CSSFramework -> FormField -> Blaze.Html -> Blaze.Html
        styledSelectFormField cssFramework@CSSFramework {styledInputClass, styledInputInvalidClass, styledFormFieldHelp} formField@FormField {fieldType, fieldName, placeholder, fieldLabel, fieldValue, fieldInputId, validatorResult, fieldClass, disabled, disableLabel, disableValidationResult, additionalAttributes, labelClass, required, autofocus } 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}
            |]
            where
                label = unless disableLabel [hsx|<label class={labelClass} for={fieldInputId}>{fieldLabel}</label>|]
                inputClass = (styledInputClass cssFramework formField, True)
                inputInvalidClass = styledInputInvalidClass cssFramework formField
                helpText = styledFormFieldHelp cssFramework formField

                isValueSelected = any (\(_, optionValue) -> optionValue == fieldValue) (options fieldType)

                -- Get a single option.
                getOption (optionLabel, optionValue) = [hsx|
                <option value={optionValue} selected={optionValue == fieldValue}>
                    {optionLabel}
                </option>
                |]


        styledInputClass _ FormField {} = "block"
        styledInputInvalidClass _ _ = "bad border"

        styledSubmitButtonClass = ""

        styledFormFieldHelp _ FormField { helpText = "" } = mempty
        styledFormFieldHelp _ FormField { helpText } = [hsx|<small class="info color">{helpText}</small>|]

        styledFormGroup :: CSSFramework -> Text -> Blaze.Html -> Blaze.Html
        styledFormGroup cssFramework@CSSFramework {styledFormGroupClass} fieldInputId renderInner =
                [hsx|{renderInner}|]

        styledFormGroupClass = ""

        styledValidationResultClass = "bad color"

        styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
        styledPagination _ paginationView@PaginationView {pageUrl, pagination} =
            let
                currentPage = pagination.currentPage
                previousPageUrl = if hasPreviousPage pagination then pageUrl $ currentPage - 1 else "#"
                nextPageUrl = if hasNextPage pagination then pageUrl $ currentPage + 1 else "#"
            in
            [hsx|
            <section>
                <nav class="justify-content:space-between f-row margin-block-start" aria-label="Pagination">
                    {paginationView.linkPrevious}
                    <div class="f-row">{paginationView.pageDotDotItems}</div>
                    {paginationView.linkNext}
                </nav>
                <select 
                    class="margin-block-start margin-block-end"
                    id="maxItemsSelect"
                    onchange="window.location.href = this.options[this.selectedIndex].dataset.url"
                >
                    {paginationView.itemsPerPageSelector}
                </select>
            </section>
            |]

        styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
        styledPaginationLinkPrevious _ pagination@Pagination {currentPage} pageUrl =
                [hsx|
                <a class="<button>" href={if hasPreviousPage pagination then pageUrl else "#"} >
                    <span>Previous</span>
                </a>
                |]

        styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Blaze.Html
        styledPaginationLinkNext _ pagination@Pagination {currentPage} pageUrl =
                [hsx|
                <a class="<button>"href={if hasNextPage pagination then pageUrl else "#"}>
                    <span>Next</span>
                </a>
                |]

        styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Blaze.Html
        styledPaginationPageLink _ pagination@Pagination {currentPage} pageUrl pageNumber =
                [hsx|
                <a href={pageUrl} aria-current={pageNumber == currentPage} class={if pageNumber == currentPage then "bold" else "" :: Text}>
                    {show pageNumber}
                </a>
                |]


        styledPaginationDotDot :: CSSFramework -> Pagination -> Blaze.Html
        styledPaginationDotDot _ _ =
            [hsx|
            <span>
                ...
            </span>
            |]


        styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Blaze.Html
        styledPaginationItemsPerPageSelector _ pagination@Pagination {pageSize} itemsPerPageUrl =
            let
                oneOption :: Int -> Blaze.Html
                oneOption 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 _ _ breadcrumbsView = [hsx|
        <nav class="breadcrumbs" aria-label="Breadcrumb">
            <ol role="list">
                {breadcrumbsView.breadcrumbItems}
            </ol>
        </nav>
        |]


        styledBreadcrumbItem :: CSSFramework -> [ BreadcrumbItem ]-> BreadcrumbItem -> Bool -> Blaze.Html
        styledBreadcrumbItem _ breadcrumbItems breadcrumbItem@BreadcrumbItem {breadcrumbLabel, url} isLast =
            case url of
                Nothing ->  [hsx|
                <li>
                    {breadcrumbLabel}
                </li>
                |]
                Just url -> [hsx|
                <li>
                    <a href={url}>{breadcrumbLabel}</a>
                </li>
                |]