{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

-- | this program based on Yesod.Form.Bootstrap3 of yesod-form
-- yesod-form under MIT license, author is Michael Snoyman <michael@snoyman.com>

module Yesod.Form.Bootstrap4
  ( renderBootstrap4
  , BootstrapFormLayout(..)
  , BootstrapGridOptions(..)
  , bfs
  , bfsFile
  , withPlaceholder
  , withAutofocus
  , withLargeInput
  , withSmallInput
  , bootstrapSubmit
  , mbootstrapSubmit
  , BootstrapSubmit(..)
  ) where

import           Control.Arrow                 (second)
import           Data.String                   (IsString (..))
import           Data.Text                     (Text)
import qualified Data.Text.Lazy                as TL
import           Text.Blaze.Html.Renderer.Text
import           Yesod.Core
import           Yesod.Form

bfs :: RenderMessage site msg => msg -> FieldSettings site
bfs :: forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfs msg
msg
  = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings (forall master msg.
RenderMessage master msg =>
msg -> SomeMessage master
SomeMessage msg
msg) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing [(Text
"class", Text
"form-control")]

bfsFile :: RenderMessage site msg => msg -> FieldSettings site
bfsFile :: forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfsFile msg
msg
  = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings (forall master msg.
RenderMessage master msg =>
msg -> SomeMessage master
SomeMessage msg
msg) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing [(Text
"class", Text
"form-control-file")]

withPlaceholder :: Text -> FieldSettings site -> FieldSettings site
withPlaceholder :: forall site. Text -> FieldSettings site -> FieldSettings site
withPlaceholder Text
placeholder FieldSettings site
fs = FieldSettings site
fs { fsAttrs :: [(Text, Text)]
fsAttrs = [(Text, Text)]
newAttrs }
  where newAttrs :: [(Text, Text)]
newAttrs = (Text
"placeholder", Text
placeholder) forall a. a -> [a] -> [a]
: forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
fs

-- | Add an autofocus attribute to a field.
withAutofocus :: FieldSettings site -> FieldSettings site
withAutofocus :: forall site. FieldSettings site -> FieldSettings site
withAutofocus FieldSettings site
fs = FieldSettings site
fs { fsAttrs :: [(Text, Text)]
fsAttrs = [(Text, Text)]
newAttrs }
  where newAttrs :: [(Text, Text)]
newAttrs = (Text
"autofocus", Text
"autofocus") forall a. a -> [a] -> [a]
: forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
fs

-- | Add the @input-lg@ CSS class to a field.
withLargeInput :: FieldSettings site -> FieldSettings site
withLargeInput :: forall site. FieldSettings site -> FieldSettings site
withLargeInput FieldSettings site
fs = FieldSettings site
fs { fsAttrs :: [(Text, Text)]
fsAttrs = [(Text, Text)]
newAttrs }
  where newAttrs :: [(Text, Text)]
newAttrs = Text -> [(Text, Text)] -> [(Text, Text)]
addClass Text
"form-control-lg" (forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
fs)

-- | Add the @input-sm@ CSS class to a field.
withSmallInput :: FieldSettings site -> FieldSettings site
withSmallInput :: forall site. FieldSettings site -> FieldSettings site
withSmallInput FieldSettings site
fs = FieldSettings site
fs { fsAttrs :: [(Text, Text)]
fsAttrs = [(Text, Text)]
newAttrs }
  where newAttrs :: [(Text, Text)]
newAttrs = Text -> [(Text, Text)] -> [(Text, Text)]
addClass Text
"form-control-sm" (forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
fs)

data BootstrapGridOptions = ColXs !Int | ColSm !Int | ColMd !Int | ColLg !Int | ColXl !Int
  deriving (BootstrapGridOptions -> BootstrapGridOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c/= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
== :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c== :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
Eq, Eq BootstrapGridOptions
BootstrapGridOptions -> BootstrapGridOptions -> Bool
BootstrapGridOptions -> BootstrapGridOptions -> Ordering
BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
$cmin :: BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
max :: BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
$cmax :: BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
>= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c>= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
> :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c> :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
<= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c<= :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
< :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
$c< :: BootstrapGridOptions -> BootstrapGridOptions -> Bool
compare :: BootstrapGridOptions -> BootstrapGridOptions -> Ordering
$ccompare :: BootstrapGridOptions -> BootstrapGridOptions -> Ordering
Ord, Int -> BootstrapGridOptions -> ShowS
[BootstrapGridOptions] -> ShowS
BootstrapGridOptions -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapGridOptions] -> ShowS
$cshowList :: [BootstrapGridOptions] -> ShowS
show :: BootstrapGridOptions -> [Char]
$cshow :: BootstrapGridOptions -> [Char]
showsPrec :: Int -> BootstrapGridOptions -> ShowS
$cshowsPrec :: Int -> BootstrapGridOptions -> ShowS
Show, ReadPrec [BootstrapGridOptions]
ReadPrec BootstrapGridOptions
Int -> ReadS BootstrapGridOptions
ReadS [BootstrapGridOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BootstrapGridOptions]
$creadListPrec :: ReadPrec [BootstrapGridOptions]
readPrec :: ReadPrec BootstrapGridOptions
$creadPrec :: ReadPrec BootstrapGridOptions
readList :: ReadS [BootstrapGridOptions]
$creadList :: ReadS [BootstrapGridOptions]
readsPrec :: Int -> ReadS BootstrapGridOptions
$creadsPrec :: Int -> ReadS BootstrapGridOptions
Read)

