I'm trying to write a custom event which sends two decoded values to update. on "mousedown", I'd like to inform update about the position of the mouse as well as the dimensions of the DOM element.
Here's what I've tried, but doesn't work:
dragMeListItem : Item -> Html Msg
dragMeListItem item =
div
[ on "mousedown" (Decode.map (\posit -> (Decode.map (\rect -> DragStart posit rect item) decodeRectangle)) Mouse.position)
, attribute "class" "drag-me"
, sharedStyles
, style
[ ( "background-color", item.color )
, ( "border", "1px solid #DD0848" )
]
]
[ text "Drag Me!"
, br [] []
, text (toString item.value)
]
-
decodeRectangle : Decode.Decoder Rectangle
decodeRectangle =
let
rectangle =
DOM.target
:> DOM.boundingClientRect
in
rectangle
-
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
DragStart xy rectangle item ->
let
xY =
Debug.log "xy:" xy
consoleRectangle =
Debug.log "rectangle:" rectangle
consoleItem =
Debug.log "item:" item
in
{ model
| draggingItem = Just ( item, rectangle )
, drag = Just (Drag xy xy)
}
! []
-
The compiler error is:
The type annotation for dragMeListItem does not match its
definition.
362| dragMeListItem : Item -> Html Msg
The type annotation is saying:
Item -> Html Msg
But I am inferring that the definition has this type:
Item -> Html (Decode.Decoder Msg)
The problem originates in your nested use of Decode.map in the "mousedown" line. Try using andThen instead:
(Mouse.position `Decode.andThen` \posit ->
decodeRectangle `Decode.andThen` \rect ->
Decode.succeed (DragStart posit rect item))
Related
I am new to ELM and I want to create a modal without the use of any libraries such as Bootstrap or ELM-UI. I found this simple example online which is also using JSON Decode. Is there a possibility to have the modal work simply without any framework/library and JSON Decode? How can I modify the code to simply get a working modal?
module Main exposing (main)
import Browser
import Html exposing (Html, Attribute, button, div, span, text)
import Html.Events exposing (onClick, on)
import Html.Attributes exposing (class, style)
import Json.Decode as Decode
type alias Model =
{ isVisible : Bool, count : Int }
initialModel : Model
initialModel =
{ isVisible = False, count = 0 }
type Msg
= Show
| Hide
| Increment
| Decrement
update : Msg -> Model -> Model
update msg model =
case msg of
Show ->
{ model | isVisible = True }
Hide ->
{ model | isVisible = False }
Increment ->
{ model | count = model.count + 1 }
Decrement ->
{ model | count = model.count - 1 }
view : Model -> Html Msg
view model =
div []
[ button [ onClick Show ] [ text "Show!" ]
, if model.isVisible then
div
([ class dialogContainerClass
, on "click" (containerClickDecoder Hide)
]
++ dialogContainerStyle
)
[ div dialogContentStyle
[ span [] [ text "Click anywhere outside this dialog to close it!" ]
, span [] [ text "Clicking on anything inside of this dialog works as normal." ]
, div []
[ button [ onClick Decrement ] [ text "-" ]
, text (String.fromInt model.count)
, button [ onClick Increment ] [ text "+" ]
]
]
]
else
div [] []
]
dialogContainerClass : String
dialogContainerClass = "dialog-container-class"
containerClickDecoder : msg -> Decode.Decoder msg
containerClickDecoder closeMsg =
Decode.at [ "target", "className" ] Decode.string
|> Decode.andThen
(\c ->
if String.contains dialogContainerClass c then
Decode.succeed closeMsg
else
Decode.fail "ignoring"
)
dialogContainerStyle : List (Attribute msg)
dialogContainerStyle =
[ style "position" "absolute"
, style "top" "0"
, style "bottom" "0"
, style "right" "0"
, style "left" "0"
, style "display" "flex"
, style "align-items" "center"
, style "justify-content" "center"
, style "background-color" "rgba(33, 43, 54, 0.4)"
]
dialogContentStyle : List (Attribute msg)
dialogContentStyle =
[ style "border-style" "solid"
, style "border-radius" "3px"
, style "border-color" "white"
, style "background-color" "white"
, style "height" "120px"
, style "width" "440px"
, style "display" "flex"
, style "flex-direction" "column"
, style "align-items" "center"
, style "justify-content" "center"
]
main : Program () Model Msg
main =
Browser.sandbox
{ init = initialModel
, view = view
, update = update
}
If I understand your question correctly, the problem you're trying to solve is clicking outside the modal to close it. Decoding the event object to get information about the DOM is a bit of a hack in Elm – I think you're right to try to avoid it, unless necessary. One way to achieve the same thing is to add a click event handler with stop propagation to your modal contents – this stops the click event from firing on the container when it originates from within the modal.
I've put your example code in an Ellie and made some small changes: https://ellie-app.com/b9gDPHgtz2ca1
This solution uses Html.Events.stopPropagationOn, which is like on but does a call to event.stopPropagation(). This function does require you to supply a decoder, so I'm afraid you can't get away from importing Json.Decode, but we are using the simplest possible decoder – Decode.succeed – and only to satisfy the parameters of the function.
I've added a NoOp variant to Msg, as there is nothing to do when the modal is clicked; simply attaching this event handler stops the Hide event from firing when we don't want it to.
Code
module Main exposing (main)
import Browser
import Html exposing (Attribute, Html, button, div, span, text)
import Html.Attributes exposing (class, style)
import Html.Events exposing (on, onClick)
import Json.Decode as Decode
type alias Model =
{ isVisible : Bool, count : Int }
initialModel : Model
initialModel =
{ isVisible = False, count = 0 }
type Msg
= Show
| Hide
| Increment
| Decrement
| NoOp
update : Msg -> Model -> Model
update msg model =
case msg of
Show ->
{ model | isVisible = True }
Hide ->
{ model | isVisible = False }
Increment ->
{ model | count = model.count + 1 }
Decrement ->
{ model | count = model.count - 1 }
NoOp ->
model
view : Model -> Html Msg
view model =
div []
[ button [ onClick Show ] [ text "Show!" ]
, if model.isVisible then
div
(onClick Hide
:: dialogContainerStyle
)
[ div
(onClickStopPropagation NoOp
:: dialogContentStyle
)
[ span [] [ text "Click anywhere outside this dialog to close it!" ]
, span [] [ text "Clicking on anything inside of this dialog works as normal." ]
, div []
[ button [ onClick Decrement ] [ text "-" ]
, text (String.fromInt model.count)
, button [ onClick Increment ] [ text "+" ]
]
]
]
else
div [] []
]
onClickStopPropagation : msg -> Html.Attribute msg
onClickStopPropagation msg =
Html.Events.stopPropagationOn "click" <| Decode.succeed ( msg, True )
dialogContainerStyle : List (Attribute msg)
dialogContainerStyle =
[ style "position" "absolute"
, style "top" "0"
, style "bottom" "0"
, style "right" "0"
, style "left" "0"
, style "display" "flex"
, style "align-items" "center"
, style "justify-content" "center"
, style "background-color" "rgba(33, 43, 54, 0.4)"
]
dialogContentStyle : List (Attribute msg)
dialogContentStyle =
[ style "border-style" "solid"
, style "border-radius" "3px"
, style "border-color" "white"
, style "background-color" "white"
, style "height" "120px"
, style "width" "440px"
, style "display" "flex"
, style "flex-direction" "column"
, style "align-items" "center"
, style "justify-content" "center"
]
main : Program () Model Msg
main =
Browser.sandbox
{ init = initialModel
, view = view
, update = update
}
I would like to know the mouse position relatively to an html element. I would also know the size of the element.
Is possible to detect the mouse position with mouseMove event. This is an example of how it can be implemented using The Elm Architecture.
The view:
view : Model -> Html Msg
view model =
div []
[ img
[ on "mousemove" (Decode.map MouseMove decoder)
, src "http://..."
]
[]
]
The decoder:
decoder : Decoder MouseMoveData
decoder =
map4 MouseMoveData
(at [ "offsetX" ] int)
(at [ "offsetY" ] int)
(at [ "target", "offsetHeight" ] float)
(at [ "target", "offsetWidth" ] float)
The type alias
type alias MouseMoveData =
{ offsetX : Int
, offsetY : Int
, offsetHeight : Float
, offsetWidth : Float
}
And the Message
type Msg
= MouseMove MouseMoveData
And this is how the data arrive to the Update:
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
MouseMove data ->
-- Here you can use your "data", updating
-- the model with it, for example
( { model | zoomMouseMove = Just data }, Cmd.none )
This is a library that does a similar thing: http://package.elm-lang.org/packages/mbr/elm-mouse-events/1.0.4/MouseEvents
How do you get the current focus in Elm? I know how to set focus with Elm, but I can't find any functionality to detect what currently has focus.
The elm-lang/dom package allows setting focus on an element given an ID but it does not allow you to fetch the currently focused element. It hints that you can use document.activeElement for this. To do that, you'll have to use ports.
Here is a contrived example. Let's say you have a Model that contains the currently selected id and a list of all ids of some textboxes we'll soon create.
type alias Model =
{ selected : Maybe String
, ids : List String
}
The Msgs we will use will be able to inquire about the focus as well as use the Dom library to set focus:
type Msg
= NoOp
| FetchFocused
| FocusedFetched (Maybe String)
| Focus (Maybe String)
For that, we will need two ports:
port focusedFetched : (Maybe String -> msg) -> Sub msg
port fetchFocused : () -> Cmd msg
The javascript calling these ports will report on the current document.activeElement:
var app = Elm.Main.fullscreen()
app.ports.fetchFocused.subscribe(function() {
var id = document.activeElement ? document.activeElement.id : null;
app.ports.focusedFetched.send(id);
});
The view displays the currently selected id, provides a list of buttons that will set the focus on one of the numbered textboxes below.
view : Model -> Html Msg
view model =
div []
[ div [] [ text ("Currently selected: " ++ toString model.selected) ]
, div [] (List.map viewButton model.ids)
, div [] (List.map viewInput model.ids)
]
viewButton : String -> Html Msg
viewButton id =
button [ onClick (Focus (Just id)) ] [ text id ]
viewInput : String -> Html Msg
viewInput idstr =
div [] [ input [ id idstr, placeholder idstr, onFocus FetchFocused ] [] ]
The update function ties it all together:
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NoOp ->
model ! []
FetchFocused ->
model ! [ fetchFocused () ]
FocusedFetched selected ->
{ model | selected = selected } ! []
Focus (Just selected) ->
model ! [ Task.attempt (always NoOp) (Dom.focus selected), fetchFocused () ]
Focus Nothing ->
{ model | selected = Nothing } ! [ fetchFocused () ]
Here is a working example on ellie-app.com.
Here's the short version:
I have a function:
onClick : String -> Bool -> (State -> msg) -> Options.Property c msg
onClick name isReversed toMsg =
Options.on "click" <| Json.succeed <|
toMsg (State name isReversed)
I want to change the function to this:
onClick : String -> Bool -> (State -> msg) -> (Maybe msg -> Options.Property c msg)
In other words, I'd like it to return a partial function which takes a Maybe msg. However, I'm not sure how to do that! Help would be appreciated.
Here's the long version:
I'm trying to build a 'fork' of the elm sortable table package which uses the elm mdl package and allows custom event listeners on the column headers. The sortable table package (obviously) applies event listeners on the column headers which sort the table by that column.
Unfortunately, you can't have two 'onClick' listeners on the same element, so what I've decided to do is to pass the custom message as an argument to the sort message, and then send it as a command from the sort update. Sorry if you're not familiar with the package and that all sounds like mumbo jumbo, I just thought I'd give the context for my question.
The developers of the sortable table package created a custom event listener which looks like this:
onClick : String -> Bool -> (State -> msg) -> Attribute msg
onClick name isReversed toMsg =
E.on "click" <| Json.map toMsg <|
Json.map2 State (Json.succeed name) (Json.succeed isReversed)
I've already changed it a bit to use the mdl custom event listener and to make it (in my opinion), slightly more readable:
onClick : String -> Bool -> (State -> msg) -> Options.Property c msg
onClick name isReversed toMsg =
Options.on "click" <| Json.succeed <|
toMsg (State name isReversed)
As I've said, I'd like it to be this:
onClick : String -> Bool -> (State -> msg) -> (Maybe msg -> Options.Property c msg)
However, if you're familiar with the package and have any other suggestions for using custom messages on clicking a column, please suggest them!! I really have no idea what I'm doing.
The longer version:
In the component's view code, there is a variable theadDetails which looks like this:
theadDetails =
customizations.thead (List.map (toHeaderInfo state toMsg columns)
state toMsg and columns all come from the config in the project's main view code. toMsg is a Msg which is handled in the main update (the component doesn't keep track of its own state).
toHeaderInfo looks like this:
toHeaderInfo : State -> (State -> msg) -> ColumnData data msg -> ( String, Status, Options.Property c msg )
toHeaderInfo (State sortName isReversed) toMsg { name, sorter } =
case sorter of
None ->
( name, Unsortable, onClick sortName isReversed toMsg )
Decreasing _ ->
( name, Sortable (name == sortName), onClick name False toMsg )
IncOrDec _ ->
if name == sortName then
( name, Reversible (Just isReversed), onClick name (not isReversed) toMsg )
else
( name, Reversible Nothing, onClick name False toMsg )
This is basically where the data that will be included in each element is rendered. All of this stuff about State and sorter has to do with how each column's sorting is configured and the current order. But you see, here onClick is being called and passed the required arguments.
As you see in theadDetails, this info is then passed to an function, customizations.tHead which looks like this:
defaultCustomizations : Customizations data msg c
defaultCustomizations =
{ tableAttrs = []
, caption = Nothing
, thead = simpleThead
, tfoot = Nothing
, tbodyAttrs = []
, rowAttrs = simpleRowAttrs
}
simpleThead : List ( String, Status, Options.Property { numeric : Bool, sorted : Maybe Table.Order } msg ) -> HtmlDetails {} msg
simpleThead headers =
HtmlDetails [] (List.map simpleTheadHelp headers)
simpleTheadHelp : ( String, Status, Options.Property { numeric : Bool, sorted : Maybe Table.Order } msg ) -> Html msg
simpleTheadHelp ( name, status, onClick ) =
let
check =
Debug.log "status" status
attrs =
case status of
Unsortable ->
[]
Sortable selected ->
if selected then
[ onClick
, Options.css "color" "rgb(0,0,0)"
]
else
[ onClick ]
Reversible Nothing ->
[ onClick
]
Reversible (Just isReversed) ->
[ onClick
, Options.css "color" "rgb(0,0,0)"
]
in
Table.th attrs [ Html.text name ]
It's precisely here where I'd like to pass the final argument. So simpleTheadHeald would become:
simpleTheadHelp : ( String, Status, Options.Property { numeric : Bool, sorted : Maybe Table.Order } msg ) -> Html msg
simpleTheadHelp ( name, status, onClick ) =
let
check =
Debug.log "status" status
attrs =
case status of
Unsortable ->
[]
Sortable selected ->
if selected then
[ onClick Nothing
, Options.css "color" "rgb(0,0,0)"
]
else
[ onClick Nothing ]
Reversible Nothing ->
[ onClick Nothing
]
Reversible (Just isReversed) ->
[ onClick Nothing
, Options.css "color" "rgb(0,0,0)"
]
in
Table.th attrs [ Html.text name ]
This, however, gives me an error saying onClick is not a function (because in the type definition it isn't expecting an argument).
Sorry for doing such a poor job explaining myself! I'm really trying to figure it out as I go, so I appreciate the patience.
I'm not familiar with the package, so if I'm missing something in your question or telling you something you already know, I apologize.
Functions in Elm are curried automatically. All you need to do is pass the function an incomplete set of arguments, and you'll get back a function that takes the remaining argument(s). So this would be your function signature:
onClick : String -> Bool -> (State -> msg) -> Maybe msg -> Options.Property c msg
onClick name isReversed toMsg maybeMsg =
You then write the function, using all the arguments and not worrying about partial application at all. Calling that function with only the first three arguments, like this:
onClick "myName" True MyMsg
will automatically return a function with this signature:
newFunction : Maybe msg -> Options.Property c msg
You don't need to do anything else.
I'm trying to make a content editable tag that uses enter to update the model.
My code is below, and here is a version that you can play around with on Ellie.
The on "blur" attribute works and updates the model when you click away. But I want to get the same 'update' functionality when an enter is pressed.
view : Model -> Html Msg
view model =
let
attrs =
[ contenteditable True
--, on "blur" (Json.map UpdateTitle targetTextContent)
, onInput2 UpdateTitle
, onEnter EnterPressed
, id "title"
, class "title"
]
in
div []
[ h1 attrs [ text model.existing ]
, text "Click above to start editing. Blur to save the value. The aim is to capture an <enter> and interpret that as a blur, i.e. to save the value and blur the field"
, p [] [ text <| "(" ++ model.existing ++ ")" ]
]
targetTextContent : Json.Decoder String
targetTextContent =
Json.at [ "target", "textContent" ] Json.string
onInput2 : (String -> msg) -> Attribute msg
onInput2 msgCreator =
on "input" (Json.map msgCreator targetTextContent)
onEnter : (Bool -> msg) -> Attribute msg
onEnter enterMsg =
onWithOptions "keydown"
{ stopPropagation = False
, preventDefault = False
}
(keyCode
|> Json.andThen
(\ch ->
let
_ =
Debug.log "on Enter" ch
in
Json.succeed (enterMsg <| ch == 13)
)
)
This code seems to be updating the model ok, but the DOM is getting messed up. For example if I enter enter after "blast" I see this
I tried switching to Html.Keyed and using "keydown" but it did not make any difference or just created different issues.
Solved! The key point is the filter function that uses Json.Decode.fail so that only <enter> is subject to preventDefault. See https://github.com/elm-lang/virtual-dom/issues/18#issuecomment-273403774 for the idea.
view : Model -> Html Msg
view model =
let
attrs =
[ contenteditable True
, on "blur" (Json.map UpdateTitle targetTextContent)
, onEnter EnterPressed
, id "title"
, class "title"
]
in
div []
[ h1 attrs [ text model.existing ]
, text "Click above to start editing. Blur to save the value. The aim is to capture an <enter> and interpret that as a blur, i.e. to save the value and blur the field"
, p [] [ text <| "(" ++ model.existing ++ ")" ]
]
targetTextContent : Json.Decoder String
targetTextContent =
Json.at [ "target", "textContent" ] Json.string
onEnter : msg -> Attribute msg
onEnter msg =
let
options =
{ defaultOptions | preventDefault = True }
filterKey code =
if code == 13 then
Json.succeed msg
else
Json.fail "ignored input"
decoder =
Html.Events.keyCode
|> Json.andThen filterKey
in
onWithOptions "keydown" options decoder