{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
module Web.Rep.Html.Input
( Input (..),
InputType (..),
)
where
import Data.Text (split)
import Lucid
import Lucid.Base
import NumHask.Prelude hiding (for_)
import Web.Rep.Html
data Input a
= Input
{
inputVal :: a,
inputLabel :: Maybe Text,
inputId :: Text,
inputType :: InputType
}
deriving (Eq, Show, Generic)
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 (Eq, Show, Generic)
instance (ToHtml a) => ToHtml (Input a) where
toHtml (Input v l i (Slider satts)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
( [ type_ "range",
class__ " form-control-range form-control-sm custom-range jsbClassEventChange",
id_ i,
value_ (pack $ show $ toHtml v)
]
<> satts
)
)
toHtml (Input v l i TextBox) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
[ type_ "text",
class__ "form-control form-control-sm jsbClassEventInput",
id_ i,
value_ (pack $ show $ toHtmlRaw v)
]
)
toHtml (Input v l i TextBox') =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
[ type_ "text",
class__ "form-control form-control-sm jsbClassEventFocusout",
id_ i,
value_ (pack $ show $ toHtmlRaw v)
]
)
toHtml (Input v l i (TextArea rows)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> with
textarea_
[ rows_ (pack $ show rows),
class__ "form-control form-control-sm jsbClassEventInput",
id_ i
]
(toHtmlRaw v)
)
toHtml (Input v l i ColorPicker) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
[ type_ "color",
class__ "form-control form-control-sm jsbClassEventInput",
id_ i,
value_ (pack $ show $ toHtml v)
]
)
toHtml (Input _ l i ChooseFile) =
with
div_
[class__ "form-group-sm"]
(maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l)
<> input_
[ type_ "file",
class__ "form-control-file form-control-sm jsbClassEventChooseFile",
id_ i
]
toHtml (Input v l i (Dropdown opts)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> with
select_
[ class__ "form-control form-control-sm jsbClassEventInput",
id_ i
]
opts'
)
where
opts' =
mconcat $
( \o ->
with
option_
( bool
[]
[selected_ "selected"]
(toText (toHtml o) == toText (toHtml v))
)
(toHtml o)
)
<$> opts
toHtml (Input vs l i (DropdownMultiple opts sep)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> with
select_
[ class__ "form-control form-control-sm jsbClassEventChangeMultiple",
multiple_ "multiple",
id_ i
]
opts'
)
where
opts' =
mconcat $
( \o ->
with
option_
( bool
[]
[selected_ "selected"]
(any (\v -> toText (toHtml o) == toText (toHtml v)) (split (== sep) (toText (toHtml vs))))
)
(toHtml o)
)
<$> opts
toHtml (Input v l i (DropdownSum opts)) =
with
div_
[class__ "form-group-sm sumtype-group"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> with
select_
[ class__ "form-control form-control-sm jsbClassEventInput jsbClassEventShowSum",
id_ i
]
opts'
)
where
opts' =
mconcat $
( \o ->
with
option_
(bool [] [selected_ "selected"] (toText (toHtml o) == toText (toHtml v)))
(toHtml o)
)
<$> opts
toHtml (Input v l i (Datalist opts listId)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
[ type_ "text",
class__ "form-control form-control-sm jsbClassEventInput",
id_ i,
list_ listId
]
<> with
datalist_
[id_ listId]
( mconcat $
( \o ->
with
option_
( bool
[]
[selected_ "selected"]
(toText (toHtml o) == toText (toHtml v))
)
(toHtml o)
)
<$> opts
)
)
toHtml (Input _ l i (Checkbox checked)) =
with
div_
[class__ "form-check form-check-sm"]
( input_
( [ type_ "checkbox",
class__ "form-check-input jsbClassEventCheckbox",
id_ i
]
<> bool [] [checked_] checked
)
<> maybe mempty (with label_ [for_ i, class__ "form-check-label mb-0"] . toHtml) l
)
toHtml (Input _ l i (Toggle pushed lab)) =
with
div_
[class__ "form-group-sm"]
( maybe mempty (with label_ [for_ i, class__ "mb-0"] . toHtml) l
<> input_
( [ type_ "button",
class__ "btn btn-primary btn-sm jsbClassEventToggle",
data_ "toggle" "button",
id_ i,
makeAttribute "aria-pressed" (bool "false" "true" pushed)
]
<> maybe [] (\l' -> [value_ l']) lab
<> bool [] [checked_] pushed
)
)
toHtml (Input _ l i Button) =
with
div_
[class__ "form-group-sm"]
( input_
[ type_ "button",
id_ i,
class__ "btn btn-primary btn-sm jsbClassEventButton",
value_ (fromMaybe "button" l)
]
)
toHtmlRaw = toHtml