toColumn :: BootstrapGridOptions -> String
toColumn :: BootstrapGridOptions -> [Char]
toColumn (ColXs Int
columns) = [Char]
"col-xs-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toColumn (ColSm Int
columns) = [Char]
"col-sm-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toColumn (ColMd Int
columns) = [Char]
"col-md-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toColumn (ColLg Int
columns) = [Char]
"col-lg-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toColumn (ColXl Int
columns) = [Char]
"col-xl-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns

toOffset :: BootstrapGridOptions -> String
toOffset :: BootstrapGridOptions -> [Char]
toOffset (ColXs Int
columns) = [Char]
"col-xs-offset-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toOffset (ColSm Int
columns) = [Char]
"col-sm-offset-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toOffset (ColMd Int
columns) = [Char]
"col-md-offset-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toOffset (ColLg Int
columns) = [Char]
"col-lg-offset-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns
toOffset (ColXl Int
columns) = [Char]
"col-Xl-offset-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
columns

addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions
addGO :: BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
addGO (ColXs Int
a) (ColXs Int
b) = Int -> BootstrapGridOptions
ColXs (Int
aforall a. Num a => a -> a -> a
+Int
b)
addGO (ColSm Int
a) (ColSm Int
b) = Int -> BootstrapGridOptions
ColSm (Int
aforall a. Num a => a -> a -> a
+Int
b)
addGO (ColMd Int
a) (ColMd Int
b) = Int -> BootstrapGridOptions
ColMd (Int
aforall a. Num a => a -> a -> a
+Int
b)
addGO (ColLg Int
a) (ColLg Int
b) = Int -> BootstrapGridOptions
ColLg (Int
aforall a. Num a => a -> a -> a
+Int
b)
addGO BootstrapGridOptions
a BootstrapGridOptions
b                 | BootstrapGridOptions
a forall a. Ord a => a -> a -> Bool
> BootstrapGridOptions
b = BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
addGO BootstrapGridOptions
b BootstrapGridOptions
a
addGO (ColXs Int
a) BootstrapGridOptions
other     = BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
addGO (Int -> BootstrapGridOptions
ColSm Int
a) BootstrapGridOptions
other
addGO (ColSm Int
a) BootstrapGridOptions
other     = BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
addGO (Int -> BootstrapGridOptions
ColMd Int
a) BootstrapGridOptions
other
addGO (ColMd Int
a) BootstrapGridOptions
other     = BootstrapGridOptions
-> BootstrapGridOptions -> BootstrapGridOptions
addGO (Int -> BootstrapGridOptions
ColLg Int
a) BootstrapGridOptions
other
addGO BootstrapGridOptions
_     BootstrapGridOptions
_             = forall a. HasCallStack => [Char] -> a
error [Char]
"Yesod.Form.Bootstrap.addGO: never here"

