{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}

-- | Common web page input elements, often with bootstrap scaffolding.
module Web.Rep.Html.Input
  ( Input (..),
    InputType (..),
  )
where

import Data.Bool
import Data.Maybe
import Data.Text (Text, pack, split)
import GHC.Generics
import Lucid
import Lucid.Base
import Web.Rep.Html

-- | something that might exist on a web page and be a front-end input to computations.
data Input a = Input
  { -- | underlying value
    Input a -> a
inputVal :: a,
    -- | label suggestion
    Input a -> Maybe Text
inputLabel :: Maybe Text,
    -- | name//key//id of the Input
    Input a -> Text
inputId :: Text,
    -- | type of html input
    Input a -> InputType
inputType :: InputType
  }
  deriving (Input a -> Input a -> Bool
(Input a -> Input a -> Bool)
-> (Input a -> Input a -> Bool) -> Eq (Input a)
forall a. Eq a => Input a -> Input a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input a -> Input a -> Bool
$c/= :: forall a. Eq a => Input a -> Input a -> Bool
== :: Input a -> Input a -> Bool
$c== :: forall a. Eq a => Input a -> Input a -> Bool
Eq, Int -> Input a -> ShowS
[Input a] -> ShowS
Input a -> String
(Int -> Input a -> ShowS)
-> (Input a -> String) -> ([Input a] -> ShowS) -> Show (Input a)
forall a. Show a => Int -> Input a -> ShowS
forall a. Show a => [Input a] -> ShowS
forall a. Show a => Input a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input a] -> ShowS
$cshowList :: forall a. Show a => [Input a] -> ShowS
show :: Input a -> String
$cshow :: forall a. Show a => Input a -> String
showsPrec :: Int -> Input a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Input a -> ShowS
Show, (forall x. Input a -> Rep (Input a) x)
-> (forall x. Rep (Input a) x -> Input a) -> Generic (Input a)
forall x. Rep (Input a) x -> Input a
forall x. Input a -> Rep (Input a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Input a) x -> Input a
forall a x. Input a -> Rep (Input a) x
$cto :: forall a x. Rep (Input a) x -> Input a
$cfrom :: forall a x. Input a -> Rep (Input a) x
Generic)

-- | Various types of web page inputs, encapsulating practical bootstrap class functionality
data InputType
  = Slider [Attribute]
  | TextBox
  | TextBox'
  | TextArea Int
  | ColorPicker
  | ChooseFile
  | Dropdown [Text]
  | DropdownMultiple [Text] Char
  | DropdownSum [Text]
  | Datalist [Text] Text
  | Checkbox Bool
  | Toggle Bool (Maybe Text)
  | Button
  deriving (InputType -> InputType -> Bool
(InputType -> InputType -> Bool)
-> (InputType -> InputType -> Bool) -> Eq InputType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputType -> InputType -> Bool
$c/= :: InputType -> InputType -> Bool
== :: InputType -> InputType -> Bool
$c== :: InputType -> InputType -> Bool
Eq, Int -> InputType -> ShowS
[InputType] -> ShowS
InputType -> String
(Int -> InputType -> ShowS)
-> (InputType -> String)
-> ([InputType] -> ShowS)
-> Show InputType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputType] -> ShowS
$cshowList :: [InputType] -> ShowS
show :: InputType -> String
$cshow :: InputType -> String
showsPrec :: Int -> InputType -> ShowS
$cshowsPrec :: Int -> InputType -> ShowS
Show, (forall x. InputType -> Rep InputType x)
-> (forall x. Rep InputType x -> InputType) -> Generic InputType
forall x. Rep InputType x -> InputType
forall x. InputType -> Rep InputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputType x -> InputType
$cfrom :: forall x. InputType -> Rep InputType x
Generic)

instance (ToHtml a) => ToHtml (Input a) where
  toHtml :: Input a -> HtmlT m ()
