{-|
Module: IHP.View.CSSFramework.Bootstrap
Description: Bootstrap CSS framework implementations
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.View.CSSFramework.Bootstrap (bootstrap, bootstrap4, bootstrapBase) where

import Prelude hiding (null)
import Data.Text (null)
import Data.ByteString (ByteString)
import Data.Maybe (isJust)
import Control.Monad (unless)
import IHP.HaskellSupport (forEach)
import IHP.InputValue (inputValue)
import IHP.HSX.Markup (Html)
import IHP.HSX.MarkupQQ (hsx)
import IHP.View.Types
import IHP.View.Classes
import IHP.Breadcrumb.Types
import IHP.Pagination.Helpers
import IHP.Pagination.Types
import Network.Wai.Middleware.FlashMessages (FlashMessage (..))
import IHP.View.CSSFramework.Unstyled (unstyled)

-- | Shared Bootstrap rendering used by both 'bootstrap' and 'bootstrap4'
bootstrapBase :: CSSFramework
bootstrapBase :: CSSFramework
bootstrapBase = CSSFramework
unstyled
    { styledFlashMessage
    , styledInputClass
    , styledInputInvalidClass
    , styledValidationResultClass
    , styledSubmitButtonClass
    , styledCheckboxFormField
    , styledRadioFormField
    , styledPaginationPageLink
    , styledPaginationDotDot
    , styledPaginationItemsPerPageSelector
    , styledBreadcrumb
    , styledBreadcrumbItem
    }
    where
        styledFlashMessage :: p -> FlashMessage -> Html
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"

        styledValidationResultClass :: Text
styledValidationResultClass = Text
"invalid-feedback"
        styledSubmitButtonClass :: Text
styledSubmitButtonClass = Text
"btn btn-primary"

        styledCheckboxFormField :: CSSFramework -> FormField -> Html -> Html
        styledCheckboxFormField :: CSSFramework -> FormField -> Html -> Html
styledCheckboxFormField cssFramework :: CSSFramework
cssFramework@CSSFramework {CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> CSSFramework -> FormField -> Text
styledInputInvalidClass :: CSSFramework -> FormField -> Text
styledInputInvalidClass, CSSFramework -> FormField -> Html
styledFormFieldHelp :: CSSFramework -> FormField -> Html
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> Html
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: 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 :: Text
fieldInputId :: FormField -> 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 } Html
validationResult = do
            [hsx|<div class="form-check">{element}</div>|]
            where
                inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
                helpText :: Html
helpText = CSSFramework -> FormField -> Html
styledFormFieldHelp CSSFramework
cssFramework FormField
formField

                theInput :: Html
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 :: Html
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}
                        |]

        styledRadioFormField :: CSSFramework -> FormField -> Html -> Html
        styledRadioFormField :: CSSFramework -> FormField -> Html -> Html
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 -> Html
styledFormFieldHelp :: CSSFramework -> CSSFramework -> FormField -> Html
styledFormFieldHelp :: CSSFramework -> FormField -> Html
styledFormFieldHelp} formField :: FormField
formField@FormField {InputType
fieldType :: FormField -> InputType
fieldType :: InputType
fieldType, Text
fieldName :: FormField -> Text
fieldName :: Text
fieldName, Text
placeholder :: Text
placeholder :: FormField -> 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 } Html
validationResult =
            [hsx|
                {label}
                <fieldset>
                    {forEach (options fieldType) (getRadio)}
                </fieldset>

                {validationResult}
                {helpText}
            |]
            where
                label :: Html
label = Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes [(cssFramework.styledLabelClass, True), (labelClass, labelClass /= "")]} for={fieldInputId}>{fieldLabel}</label>|]
                inputInvalidClass :: Text
inputInvalidClass = CSSFramework -> FormField -> Text
styledInputInvalidClass CSSFramework
cssFramework FormField
formField
                helpText :: Html
helpText = CSSFramework -> FormField -> Html
styledFormFieldHelp CSSFramework
cssFramework FormField
formField

                getRadio :: (Text, Text) -> Html
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}
                        />
                        {radioLabel}
                    </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
                        radioLabel :: Html
radioLabel = Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disableLabel [hsx|<label class={classes ["form-check-label", (labelClass, labelClass /= "")]} for={optionId}>{optionLabel}</label>|]

        styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Html
        styledPaginationPageLink :: CSSFramework -> Pagination -> ByteString -> Int -> Html
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 -> Html
        styledPaginationDotDot :: CSSFramework -> Pagination -> Html