-- | The layout used for the bootstrap form.
data BootstrapFormLayout = BootstrapBasicForm | BootstrapInlineForm |
  BootstrapHorizontalForm
  { BootstrapFormLayout -> BootstrapGridOptions
bflLabelOffset :: !BootstrapGridOptions
  , BootstrapFormLayout -> BootstrapGridOptions
bflLabelSize   :: !BootstrapGridOptions
  , BootstrapFormLayout -> BootstrapGridOptions
bflInputOffset :: !BootstrapGridOptions
  , BootstrapFormLayout -> BootstrapGridOptions
bflInputSize   :: !BootstrapGridOptions
  }
  deriving (BootstrapFormLayout -> BootstrapFormLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c/= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
== :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c== :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
Eq, Eq BootstrapFormLayout
BootstrapFormLayout -> BootstrapFormLayout -> Bool
BootstrapFormLayout -> BootstrapFormLayout -> Ordering
BootstrapFormLayout -> BootstrapFormLayout -> BootstrapFormLayout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BootstrapFormLayout -> BootstrapFormLayout -> BootstrapFormLayout
$cmin :: BootstrapFormLayout -> BootstrapFormLayout -> BootstrapFormLayout
max :: BootstrapFormLayout -> BootstrapFormLayout -> BootstrapFormLayout
$cmax :: BootstrapFormLayout -> BootstrapFormLayout -> BootstrapFormLayout
>= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c>= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
> :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c> :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
<= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c<= :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
< :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
$c< :: BootstrapFormLayout -> BootstrapFormLayout -> Bool
compare :: BootstrapFormLayout -> BootstrapFormLayout -> Ordering
$ccompare :: BootstrapFormLayout -> BootstrapFormLayout -> Ordering
Ord, Int -> BootstrapFormLayout -> ShowS
[BootstrapFormLayout] -> ShowS
BootstrapFormLayout -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapFormLayout] -> ShowS
$cshowList :: [BootstrapFormLayout] -> ShowS
show :: BootstrapFormLayout -> [Char]
$cshow :: BootstrapFormLayout -> [Char]
showsPrec :: Int -> BootstrapFormLayout -> ShowS
$cshowsPrec :: Int -> BootstrapFormLayout -> ShowS
Show, ReadPrec [BootstrapFormLayout]
ReadPrec BootstrapFormLayout
Int -> ReadS BootstrapFormLayout
ReadS [BootstrapFormLayout]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BootstrapFormLayout]
$creadListPrec :: ReadPrec [BootstrapFormLayout]
readPrec :: ReadPrec BootstrapFormLayout
$creadPrec :: ReadPrec BootstrapFormLayout
readList :: ReadS [BootstrapFormLayout]
$creadList :: ReadS [BootstrapFormLayout]
readsPrec :: Int -> ReadS BootstrapFormLayout
$creadsPrec :: Int -> ReadS BootstrapFormLayout
Read)

-- | Render the given form using Bootstrap v4 conventions.
renderBootstrap4 :: Monad m => BootstrapFormLayout -> FormRender m a
renderBootstrap4 :: forall (m :: * -> *) a.
Monad m =>
BootstrapFormLayout -> FormRender m a
renderBootstrap4 BootstrapFormLayout
formLayout AForm m a
aform Html
fragment = do
  (FormResult a
res, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views') <- forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm AForm m a
aform
  let views :: [FieldView (HandlerSite m)]
views = [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views' []
      widget :: WidgetFor (HandlerSite m) ()
widget = [whamlet|
#{fragment}
$forall view <- views
  $if inputTypeBoolOrCheckBox view
    ^{renderCheckInput view}
  $else
    ^{renderGroupInput view formLayout}
|]
  forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)

-- FIXME: `.form-check-input`を`input`につける方法がわからない
renderCheckInput :: FieldView site -> WidgetFor site ()
renderCheckInput :: forall site. FieldView site -> WidgetFor site ()
renderCheckInput FieldView site
view = [whamlet|
<div .form-check (fvErrors view):.is-invalid>
  ^{fvInput view}
  <label .form-check-label for=#{fvId view}>
  ^{helpWidget view}
|]

renderGroupInput :: FieldView site -> BootstrapFormLayout -> WidgetFor site ()
renderGroupInput :: forall site.
FieldView site -> BootstrapFormLayout -> WidgetFor site ()
renderGroupInput FieldView site
view BootstrapFormLayout
formLayout = [whamlet|
$case formLayout
  $of BootstrapBasicForm
    $if fvId view /= bootstrapSubmitId
      <label for=#{fvId view}>#{fvLabel view}
    ^{fvInput view}
    ^{helpWidget view}
  $of BootstrapInlineForm
    $if fvId view /= bootstrapSubmitId
      <label .sr-only for=#{fvId view}>#{fvLabel view}
    ^{fvInput view}
    ^{helpWidget view}
  $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize
    $if fvId view /= bootstrapSubmitId
      <div .row>
        <label
          .#{toOffset labelOffset}
          .#{toColumn labelSize}
          for=#{fvId view}>#{fvLabel view}
        <div .#{toOffset inputOffset} .#{toColumn inputSize}>
          ^{fvInput view}
          ^{helpWidget view}
    $else
      <div
        .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))}
        .#{toColumn inputSize}>
        ^{fvInput view}
        ^{helpWidget view}
|]

-- | 入力されたフィールドがcheck形式である必要があるか判定する
-- HTMLの内容を`Monad`の範囲で見る方法が分からなかったため,ワークアラウンドとしてlabelの内容を見て判断します
inputTypeBoolOrCheckBox :: FieldView site -> Bool
inputTypeBoolOrCheckBox :: forall site. FieldView site -> Bool
inputTypeBoolOrCheckBox FieldView{Html
fvLabel :: Html
fvLabel :: forall site. FieldView site -> Html
fvLabel}
  = let textLabel :: Text
textLabel = Html -> Text
renderHtml Html
fvLabel
    in Text
"radio" Text -> Text -> Bool
`TL.isInfixOf` Text
textLabel Bool -> Bool -> Bool
|| Text
"checkbox" Text -> Text -> Bool
`TL.isInfixOf` Text
textLabel

-- | (Internal) Render a help widget for tooltips and errors.
-- .invalid-feedbackを必ず表示する
-- bootstrap 4.1の書式ではinputがerrorでなければエラーメッセージが出ませんが
-- yesod-formのAPIではfvInput自体を弄るのが困難ですし
-- yesod-formのAPI上fvErrorsが存在する時は常にエラーメッセージは表示させるべきなので汚いやり方ですが
-- styleを上書きして常に表示します
helpWidget :: FieldView site -> WidgetFor site ()
helpWidget :: forall site. FieldView site -> WidgetFor site ()
helpWidget FieldView site
view = [whamlet|
$maybe err <- fvErrors view
  <div .invalid-feedback style="display: block;">
    #{err}
$maybe tt <- fvTooltip view
  <small .form-text .text-muted>
    #{tt}
|]

-- | How the 'bootstrapSubmit' button should be rendered.
data BootstrapSubmit msg =
  BootstrapSubmit
  { forall msg. BootstrapSubmit msg -> msg
bsValue   :: msg -- ^ The text of the submit button.
  , forall msg. BootstrapSubmit msg -> Text
bsClasses :: Text -- ^ Classes added to the @\<button>@.
  , forall msg. BootstrapSubmit msg -> [(Text, Text)]
bsAttrs   :: [(Text, Text)] -- ^ Attributes added to the @\<button>@.
  } deriving (BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
forall msg.
Eq msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c/= :: forall msg.
Eq msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
== :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c== :: forall msg.
Eq msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
Eq, BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
BootstrapSubmit msg -> BootstrapSubmit msg -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {msg}. Ord msg => Eq (BootstrapSubmit msg)
forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Ordering
forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> BootstrapSubmit msg
min :: BootstrapSubmit msg -> BootstrapSubmit msg -> BootstrapSubmit msg
$cmin :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> BootstrapSubmit msg
max :: BootstrapSubmit msg -> BootstrapSubmit msg -> BootstrapSubmit msg
$cmax :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> BootstrapSubmit msg
>= :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c>= :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
> :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c> :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
<= :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c<= :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
< :: BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
$c< :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Bool
compare :: BootstrapSubmit msg -> BootstrapSubmit msg -> Ordering
$ccompare :: forall msg.
Ord msg =>
BootstrapSubmit msg -> BootstrapSubmit msg -> Ordering
Ord, Int -> BootstrapSubmit msg -> ShowS
forall msg. Show msg => Int -> BootstrapSubmit msg -> ShowS
forall msg. Show msg => [BootstrapSubmit msg] -> ShowS
forall msg. Show msg => BootstrapSubmit msg -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapSubmit msg] -> ShowS
$cshowList :: forall msg. Show msg => [BootstrapSubmit msg] -> ShowS
show :: BootstrapSubmit msg -> [Char]
$cshow :: forall msg. Show msg => BootstrapSubmit msg -> [Char]
showsPrec :: Int -> BootstrapSubmit msg -> ShowS
$cshowsPrec :: forall msg. Show msg => Int -> BootstrapSubmit msg -> ShowS
Show, ReadPrec [BootstrapSubmit msg]
ReadPrec (BootstrapSubmit msg)
ReadS [BootstrapSubmit msg]
forall msg. Read msg => ReadPrec [BootstrapSubmit msg]
forall msg. Read msg => ReadPrec (BootstrapSubmit msg)
forall msg. Read msg => Int -> ReadS (BootstrapSubmit msg)
forall msg. Read msg => ReadS [BootstrapSubmit msg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BootstrapSubmit msg]
$creadListPrec :: forall msg. Read msg => ReadPrec [BootstrapSubmit msg]
readPrec :: ReadPrec (BootstrapSubmit msg)
$creadPrec :: forall msg. Read msg => ReadPrec (BootstrapSubmit msg)
readList :: ReadS [BootstrapSubmit msg]
$creadList :: forall msg. Read msg => ReadS [BootstrapSubmit msg]
readsPrec :: Int -> ReadS (BootstrapSubmit msg)
$creadsPrec :: forall msg. Read msg => Int -> ReadS (BootstrapSubmit msg)
Read)

