module Element.Input exposing
( button
, checkbox, defaultCheckbox
, text, Placeholder, placeholder
, username, newPassword, currentPassword, email, search, spellChecked
, multiline
, slider, Thumb, thumb, defaultThumb
, radio, radioRow, Option, option, optionWith, OptionState(..)
, Label, labelAbove, labelBelow, labelLeft, labelRight, labelHidden
, focusedOnLoad
)
{-|
@docs button
@docs checkbox, defaultCheckbox
## Text Input
@docs text, Placeholder, placeholder
We can also give a hint about what type of content our text field contains. This will allow things like autofill to work correctly.
@docs username, newPassword, currentPassword, email, search, spellChecked
## Multiline Text
@docs multiline
## Slider
@docs slider, Thumb, thumb, defaultThumb
## Radio Buttons
@docs radio, radioRow, Option, option, optionWith, OptionState
## Labels
@docs Label, labelAbove, labelBelow, labelLeft, labelRight, labelHidden
@docs focusedOnLoad
-}
import Element exposing (Attribute, Color, Element)
import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Region as Region
import Html
import Html.Attributes
import Html.Events
import Internal.Flag as Flag
import Internal.Model as Internal
import Internal.Style exposing (classes)
import Json.Decode as Json
{-| -}
type Placeholder msg
= Placeholder (List (Attribute msg)) (Element msg)
white =
Element.rgb 1 1 1
darkGrey =
Element.rgb (186 / 255) (189 / 255) (182 / 255)
charcoal =
Element.rgb
(136 / 255)
(138 / 255)
(133 / 255)
{-| -}
placeholder : List (Attribute msg) -> Element msg -> Placeholder msg
placeholder =
Placeholder
type LabelLocation
= OnRight
| OnLeft
| Above
| Below
{-| Every input has a required `label`.
-}
type Label msg
= Label LabelLocation (List (Attribute msg)) (Element msg)
| HiddenLabel String
{-| -}
labelRight : List (Attribute msg) -> Element msg -> Label msg
labelRight =
Label OnRight
{-| -}
labelLeft : List (Attribute msg) -> Element msg -> Label msg
labelLeft =
Label OnLeft
{-| -}
labelAbove : List (Attribute msg) -> Element msg -> Label msg
labelAbove =
Label Above
{-| -}
labelBelow : List (Attribute msg) -> Element msg -> Label msg
labelBelow =
Label Below
{-| Sometimes you may need to have a label which is not visible, but is still accessible to screen readers.
Seriously consider a visible label before using this.
The situations where a hidden label makes sense:
- A searchbar with a `search` button right next to it.
- A `table` of inputs where the header gives the label.
Basically, a hidden label works when there are other contextual clues that sighted people can pick up on.
-}
labelHidden : String -> Label msg
labelHidden =
HiddenLabel
hiddenLabelAttribute label =
case label of
HiddenLabel textLabel ->
Internal.Describe (Internal.Label textLabel)
Label _ _ _ ->
Internal.NoAttribute
{-| A standard button.
The `onPress` handler will be fired either `onClick` or when the element is focused and the enter key has been pressed.
import Element.Input as Input
Input.button []
{ onPress = ClickMsg
, label = text "My Button"
}
`onPress` takes a `Maybe msg`. If you provide the value `Nothing`, then the button will be disabled.
-}
button :
List (Attribute msg)
->
{ onPress : Maybe msg
, label : Element msg
}
-> Element msg
button attrs { onPress, label } =
Internal.element
Internal.asEl
-- We don't explicitly label this node as a button,
-- because buttons fire a bunch of times when you hold down the enter key.
-- We'd like to fire just once on the enter key, which means using keyup instead of keydown.
-- Because we have no way to disable keydown, though our messages get doubled.
Internal.div
(Element.width Element.shrink
:: Element.height Element.shrink
:: Internal.htmlClass
(classes.contentCenterX
++ " "
++ classes.contentCenterY
++ " "
++ classes.seButton
++ " "
++ classes.noTextSelection
)
:: Element.pointer
:: focusDefault attrs
:: Internal.Describe Internal.Button
:: Internal.Attr (Html.Attributes.tabindex 0)
:: (case onPress of
Nothing ->
Internal.Attr (Html.Attributes.disabled True) :: attrs
Just msg ->
Events.onClick msg
:: onEnter msg
:: attrs
)
)
(Internal.Unkeyed [ label ])
focusDefault attrs =
if List.any hasFocusStyle attrs then
Internal.NoAttribute
else
Internal.htmlClass "focusable"
hasFocusStyle attr =
case attr of
Internal.StyleClass _ (Internal.PseudoSelector Internal.Focus _) ->
True
_ ->
False
{-| -}
type alias Checkbox msg =
{ onChange : Maybe (Bool -> msg)
, icon : Maybe (Element msg)
, checked : Bool
, label : Label msg
}
{-| -}
checkbox :
List (Attribute msg)
->
{ onChange : Bool -> msg
, icon : Bool -> Element msg
, checked : Bool
, label : Label msg
}
-> Element msg
checkbox attrs { label, icon, checked, onChange } =
let
attributes =
[ if isHiddenLabel label then
Internal.NoAttribute
else
Element.spacing
6
, Internal.Attr (Html.Events.onClick (onChange (not checked)))
, Region.announce
, onKeyLookup <|
\code ->
if code == enter then
Just <| onChange (not checked)
else if code == space then
Just <| onChange (not checked)
else
Nothing
, tabindex 0
, Element.pointer
, Element.alignLeft
, Element.width Element.fill
]
++ attrs
in
applyLabel attributes
label
(Internal.element
Internal.asEl
Internal.div
[ Internal.Attr <|
Html.Attributes.attribute "role" "checkbox"
, Internal.Attr <|
Html.Attributes.attribute "aria-checked" <|
if checked then
"true"
else
"false"
, hiddenLabelAttribute label
, Element.centerY
, Element.height Element.fill
, Element.width Element.shrink
]
(Internal.Unkeyed
[ icon checked
]
)
)
{-| -}
type Thumb
= Thumb (List (Attribute Never))
{-| -}
thumb : List (Attribute Never) -> Thumb
thumb =
Thumb
{-| -}
defaultThumb : Thumb
defaultThumb =
Thumb
[ Element.width (Element.px 16)
, Element.height (Element.px 16)
, Border.rounded 8
, Border.width 1
, Border.color (Element.rgb 0.5 0.5 0.5)
, Background.color (Element.rgb 1 1 1)
]
{-| A slider input, good for capturing float values.
Input.slider
[ Element.height (Element.px 30)
-- Here is where we're creating/styling the "track"
, Element.behindContent
(Element.el
[ Element.width Element.fill
, Element.height (Element.px 2)
, Element.centerY
, Background.color grey
, Border.rounded 2
]
Element.none
)
]
{ onChange = AdjustValue
, label = Input.labelAbove [] (text "My Slider Value")
, min = 0
, max = 75
, step = Nothing
, value = model.sliderValue
, thumb =
Input.defaultThumb
}
The `thumb` is the icon that you can move around.
The slider can be vertical or horizontal depending on the width/height of the slider.
- `height fill` and `width (px someWidth)` will cause the slider to be vertical.
- `height (px someHeight)` and `width (px someWidth)` where `someHeight` > `someWidth` will also do it.
- otherwise, the slider will be horizontal.
**Note:** If you want a slider for an `Int` value:
- set `step` to be `Just 1`, or some other whole value
- `value = toFloat model.myInt`
- And finally, round the value before making a message `onChange = round >> AdjustValue`
-}
slider :
List (Attribute msg)
->
{ onChange : Float -> msg
, label : Label msg
, min : Float
, max : Float
, value : Float
, thumb : Thumb
, step : Maybe Float
}
-> Element msg
slider attributes input =
let
(Thumb thumbAttributes) =
input.thumb
width =
Internal.getWidth thumbAttributes
height =
Internal.getHeight thumbAttributes
vertical =
case ( trackWidth, trackHeight ) of
( Nothing, Nothing ) ->
False
( Just (Internal.Px w), Just (Internal.Px h) ) ->
h > w
( Just (Internal.Px _), Just (Internal.Fill _) ) ->
True
_ ->
False
trackHeight =
Internal.getHeight attributes
trackWidth =
Internal.getWidth attributes
( spacingX, spacingY ) =
Internal.getSpacing attributes ( 5, 5 )
factor =
(input.value - input.min)
/ (input.max - input.min)
{- Needed attributes
Thumb Attributes
- Width/Height of thumb so that the input can shadow it.
Attributes
OnParent ->
Spacing
On track ->
Everything else
The ``
-}
className =
"thmb-" ++ thumbWidthString ++ "-" ++ thumbHeightString
thumbWidthString =
case width of
Nothing ->
"20px"
Just (Internal.Px px) ->
String.fromInt px ++ "px"
_ ->
"100%"
thumbHeightString =
case height of
Nothing ->
"20px"
Just (Internal.Px px) ->
String.fromInt px ++ "px"
_ ->
"100%"
thumbShadowStyle =
[ Internal.Property "width"
thumbWidthString
, Internal.Property "height"
thumbHeightString
]
in
applyLabel
[ if isHiddenLabel input.label then
Internal.NoAttribute
else
Element.spacingXY spacingX spacingY
, Region.announce
, Element.width
(case trackWidth of
Nothing ->
Element.fill
Just (Internal.Px _) ->
Element.shrink
Just x ->
x
)
, Element.height
(case trackHeight of
Nothing ->
Element.shrink
Just (Internal.Px _) ->
Element.shrink
Just x ->
x
)
]
input.label
(Element.row
[ Element.width
(Maybe.withDefault Element.fill trackWidth)
, Element.height
(Maybe.withDefault (Element.px 20) trackHeight)
]
[ Internal.element
Internal.asEl
(Internal.NodeName "input")
[ hiddenLabelAttribute input.label
, Internal.StyleClass Flag.active
(Internal.Style
("input[type=\"range\"]." ++ className ++ "::-moz-range-thumb")
thumbShadowStyle
)
, Internal.StyleClass Flag.hover
(Internal.Style
("input[type=\"range\"]." ++ className ++ "::-webkit-slider-thumb")
thumbShadowStyle
)
, Internal.StyleClass Flag.focus
(Internal.Style
("input[type=\"range\"]." ++ className ++ "::-ms-thumb")
thumbShadowStyle
)
, Internal.Attr (Html.Attributes.class (className ++ " focusable-parent"))
, Internal.Attr
(Html.Events.onInput
(\str ->
case String.toFloat str of
Nothing ->
-- This should never happen because the browser
-- should always provide a Float.
input.onChange 0
Just val ->
input.onChange val
)
)
, Internal.Attr <|
Html.Attributes.type_ "range"
, Internal.Attr <|
Html.Attributes.step
(case input.step of
Nothing ->
-- Note: If we set `any` here,
-- Firefox makes a single press of the arrows keys equal to 1
-- We could set the step manually to the effective range / 100
-- String.fromFloat ((input.max - input.min) / 100)
-- Which matches Chrome's default behavior
-- HOWEVER, that means manually moving a slider with the mouse will snap to that interval.
"any"
Just step ->
String.fromFloat step
)
, Internal.Attr <|
Html.Attributes.min (String.fromFloat input.min)
, Internal.Attr <|
Html.Attributes.max (String.fromFloat input.max)
, Internal.Attr <|
Html.Attributes.value (String.fromFloat input.value)
, if vertical then
Internal.Attr <|
Html.Attributes.attribute "orient" "vertical"
else
Internal.NoAttribute
, Element.width <|
if vertical then
Maybe.withDefault (Element.px 20) trackHeight
else
Maybe.withDefault Element.fill trackWidth
, Element.height <|
if vertical then
Maybe.withDefault Element.fill trackWidth
else
Maybe.withDefault (Element.px 20) trackHeight
]
(Internal.Unkeyed [])
, Element.el
(Element.width
(Maybe.withDefault Element.fill trackWidth)
:: Element.height
(Maybe.withDefault (Element.px 20) trackHeight)
:: attributes
-- This is after `attributes` because the thumb should be in front of everything.
++ [ Element.behindContent <|
if vertical then
viewVerticalThumb factor thumbAttributes trackWidth
else
viewHorizontalThumb factor thumbAttributes trackHeight
]
)
Element.none
]
)
viewHorizontalThumb factor thumbAttributes trackHeight =
Element.row
[ Element.width Element.fill
, Element.height (Maybe.withDefault Element.fill trackHeight)
, Element.centerY
]
[ Element.el
[ Element.width (Element.fillPortion (round <| factor * 10000))
]
Element.none
, Element.el
(Element.centerY
:: List.map (Internal.mapAttr Basics.never) thumbAttributes
)
Element.none
, Element.el
[ Element.width (Element.fillPortion (round <| (abs <| 1 - factor) * 10000))
]
Element.none
]
viewVerticalThumb factor thumbAttributes trackWidth =
Element.column
[ Element.height Element.fill
, Element.width (Maybe.withDefault Element.fill trackWidth)
, Element.centerX
]
[ Element.el
[ Element.height (Element.fillPortion (round <| (abs <| 1 - factor) * 10000))
]
Element.none
, Element.el
(Element.centerX
:: List.map (Internal.mapAttr Basics.never) thumbAttributes
)
Element.none
, Element.el
[ Element.height (Element.fillPortion (round <| factor * 10000))
]
Element.none
]
type alias TextInput =
{ type_ : TextKind
, spellchecked : Bool
, autofill : Maybe String
}
type TextKind
= TextInputNode String
| TextArea
{-| -}
type alias Text msg =
{ onChange : String -> msg
, text : String
, placeholder : Maybe (Placeholder msg)
, label : Label msg
}
type Padding
= Padding Int Int Int Int
inheritablePlaceholderAttributes attr =
case attr of
Internal.StyleClass _ (Internal.PaddingStyle _ _ _ _ _) ->
True
Internal.StyleClass _ (Internal.BorderWidth _ _ _ _ _) ->
True
Internal.StyleClass _ (Internal.Transform _) ->
True
_ ->
False
{-|
attributes
attribute::width/height fill
attribtue::alignment
attribute::spacing
attribute::fontsize/family/lineheight
attribute::nearby(placeholder)
attribute::width/height fill
inFront ->
placeholder
attribute::padding
textarea ->
special height for height-content
attribtue::padding
attribute::lineHeight
attributes