styledPaginationDotDot CSSFramework
_ Pagination
_ =
            [hsx|<li class="page-item"><a class="page-link">…</a></li>|]

        styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Html
        styledPaginationItemsPerPageSelector :: CSSFramework -> Pagination -> (Int -> ByteString) -> Html
styledPaginationItemsPerPageSelector CSSFramework
_ pagination :: Pagination
pagination@Pagination {Int
pageSize :: Int
pageSize :: Pagination -> Int
pageSize} Int -> ByteString
itemsPerPageUrl =
            let
                oneOption :: Int -> Html
                oneOption :: Int -> Html
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 -> Html
        styledBreadcrumb :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbsView -> Html
styledBreadcrumb CSSFramework
_ [BreadcrumbItem]
_ BreadcrumbsView
breadcrumbsView = [hsx|
            <nav>
                <ol class="breadcrumb">
                    {breadcrumbsView.breadcrumbItems}

                </ol>
            </nav>
        |]

        styledBreadcrumbItem :: CSSFramework -> [ BreadcrumbItem ]-> BreadcrumbItem -> Bool -> Html
        styledBreadcrumbItem :: CSSFramework -> [BreadcrumbItem] -> BreadcrumbItem -> Bool -> Html
styledBreadcrumbItem CSSFramework
_ [BreadcrumbItem]
breadcrumbItems breadcrumbItem :: BreadcrumbItem
breadcrumbItem@BreadcrumbItem {Html
breadcrumbLabel :: Html
breadcrumbLabel :: BreadcrumbItem -> Html
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
bootstrapBase
    { styledLabelClass
    , styledFormGroupClass
    , styledFormFieldHelp
    , styledPagination
    , styledPaginationLinkPrevious
    , styledPaginationLinkNext
    }
    where
        styledLabelClass :: Text
styledLabelClass = Text
"form-label"
        styledFormGroupClass :: Text
styledFormGroupClass = Text
"mb-3"

        styledFormFieldHelp :: p -> FormField -> Html
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = Html
forall a. Monoid a => a
mempty
        styledFormFieldHelp p
_ FormField { Text
helpText :: FormField -> Text
helpText :: Text
helpText } = [hsx|<small class="form-text">{helpText}</small>|]

        styledPagination :: CSSFramework -> PaginationView -> Html
        styledPagination :: CSSFramework -> PaginationView -> Html
styledPagination CSSFramework
_ PaginationView
paginationView =
            [hsx|

            <div class="d-flex justify-content-md-center">
                <nav aria-label="Page Navigator" class="me-2">
                    <ul class="pagination">
                        {paginationView.linkPrevious}
                        {paginationView.pageDotDotItems}
                        {paginationView.linkNext}
                    </ul>
                </nav>

                <div class="row">
                    <div class="col-auto me-2">
                        <select class="form-select" id="maxItemsSelect" onchange="window.location.href = this.options[this.selectedIndex].dataset.url">
                            {paginationView.itemsPerPageSelector}
                        </select>
                    </div>
                </div>

            </div>
            |]

        styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Html
        styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Html
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">&laquo;</span>
                            <span class="visually-hidden">Previous</span>
                        </a>
                    </li>
                |]

        styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Html
        styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Html
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">&raquo;</span>
                            <span class="visually-hidden">Next</span>
                        </a>
                    </li>
                |]

bootstrap4 :: CSSFramework
bootstrap4 :: CSSFramework
bootstrap4 = CSSFramework
bootstrapBase
    { styledFormGroupClass
    , styledFormFieldHelp
    , styledPagination
    , styledPaginationLinkPrevious
    , styledPaginationLinkNext
    }
    where
        styledFormGroupClass :: Text
styledFormGroupClass = Text
"form-group"

        styledFormFieldHelp :: p -> FormField -> Html
styledFormFieldHelp p
_ FormField { helpText :: FormField -> Text
helpText = Text
"" } = Html
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>|]

        styledPagination :: CSSFramework -> PaginationView -> Html
        styledPagination :: CSSFramework -> PaginationView -> Html
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>
            |]

        styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Html
        styledPaginationLinkPrevious :: CSSFramework -> Pagination -> ByteString -> Html
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">&laquo;</span>
                            <span class="sr-only">Previous</span>
                        </a>
                    </li>
                |]

        styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Html
        styledPaginationLinkNext :: CSSFramework -> Pagination -> ByteString -> Html
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">&raquo;</span>
                            <span class="sr-only">Next</span>
                        </a>
                    </li>
                |]