This module entirely replaces Html.Events, providing a type-safer alternative. This is designed to work with BodyBuilder. It is not compatible with Html, though.
module BodyBuilder.Events
exposing
( OnMouseEvents
, OnMouseEventsInside
, onClick
, onDoubleClick
, onContextMenu
, onMouseUp
, onMouseOut
, onMouseOver
, onMouseDown
, onMouseLeave
, onMouseEnter
, mouseEventsToHtmlAttributes
, OnStringInputEvent
, OnIntInputEvent
, OnColorInputEvent
, onInput
, inputEventToHtmlEvent
, OnCheckEvent
, onCheck
, checkEventToHtmlEvent
, OnSubmitEvent
, onSubmit
, submitEventToHtmlEvent
, OnFocusEvent
, onFocus
, focusEventToHtmlAttributes
, OnBlurEvent
, onBlur
, onBlurEventToHtmlAttributes
, OnEvent
, on
, onWithOptions
, onEventToHtmlAttributes
)
{-| This module entirely replaces Html.Events, providing a type-safer alternative.
This is designed to work with BodyBuilder.
It is not compatible with Html, though.
@docs checkEventToHtmlEvent
@docs focusEventToHtmlAttributes
@docs inputEventToHtmlEvent
@docs mouseEventsToHtmlAttributes
@docs on
@docs onWithOptions
@docs onBlur
@docs OnBlurEvent
@docs onBlurEventToHtmlAttributes
@docs onCheck
@docs OnCheckEvent
@docs onClick
@docs OnColorInputEvent
@docs onDoubleClick
@docs onContextMenu
@docs OnEvent
@docs onEventToHtmlAttributes
@docs onFocus
@docs OnFocusEvent
@docs onInput
@docs OnIntInputEvent
@docs onMouseDown
@docs onMouseEnter
@docs OnMouseEvents
@docs OnMouseEventsInside
@docs onMouseLeave
@docs onMouseOut
@docs onMouseOver
@docs onMouseUp
@docs OnStringInputEvent
@docs onSubmit
@docs OnSubmitEvent
@docs submitEventToHtmlEvent
-}
import Html
import Html.Events
import Json.Decode exposing (Decoder)
import Color exposing (Color)
import Helpers.Shared exposing (..)
import BodyBuilder.Setters exposing (..)
import Modifiers exposing (..)
defaultOnMouseEvents : OnMouseEventsInside msg
defaultOnMouseEvents =
OnMouseEventsInside
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
withDefaultOnMouse : Modifier (OnMouseEventsInside msg) -> Modifier (OnMouseEvents msg a)
withDefaultOnMouse setter ({ onMouseEvents } as attrs) =
onMouseEvents
|> Maybe.withDefault defaultOnMouseEvents
|> setter
|> setOnMouseEventsIn attrs
{-| -}
onClick : msg -> Modifier (OnMouseEvents msg a)
onClick val =
withDefaultOnMouse (setClick val)
{-| -}
onDoubleClick : msg -> Modifier (OnMouseEvents msg a)
onDoubleClick val =
withDefaultOnMouse (setDoubleClick val)
{-| -}
onContextMenu : msg -> Modifier (OnMouseEvents msg a)
onContextMenu val =
withDefaultOnMouse (setContextMenu val)
{-| -}
onMouseUp : msg -> Modifier (OnMouseEvents msg a)
onMouseUp val =
withDefaultOnMouse (setOnMouseUp val)
{-| -}
onMouseOut : msg -> Modifier (OnMouseEvents msg a)
onMouseOut val =
withDefaultOnMouse (setOnMouseOut val)
{-| -}
onMouseOver : msg -> Modifier (OnMouseEvents msg a)
onMouseOver val =
withDefaultOnMouse (setOnMouseOver val)
{-| -}
onMouseDown : msg -> Modifier (OnMouseEvents msg a)
onMouseDown val =
withDefaultOnMouse (setOnMouseDown val)
{-| -}
onMouseLeave : msg -> Modifier (OnMouseEvents msg a)
onMouseLeave val =
withDefaultOnMouse (setOnMouseLeave val)
{-| -}
onMouseEnter : msg -> Modifier (OnMouseEvents msg a)
onMouseEnter val =
withDefaultOnMouse (setOnMouseEnter val)
{-| -}
mouseEventsToHtmlAttributes : OnMouseEventsInside msg -> List (Html.Attribute msg)
mouseEventsToHtmlAttributes events =
List.concatMap (callOn events)
[ unwrapEmptyList (Html.Events.onClick >> List.singleton) << .click
, unwrapEmptyList (Html.Events.onDoubleClick >> List.singleton) << .doubleClick
, unwrapEmptyList (Json.Decode.succeed >> Html.Events.on "contextmenu" >> List.singleton) << .contextMenu
, unwrapEmptyList (Html.Events.onMouseDown >> List.singleton) << .mouseDown
, unwrapEmptyList (Html.Events.onMouseUp >> List.singleton) << .mouseUp
, unwrapEmptyList (Html.Events.onMouseEnter >> List.singleton) << .mouseEnter
, unwrapEmptyList (Html.Events.onMouseLeave >> List.singleton) << .mouseLeave
, unwrapEmptyList (Html.Events.onMouseOver >> List.singleton) << .mouseOver
, unwrapEmptyList (Html.Events.onMouseOut >> List.singleton) << .mouseOut
]
{-| -}
type alias OnMouseEvents msg a =
{ a | onMouseEvents : Maybe (OnMouseEventsInside msg) }
{-| -}
type alias OnMouseEventsInside msg =
{ click : Maybe msg
, doubleClick : Maybe msg
, contextMenu : Maybe msg
, mouseDown : Maybe msg
, mouseUp : Maybe msg
, mouseEnter : Maybe msg
, mouseLeave : Maybe msg
, mouseOver : Maybe msg
, mouseOut : Maybe msg
}
type alias OnInputEvent b msg a =
{ a
| onInputEvent : Maybe (b -> msg)
, fromStringInput : String -> b
}
{-| -}
type alias OnStringInputEvent msg a =
OnInputEvent String msg a
{-| -}
type alias OnIntInputEvent msg a =
OnInputEvent Int msg a
{-| -}
type alias OnColorInputEvent msg a =
OnInputEvent Color msg a
{-| -}
type alias OnCheckEvent msg a =
{ a | onCheckEvent : Maybe (Bool -> msg) }
{-| -}
type alias OnSubmitEvent msg a =
{ a | onSubmitEvent : Maybe msg }
{-| -}
type alias OnFocusEvent msg a =
{ a | onFocusEvent : Maybe msg }
{-| -}
type alias OnBlurEvent msg a =
{ a | onBlurEvent : Maybe msg }
{-| -}
type alias OnEvent msg a =
{ a | onEvent : Maybe ( String, Maybe Html.Events.Options, Decoder msg ) }
{-| -}
onInput : (a -> msg) -> Modifier (OnInputEvent a msg b)
onInput val attrs =
{ attrs | onInputEvent = Just val }
{-| -}
inputEventToHtmlEvent : ( Maybe (a -> msg), String -> a ) -> List (Html.Attribute msg)
inputEventToHtmlEvent ( onInputEvent, fromStringInput ) =
case onInputEvent of
Just fun ->
[ Html.Events.onInput (fromStringInput >> fun) ]
Nothing ->
[]
{-| -}
onCheck : (Bool -> msg) -> Modifier (OnCheckEvent msg a)
onCheck val attrs =
{ attrs | onCheckEvent = Just val }
{-| -}
checkEventToHtmlEvent : OnCheckEvent msg a -> List (Html.Attribute msg)
checkEventToHtmlEvent =
unwrapMaybeAttribute Html.Events.onCheck << .onCheckEvent
{-| -}
onSubmit : msg -> Modifier (OnSubmitEvent msg a)
onSubmit val attrs =
{ attrs | onSubmitEvent = Just val }
{-| -}
submitEventToHtmlEvent : OnSubmitEvent msg a -> List (Html.Attribute msg)
submitEventToHtmlEvent =
unwrapMaybeAttribute Html.Events.onSubmit << .onSubmitEvent
{-| -}
onFocus : msg -> Modifier (OnFocusEvent msg a)
onFocus val attrs =
{ attrs | onFocusEvent = Just val }
{-| -}
focusEventToHtmlAttributes : msg -> List (Html.Attribute msg)
focusEventToHtmlAttributes =
Html.Events.onFocus >> List.singleton
{-| -}
onBlur : msg -> Modifier (OnBlurEvent msg a)
onBlur val attrs =
{ attrs | onBlurEvent = Just val }
{-| -}
onBlurEventToHtmlAttributes : msg -> List (Html.Attribute msg)
onBlurEventToHtmlAttributes =
Html.Events.onBlur >> List.singleton
{-| -}
on : String -> Decoder msg -> Modifier (OnEvent msg a)
on event decoder attrs =
{ attrs | onEvent = Just ( event, Nothing, decoder ) }
{-| -}
onWithOptions : String -> Html.Events.Options -> Decoder msg -> Modifier (OnEvent msg a)
onWithOptions event options decoder attrs =
{ attrs | onEvent = Just ( event, Just options, decoder ) }
{-| -}
onEventToHtmlAttributes : ( String, Maybe Html.Events.Options, Decoder msg ) -> List (Html.Attribute msg)
onEventToHtmlAttributes ( event, maybeOptions, decoder ) =
case maybeOptions of
Nothing ->
[ Html.Events.on event decoder ]
Just options ->
[ Html.Events.onWithOptions event options decoder ]