toHtml (Input a
v Maybe Text
l Text
i (Slider [Attribute]
satts)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            ( [ Text -> Attribute
type_ Text
"range",
                Text -> Attribute
class__ Text
" form-control-range form-control-sm custom-range jsbClassEventChange",
                Text -> Attribute
id_ Text
i,
                Text -> Attribute
value_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> String
forall a. Show a => a -> String
show (HtmlT Identity () -> String) -> HtmlT Identity () -> String
forall a b. (a -> b) -> a -> b
$ a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
v)
              ]
                [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
satts
            )
      )
  toHtml (Input a
v Maybe Text
l Text
i InputType
TextBox) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            [ Text -> Attribute
type_ Text
"text",
              Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput",
              Text -> Attribute
id_ Text
i,
              Text -> Attribute
value_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> String
forall a. Show a => a -> String
show (HtmlT Identity () -> String) -> HtmlT Identity () -> String
forall a b. (a -> b) -> a -> b
$ a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw a
v)
            ]
      )
  toHtml (Input a
v Maybe Text
l Text
i InputType
TextBox') =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            [ Text -> Attribute
type_ Text
"text",
              Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventFocusout",
              Text -> Attribute
id_ Text
i,
              Text -> Attribute
value_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> String
forall a. Show a => a -> String
show (HtmlT Identity () -> String) -> HtmlT Identity () -> String
forall a b. (a -> b) -> a -> b
$ a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw a
v)
            ]
      )
  toHtml (Input a
v Maybe Text
l Text
i (TextArea Int
rows)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
            HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
textarea_
            [ Text -> Attribute
rows_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
rows),
              Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput",
              Text -> Attribute
id_ Text
i
            ]
            (a -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw a
v)
      )
  toHtml (Input a
v Maybe Text
l Text
i InputType
ColorPicker) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            [ Text -> Attribute
type_ Text
"color",
              Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput",
              Text -> Attribute
id_ Text
i,
              Text -> Attribute
value_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> String
forall a. Show a => a -> String
show (HtmlT Identity () -> String) -> HtmlT Identity () -> String
forall a b. (a -> b) -> a -> b
$ a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
v)
            ]
      )
  toHtml (Input a
_ Maybe Text
l Text
i InputType
ChooseFile) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      (HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l)
      HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
        [ Text -> Attribute
type_ Text
"file",
          Text -> Attribute
class__ Text
"form-control-file form-control-sm jsbClassEventChooseFile",
          Text -> Attribute
id_ Text
i
        ]
  toHtml (Input a
v Maybe Text
l Text
i (Dropdown [Text]
opts)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
            HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
select_
            [ Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput",
              Text -> Attribute
id_ Text
i
            ]
            HtmlT m ()
opts'
      )
    where
      opts' :: HtmlT m ()