instance IsString msg => IsString (BootstrapSubmit msg) where
  fromString :: [Char] -> BootstrapSubmit msg
fromString [Char]
msg = forall msg. msg -> Text -> [(Text, Text)] -> BootstrapSubmit msg
BootstrapSubmit (forall a. IsString a => [Char] -> a
fromString [Char]
msg) Text
"btn-primary" []

-- | A Bootstrap v4 submit button disguised as a field for
-- convenience.  For example, if your form currently is:
--
-- > Person <$> areq textField "Name"  Nothing
-- >    <*> areq textField "Surname" Nothing
--
-- Then just change it to:
--
-- > Person <$> areq textField "Name"  Nothing
-- >    <*> areq textField "Surname" Nothing
-- >    <*  bootstrapSubmit ("Register" :: BootstrapSubmit Text)
--
-- (Note that '<*' is not a typo.)
--
-- Alternatively, you may also just create the submit button
-- manually as well in order to have more control over its
-- layout.
bootstrapSubmit :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
  BootstrapSubmit msg -> AForm m ()
bootstrapSubmit :: forall site msg (m :: * -> *).
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
BootstrapSubmit msg -> AForm m ()
bootstrapSubmit = forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (m :: * -> *) a. Monad m => a -> m a
return) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site msg (m :: * -> *).
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit

-- | Same as 'bootstrapSubmit' but for monadic forms.  This isn't
-- as useful since you're not going to use 'renderBootstrap4'
-- anyway.
mbootstrapSubmit :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
  BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit :: forall site msg (m :: * -> *).
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit (BootstrapSubmit msg
msg Text
classes [(Text, Text)]
attrs) =
  let res :: FormResult ()
res = forall a. a -> FormResult a
FormSuccess ()
      widget :: WidgetFor site ()
widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]
      fv :: FieldView site
fv  = FieldView
            { fvLabel :: Html
fvLabel    = Html
""
            , fvTooltip :: Maybe Html
fvTooltip  = forall a. Maybe a
Nothing
            , fvId :: Text
fvId       = Text
bootstrapSubmitId
            , fvInput :: WidgetFor site ()
fvInput    = WidgetFor site ()
widget
            , fvErrors :: Maybe Html
fvErrors   = forall a. Maybe a
Nothing
            , fvRequired :: Bool
fvRequired = Bool
False
            }
  in forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult ()
res, FieldView site
fv)

-- | A royal hack.  Magic id used to identify whether a field
-- should have no label.  A valid HTML4 id which is probably not
-- going to clash with any other id should someone use
-- 'bootstrapSubmit' outside 'renderBootstrap4'.
bootstrapSubmitId :: Text
bootstrapSubmitId :: Text
bootstrapSubmitId = Text
"b:ootstrap___unique__:::::::::::::::::submit-id"