opts' =
        [HtmlT m ()] -> HtmlT m ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT m ()] -> HtmlT m ()) -> [HtmlT m ()] -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$
          ( \Text
o ->
              (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
                HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
option_
                ( [Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool
                    []
                    [Text -> Attribute
selected_ Text
"selected"]
                    (HtmlT Identity () -> Text
forall a. Html a -> Text
toText (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlT Identity () -> Text
forall a. Html a -> Text
toText (a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
v))
                )
                (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o)
          )
            (Text -> HtmlT m ()) -> [Text] -> [HtmlT m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
opts
  toHtml (Input a
vs Maybe Text
l Text
i (DropdownMultiple [Text]
opts Char
sep)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
            HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
select_
            [ Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventChangeMultiple",
              Text -> Attribute
multiple_ Text
"multiple",
              Text -> Attribute
id_ Text
i
            ]
            HtmlT m ()
opts'
      )
    where
      opts' :: HtmlT m ()
opts' =
        [HtmlT m ()] -> HtmlT m ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT m ()] -> HtmlT m ()) -> [HtmlT m ()] -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$
          ( \Text
o ->
              (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
                HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
option_
                ( [Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool
                    []
                    [Text -> Attribute
selected_ Text
"selected"]
                    ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
v -> HtmlT Identity () -> Text
forall a. Html a -> Text
toText (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlT Identity () -> Text
forall a. Html a -> Text
toText (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
v)) ((Char -> Bool) -> Text -> [Text]
Data.Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep) (HtmlT Identity () -> Text
forall a. Html a -> Text
toText (a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
vs))))
                )
                (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o)
          )
            (Text -> HtmlT m ()) -> [Text] -> [HtmlT m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
opts
  toHtml (Input a
v Maybe Text
l Text
i (DropdownSum [Text]
opts)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm sumtype-group"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
            HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
select_
            [ Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput jsbClassEventShowSum",
              Text -> Attribute
id_ Text
i
            ]
            HtmlT m ()
opts'
      )
    where
      opts' :: HtmlT m ()
opts' =
        [HtmlT m ()] -> HtmlT m ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT m ()] -> HtmlT m ()) -> [HtmlT m ()] -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$
          ( \Text
o ->
              (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
                HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
option_
                ([Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool [] [Text -> Attribute
selected_ Text
"selected"] (HtmlT Identity () -> Text
forall a. Html a -> Text
toText (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlT Identity () -> Text
forall a. Html a -> Text
toText (a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
v)))
                (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o)
          )
            (Text -> HtmlT m ()) -> [Text] -> [HtmlT m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
opts
  toHtml (Input a
v Maybe Text
l Text
i (Datalist [Text]
opts Text
listId)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            [ Text -> Attribute
type_ Text
"text",
              Text -> Attribute
class__ Text
"form-control form-control-sm jsbClassEventInput",
              Text -> Attribute
id_ Text
i,
              Text -> Attribute
list_ Text
listId
              -- the datalist concept in html assumes initial state is a null
              -- and doesn't present the list if it has a value alreadyx
              -- , value_ (show $ toHtml v)
            ]
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
            HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
datalist_
            [Text -> Attribute
id_ Text
listId]
            ( [HtmlT m ()] -> HtmlT m ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT m ()] -> HtmlT m ()) -> [HtmlT m ()] -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$
                ( \Text
o ->
                    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
                      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
option_
                      ( [Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool
                          []
                          [Text -> Attribute
selected_ Text
"selected"]
                          (HtmlT Identity () -> Text
forall a. Html a -> Text
toText (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== HtmlT Identity () -> Text
forall a. Html a -> Text
toText (a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml a
v))
                      )
                      (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
o)
                )
                  (Text -> HtmlT m ()) -> [Text] -> [HtmlT m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
opts
            )
      )
  -- FIXME: How can you refactor to eliminate this polymorphic wart?
  toHtml (Input a
_ Maybe Text
l Text
i (Checkbox Bool
checked)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-check form-check-sm"]
      ( [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
          ( [ Text -> Attribute
type_ Text
"checkbox",
              Text -> Attribute
class__ Text
"form-check-input jsbClassEventCheckbox",
              Text -> Attribute
id_ Text
i
            ]
              [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool [] [Attribute
checked_] Bool
checked
          )
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"form-check-label mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
      )
  toHtml (Input a
_ Maybe Text
l Text
i (Toggle Bool
pushed Maybe Text
lab)) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( HtmlT m () -> (Text -> HtmlT m ()) -> Maybe Text -> HtmlT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT m ()
forall a. Monoid a => a
mempty ((HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
for_ Text
i, Text -> Attribute
class__ Text
"mb-0"] (HtmlT m () -> HtmlT m ())
-> (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
l
          HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
            ( [ Text -> Attribute
type_ Text
"button",
                Text -> Attribute
class__ Text
"btn btn-primary btn-sm jsbClassEventToggle",
                Text -> Text -> Attribute
data_ Text
"toggle" Text
"button",
                Text -> Attribute
id_ Text
i,
                Text -> Text -> Attribute
makeAttribute Text
"aria-pressed" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
pushed)
              ]
                [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> (Text -> [Attribute]) -> Maybe Text -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
l' -> [Text -> Attribute
value_ Text
l']) Maybe Text
lab
                [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute] -> [Attribute] -> Bool -> [Attribute]
forall a. a -> a -> Bool -> a
bool [] [Attribute
checked_] Bool
pushed
            )
      )
  toHtml (Input a
_ Maybe Text
l Text
i InputType
Button) =
    (HtmlT m () -> HtmlT m ())
-> [Attribute] -> HtmlT m () -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
with
      HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"form-group-sm"]
      ( [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_
          [ Text -> Attribute
type_ Text
"button",
            Text -> Attribute
id_ Text
i,
            Text -> Attribute
class__ Text
"btn btn-primary btn-sm jsbClassEventButton",
            Text -> Attribute
value_ (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"button" Maybe Text
l)
          ]
      )

  toHtmlRaw :: Input a -> HtmlT m ()
toHtmlRaw = Input a -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml