Elm onInput character one behind - elm

What am I doing wrong that is causing the value reported by onInput to be a character behind?
For example, type "mil" in the text field to filter to the mileposts row. Then delete it back to nothing and you'll see its still filtering mileposts (also see the browser console to see that value is still "m" even thought the text field is visibly "")
module Main exposing (main)
import Browser
import Html exposing (Html, a, button, div, input, li, span, text, ul)
import Html.Attributes exposing (checked, class, classList, placeholder, style, type_, value)
import Html.Events exposing (custom, onBlur, onClick, onFocus, onInput)
import Json.Decode as Json
type alias Layer =
{ name : String
, description : String
, selected : Bool
}
main : Program () Model Msg
main =
Browser.element
{ init = init
, update = update
, view = view
, subscriptions = \_ -> Sub.none
}
type alias Model =
{ open : Bool
, layers : List Layer
, filtered : List Layer
, searchText : String
, highlightedIndex : Int
}
init : () -> ( Model, Cmd Msg )
init _ =
let
layers =
[ { name = "Parcels", description = "Show parcel lines", selected = False }
, { name = "Mileposts", description = "Show Mile post markers", selected = False }
]
in
( { open = False, layers = layers, filtered = layers, searchText = "", highlightedIndex = 0 }, Cmd.none )
type Msg
= Open
| Close
| Change String
| Up
| Down
| Toggle
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
let
lastIndex =
List.length model.filtered - 1
in
case msg of
Open ->
( { model | open = True }, Cmd.none )
Close ->
( { model | open = False }, Cmd.none )
Change value ->
let
filtered =
model.layers
|> List.filter
(\{ name } ->
let
_ =
Debug.log "name" name
_ =
Debug.log "searchText" model.searchText
in
String.contains (String.toLower model.searchText) (String.toLower name) |> Debug.log "contains"
)
in
( { model | searchText = value, filtered = filtered }, Cmd.none )
Up ->
if model.highlightedIndex == 0 then
( { model | highlightedIndex = lastIndex }, Cmd.none )
else
( { model | highlightedIndex = model.highlightedIndex - 1 }, Cmd.none )
Down ->
if model.highlightedIndex == lastIndex then
( { model | highlightedIndex = 0 }, Cmd.none )
else
( { model | highlightedIndex = model.highlightedIndex + 1 }, Cmd.none )
Toggle ->
let
highlightedLayer =
model.filtered
|> List.indexedMap Tuple.pair
|> List.filterMap
(\( idx, layer ) ->
if idx == model.highlightedIndex then
Just layer
else
Nothing
)
updatedFiltered =
model.filtered
|> List.indexedMap
(\idx layer ->
if idx == model.highlightedIndex then
{ layer | selected = not layer.selected }
else
layer
)
updatedLayers =
model.layers
|> List.map
(\layer ->
if [ layer ] == highlightedLayer then
{ layer | selected = not layer.selected }
else
layer
)
in
( { model | filtered = updatedFiltered, layers = updatedLayers }, Cmd.none )
view model =
div []
[ span [ class "mapboxgl-ctrl-geocoder--icon mapboxgl-ctrl-geocoder--icon-search" ]
[ span [ class "ds-badge ds-badge--red ds-badge--circle", style "margin-top" "-2px" ] [ text "3" ]
]
, input
[ type_ "text"
, class "mapboxgl-ctrl-geocoder--input"
, placeholder "Search layers"
, value model.searchText
, onFocus Open
, style "padding-left" "45px"
, onInput Change
--, onKey [(38, Up), (40, Down), (13, Toggle)]
]
[]
, if model.open then
div [ class "suggestions-wrapper" ]
[ ul [ class "suggestions", style "display" "block" ]
(model.filtered
|> List.indexedMap
(\idx { name, description, selected } ->
li [ classList [ ( "active", model.highlightedIndex == idx ) ] ]
[ a []
[ div [ class "mapboxgl-ctrl-geocoder--suggestion flex flex-column" ]
[ div [] [ input [ type_ "checkbox", style "margin-top" "5px", checked selected ] [] ]
, div [ class "ml-1" ]
[ div [ class "mapboxgl-ctrl-geocoder--suggestion-title" ] [ text name ]
, div [ class "mapboxgl-ctrl-geocoder--suggestion-address" ] [ text description ]
]
]
]
]
)
)
]
else
text ""
]
onKey : List ( Int, Msg ) -> Html.Attribute Msg
onKey codes =
let
isEnterKey keyCode =
case codes |> List.filter (\( code, _ ) -> code == keyCode) of
[ ( _, msg ) ] ->
Json.succeed
{ message = msg
, stopPropagation = True
, preventDefault = True
}
_ ->
Json.fail "silent failure :)"
in
custom "keydown" <|
Json.andThen isEnterKey Html.Events.keyCode
options =
{ stopPropagation = True
, preventDefault = True
}
https://ellie-app.com/fcgHCF2z5sza1

The problem is here, when handling the Change message from onInput:
Change value ->
let
filtered =
model.layers
|> List.filter
(\{ name } ->
let
_ =
Debug.log "name" name
_ =
Debug.log "searchText" model.searchText
in
String.contains (String.toLower model.searchText) (String.toLower name) |> Debug.log "contains"
)
in
( { model | searchText = value, filtered = filtered }, Cmd.none )
You're using model.searchText to filter the list, binding the result to filtered, then updating model with the new searchText and filtered list. model.searchText still has the previous value when you're filtering. Use value instead when filtering, then it works as expected.

Related

Reset an Elm select dropdown value

I basically have a little select dropdown like this:
viewDropdown : Model -> Html Msg
viewDropdown model =
let
options =
[ ( "", "-- Select --" )
, ( "not_available", "Unavailable" )
, ( "available", "Available" )
]
buildOption ( k, v ) =
option [ value k, selected (k == model.isAvailable) ] [ text v ]
viewOptions =
options
|> List.map
(\( k, v ) ->
buildOption ( k, v )
)
in
div [ class "styled-select" ]
[ select
[ on "change" (Decode.map (UpdateAvailability) targetValue)
]
viewOptions
]
If the user selects "Available", a modal pops up and they are prompted to confirm. If they hit "Cancel", I want the Select dropdown's value to reset to the value of "". This is not the case and although my model reflects the a Nothing val, the dropdown selection option is still on "Available". Any idea on what I can do to reset the DOM state?
While this doesn't answer why your code doesn't work, it seems that if you add the step of confirming the selection, then code will work:
Ellie example, with full code below: https://ellie-app.com/3P5TTM9YqVWa1
module Main exposing (main)
import Browser
import Html exposing (Html, button, div, text, option, select)
import Html.Events exposing (onClick, on, targetValue)
import Html.Attributes exposing (value, selected, class)
import Json.Decode as Decode
import Task
type alias Model =
{ isAvailable : String , showConfirm: Bool }
init : Model
init =
{ isAvailable = "-", showConfirm = False }
type Msg
= UpdateAvailability String
| ConfirmYes
| Reset
update : Msg -> Model -> Model
update msg model =
case msg of
UpdateAvailability v ->
{ model | isAvailable = v, showConfirm = (v == "available") }
ConfirmYes ->
{ model | showConfirm = False }
Reset ->
{ model | isAvailable = "-", showConfirm = False }
viewDropdown : Model -> Html Msg
viewDropdown model =
let
options =
[ ( "-", "-- Select --" )
, ( "not_available", "Unavailable" )
, ( "available", "Available" )
]
buildOption ( k, v ) =
option [ value k, selected (k == model.isAvailable) ] [ text v ]
viewOptions = List.map buildOption options
in
div []
[ select
[ on "change" (Decode.map (UpdateAvailability) targetValue) ]
viewOptions
]
viewConfirm model =
if model.showConfirm then
div []
[ text "Really available?"
, button [ onClick ConfirmYes ] [ text "Yes" ]
, button [ onClick Reset ] [ text "No" ]
]
else
div [] []
view : Model -> Html Msg
view model =
div []
[ viewDropdown model
, viewConfirm model
, button [ onClick Reset ] [ text "Reset" ]
]
main : Program () Model Msg
main =
Browser.sandbox
{ init = init
, view = view
, update = update
}
Turns out, adding a value attribute to the select html will override the option selected state, so this is pretty important if you need your select input to be in sync with model state.
https://ellie-app.com/3NZgYQYKv2Fa1
Are you setting model.isAvailable to "" when hitting the close button? Your code should work as is https://ellie-app.com/3NYRvgwkHWPa1

Dom not re-rendering on Model change (Elm)

I'm trying a simple Elm CRUD example, but the DOM is not re-rendering when I add a new item to a list of items in the model.
Right now, I'm just adding a static record, and I can confirm that the model is changing via the elm-reactor debugger, but the mapped itemView items is not updating w/ a new div element.
I feel like I might be missing a pretty important part of the Elm architecture/virtual dom. Can anybody point me in right direction?
import Html exposing (Html, text, beginnerProgram, div, input, button)
import Html.Events exposing (onInput, onClick)
import List exposing (map, repeat, append)
main =
Html.beginnerProgram
{ model = model
, view = view
, update = update }
type alias Model =
{ items : List Item
, inputTxt : String }
model : Model
model =
{ items = items
, inputTxt = inputTxt }
type alias Item =
{ id : Int
, txt : String }
item : Item
item =
{ id = 0
, txt = "some text" }
items : List Item
items =
repeat 2 item
inputTxt : String
inputTxt =
""
type Msg
= NoOp
| ChangeTxt String
| AddItem
update : Msg -> Model -> Model
update msg model =
case msg of
NoOp ->
model
ChangeTxt newTxt ->
{ model | inputTxt = newTxt }
AddItem ->
{ model | items = model.items ++ [{ id = 0, txt = "some text" }] }
view : Model -> Html Msg
view model =
div [] [
div [] [ itemsView items ]
, div [] [
input [ onInput ChangeTxt ] []
]
, div [] [
text model.inputTxt
]
, div [] [
button [ onClick AddItem ] [ text "click me!" ]
]
]
itemView : Item -> Html Msg
itemView item =
div [] [
div [] [ text ( toString item.id ) ]
, div [] [ text item.txt ]
]
itemsView : List Item -> Html Msg
itemsView items =
div [] [
div [] (List.map itemView items)
]
The second line of your view function should be
div [] [ itemsView model.items ]
Right now it always renders items defined above, not the items in the model.

mdl-lite dialog not displaying correct information

I'm trying to make a list of buttons, each of which opens up a dialog which displays a different number. For example, the first button says '10' and then when it is clicked a dialog opens which also says '10'. The second says '20', and when it is clicked a dialog is opened that also says '20', etc. However, all of the dialogs say '10' when they are opened.
Here is the code:
module Main exposing (..)
import Html exposing (Html, div, text, p)
import Html.App as App exposing (program)
import Material
import Material.Button as Button
import Material.Scheme as Scheme
import Material.Dialog as Dialog
-- MODEL
type alias Model =
{ buttons : List Int, mdl : Material.Model }
init : ( Model, Cmd Msg )
init =
( { buttons = [ 10, 20, 30, 40, 50, 60, 70 ], mdl = Material.model }, Cmd.none )
-- MESSAGES
type Msg
= Log Int
| Mdl (Material.Msg Msg)
--VIEW
element : Int -> Model -> Html Msg
element int model =
Dialog.view
[]
[ Dialog.title [] [ text "Greetings" ]
, Dialog.content []
[ p [] [ text "What is this insanity?" ]
, p [] [ text (toString int) ]
]
, Dialog.actions []
[ Button.render Mdl
[ 0 ]
model.mdl
[ Dialog.closeOn "click" ]
[ text "Close" ]
]
]
view : Model -> Html Msg
view model =
div []
(List.map (\b -> button b model) model.buttons)
|> Scheme.top
button : Int -> Model -> Html Msg
button int model =
div []
[ Button.render
Mdl
[ 1 ]
model.mdl
[ Button.raised
, Button.ripple
, Button.onClick (Log int)
, Dialog.openOn "click"
]
[ text (toString int) ]
, element int model
]
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Log int ->
let
check =
Debug.log "Int" int
in
model ! []
Mdl msg' ->
Material.update msg' model
-- MAIN
main : Program Never
main =
program
{ init = init
, view = view
, update = update
, subscriptions = always Sub.none
}
I read mdl-lite only supports one dialog per application, so the problem must have been calling element multiple times. The solution is to call element once in the view function, and with each button click to update a dialogInt value in the model, and then to display this value in the dialog.
Here's the code:
module Main exposing (..)
import Html exposing (Html, div, text, p)
import Html.App as App exposing (program)
import Material
import Material.Button as Button
import Material.Scheme as Scheme
import Material.Dialog as Dialog
-- MODEL
type alias Model =
{ ints : List Int, dialogInt : Int, mdl : Material.Model }
init : ( Model, Cmd Msg )
init =
( { ints = [ 10, 20, 30, 40, 50, 60, 70 ], dialogInt = 0, mdl = Material.model }, Cmd.none )
-- MESSAGES
type Msg
= Log Int
| UpdateDialogInt Int
| Mdl (Material.Msg Msg)
--VIEW
element : Model -> Html Msg
element model =
-- let
-- check =
-- Debug.log "int" int
-- in
Dialog.view
[]
[ Dialog.title [] [ text "Greetings" ]
, Dialog.content []
[ p [] [ text "What is this insanity?" ]
, p [] [ text (toString model.dialogInt) ]
]
, Dialog.actions []
[ Button.render Mdl
[ 1 ]
model.mdl
[ Dialog.closeOn "click" ]
[ text "Close" ]
]
]
view : Model -> Html Msg
view model =
div []
((element
model
)
:: (List.map (\b -> button b model) model.ints)
)
|> Scheme.top
button : Int -> Model -> Html Msg
button int model =
div []
[ Button.render
Mdl
[ int ]
model.mdl
[ Button.raised
, Button.ripple
, Button.onClick (UpdateDialogInt int)
, Dialog.openOn "click"
]
[ text (toString int) ]
]
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Log int ->
let
check =
Debug.log "int" int
in
model ! []
UpdateDialogInt int ->
{ model | dialogInt = int } ! []
Mdl msg' ->
let
check =
Debug.log "msg" msg'
in
Material.update msg' model
-- MAIN
main : Program Never
main =
program
{ init = init
, view = view
, update = update
, subscriptions = always Sub.none
}

boundingClientRect to get position of element relative to document

I'm trying to implement a drag and drop program, using boundingClientRect from the DOM package to get the dimensions of the element to be moved, and position from the Mouse to track the movement of the mouse when dragging.
The program works fine before I have scrolled, but when I scroll down, the dragging element appears higher in the view than before I clicked it. What I suspect is happening is, boundingClientRect gets the position of the element relative to the viewpoint, and then I use those values to set the top and left values. However, top and left are relative to the document or to a parent element. However, I have no idea what I could use instead of or in addition to boundingClientRect to get the left and top values relative to the document or parent element.
Here's the code, it's probably clearer than my rambling.
type alias Model =
{ movableItemsList : List Item
, originalMovableItems : List Item
, movingItem : Maybe ( Item, Rectangle )
, receivingItemsList : List Item
, updatedItemsList : List ( Item, Rectangle )
, drag : Maybe Drag
, scrollTop : Float
}
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
DragAndDelete deleteMsg xy movingItem movingRectangle ->
model
! [ command (DragStart xy movingItem movingRectangle)
, command (deleteMsg movingItem)
]
DragStart xy selectedItem movingRectangle ->
let
movingItem =
List.head (List.filter (\i -> i.id == selectedItem.id) model.originalMovableItems)
|> Maybe.withDefault (Item "" "" 0 "")
in
{ model
| drag = Just (Drag xy xy)
, movingItem = Just ( movingItem, movingRectangle )
}
! []
DragAt xy ->
{ model
| drag =
(Maybe.map (\{ start } -> Drag start xy) model.drag)
}
! []
DragEnd _ ->
{ model
| movingItem = Nothing
, drag = Nothing
}
! []
DeleteFromUpdatedList movingItem ->
let
isKeepable iteratingItem =
iteratingItem.id /= movingItem.id
updatedItemsData =
List.filter (\( i, _ ) -> isKeepable i) model.updatedItemsList
in
{ model
| updatedItemsList = updatedItemsData
}
! []
DeleteFromMovableList movingItem ->
let
isKeepable iteratingItem =
iteratingItem.id /= movingItem.id
movableItemsData =
List.filter isKeepable model.movableItemsList
in
{ model
| movableItemsList = movableItemsData
}
! []
UpdateReceivingItemsOnOverlap receivingRectangle receivingItem ->
let
receivingItemsData =
if (checkOverlap (getCurrentMovingRectangle model) receivingRectangle) then
List.map (\i -> updateItemColor i receivingItem) model.receivingItemsList
else
model.receivingItemsList
in
{ model | receivingItemsList = receivingItemsData } ! []
RestoreReceivingItemsListColor _ ->
let
receivingItemsData =
List.map restoreReceivingItemColor model.receivingItemsList
in
{ model | receivingItemsList = receivingItemsData } ! []
AddValues receivingRectangle receivingItem ->
let
movingItem =
movingItemMaybe model.movingItem
updatedItemsData =
if (checkOverlap (getCurrentMovingRectangle model) receivingRectangle) then
( { movingItem
| value = receivingItem.value + movingItem.value
, color = "#1A6B0D"
}
, receivingRectangle
)
:: model.updatedItemsList
else
model.updatedItemsList
in
{ model
| updatedItemsList = updatedItemsData
}
! [ command (DeleteFromMovableList movingItem)
]
RestoreListContent ->
let
movingItem =
movingItemMaybe model.movingItem
listItems =
movingItem :: model.movableItemsList
in
{ model | movableItemsList = listItems } ! []
getCurrentMovingRectangle : Model -> Rectangle
getCurrentMovingRectangle model =
let
movingItemTuple =
Maybe.withDefault ( Item "" "" 0 "0", Rectangle 0 0 0 0 ) model.movingItem
( _, movingRect ) =
movingItemTuple
in
case model.drag of
Nothing ->
movingRect
Just { start, current } ->
Rectangle
(movingRect.top + toFloat (current.y - start.y))
(movingRect.left + toFloat (current.x - start.x))
(movingRect.width)
(movingRect.height)
-- VIEW
view : Model -> Html Msg
view model =
div
[]
[ receivingAndUpdatedItemsLayersDiv model
, movableItemsListDiv model
, if model.movingItem /= Nothing then
movingItemDiv model
else
div [] []
]
receivingAndUpdatedItemsLayersDiv : Model -> Html Msg
receivingAndUpdatedItemsLayersDiv model =
div
[ style [ ( "position", "relative" ) ] ]
[ div
[ style
[ ( "position", "relative" )
, ( "top", "10px" )
, ( "left", "80px" )
]
]
[ div
[ style
[ ( "z-index", "3" )
, ( "position", "absolute" )
]
, attribute "class" "drag-here-overlay"
]
(List.map receivingItemOverlay model.receivingItemsList)
, div
[ style
[ ( "z-index", "0" )
, ( "position", "absolute" )
]
, attribute "class" "drag-here-underlay"
]
(List.map receivingItemUnderlay model.receivingItemsList)
]
, div
[]
[ div
[ style
[ ( "position", "absolute" )
, ( "z-index", "1" )
]
, attribute "class" "drag-here-updated"
]
(List.map updatedItemUnderlay model.updatedItemsList)
, div
[ style
[ ( "position", "absolute" )
, ( "z-index", "4" )
]
]
(List.map updatedItemOverlay model.updatedItemsList)
]
]
movableItemsListDiv : Model -> Html Msg
movableItemsListDiv model =
div
[ style
[ ( "position", "relative" )
, ( "top", "10px" )
, ( "left", "800px" )
]
]
(List.map movableItemDiv model.movableItemsList)
updatedItemUnderlay : ( Item, Rectangle ) -> Html Msg
updatedItemUnderlay ( item, rectangle ) =
div
[ attribute "class" "drag-here-updated-underlay-item"
, sharedStyles
, style
[ ( "background-color", item.color )
, ( "border", "1px solid #000" )
, ( "position", "absolute" )
, ( "left", px rectangle.left )
, ( "top", px rectangle.top )
]
]
[ text item.text
, br [] []
, text (toString item.value)
]
updatedItemOverlay : ( Item, Rectangle ) -> Html Msg
updatedItemOverlay ( item, rectangle ) =
div
[ onDragStart DeleteFromUpdatedList item
, attribute "class" "drag-here-updated-overlay-item"
, sharedStyles
, style
[ ( "background-color", "transparent" )
, ( "position", "absolute" )
, ( "left", px rectangle.left )
, ( "top", px rectangle.top )
]
]
[]
receivingItemUnderlay : Item -> Html Msg
receivingItemUnderlay item =
div
[ attribute "class" "drag-here-underlay-item"
, sharedStyles
, style
[ ( "background-color", item.color )
-- , ( "border", "1px solid #1A6B0D" )
]
]
[ text item.text
, br [] []
, text (toString item.value)
]
receivingItemOverlay : Item -> Html Msg
receivingItemOverlay item =
div
[ on "mouseenter" (Decode.map (\d -> UpdateReceivingItemsOnOverlap d item) (DOM.target DOM.boundingClientRect))
, on "mouseleave" (Decode.map (\d -> RestoreReceivingItemsListColor d) (DOM.target DOM.boundingClientRect))
, on "mouseup" (Decode.map (\d -> AddValues d item) (DOM.target DOM.boundingClientRect))
, attribute "class" "drag-here-overlay-item"
, sharedStyles
, style
[ ( "background-color", "transparent" ) ]
]
[]
movableItemDiv : Item -> Html Msg
movableItemDiv item =
div
[ onDragStart DeleteFromMovableList item
, attribute "id" ("drag-me " ++ toString item.value)
, sharedStyles
, style
[ ( "background-color", item.color )
, ( "border", "1px solid #DD0848" )
, ( "position", "relative" )
]
]
[ text "Drag Me!"
, br [] []
, text (toString item.value)
]
movingItemDiv : Model -> Html Msg
movingItemDiv model =
let
movingItem =
movingItemMaybe model.movingItem
realRectangle =
getCurrentMovingRectangle model
in
div
[ onMouseUp RestoreListContent
, sharedStyles
, style
[ ( "background-color", "#FF3C8C" )
, ( "border", "1px solid #DD0848" )
, ( "position", "absolute" )
, ( "top", px (realRectangle.top) )
, ( "left", px (realRectangle.left) )
, ( "z-index", "2" )
]
]
[ text movingItem.text
, br [] []
, text (toString movingItem.value)
]
sharedStyles : Attribute a
sharedStyles =
style
[ ( "width", "100px" )
, ( "height", "100px" )
, ( "border-radius", "4px" )
, ( "color", "white" )
, ( "justify-content", "center" )
, ( "align-items", "center" )
, ( "display", "flex" )
]
onDragStart : (Item -> Msg) -> Item -> Attribute Msg
onDragStart deleteMsg item =
on "mousedown"
(Mouse.position
`Decode.andThen`
(\posit ->
DOM.target DOM.boundingClientRect
`Decode.andThen`
(\rect ->
Decode.succeed (DragAndDelete deleteMsg posit item rect)
)
)
)
px : countable -> String
px number =
toString number ++ "px"
So, as you can see, when one clicks a movableItemDiv, the model's drag and movingItem fields are updated with the position of the mouse and the dimensions (Rectangle) of the movableItem respectively. However, these dimensions are relative to the viewpoint. movingItemDiv then calls getCurrentMovingRectangle, which sets the left and top styles of movingItemDiv according to the dimensions of the movingItem and the drag in the model. Because the dimensions of the movingItem are based on dimensions of the movableItemDiv relative to the viewpoint, not relative to the document, while the values set for the top and left values of the movingItemDiv establish the position of the element relative to the document (or the parent element, I'm not sure to be honest), the movingItemDiv is not positioned correctly. I hope this is clear!
Updated to elm-0.18
Below is a quick and dirty example of a list with draggable items
(which you can copy to elm-lang.org/try to see it in action)
each item has a relative positioning
transform: translate() is used to position the item being dragged
we do not know the absolute position of the item, but we do know how much it has moved relative to its (unknown) starting position.
Next step would be to determine if we are over a drop-zone when drag ends.
To calculate, you would need to know:
the relative position of your drop zones compared to the top-left corner of your list container
the size (width, height) of each drop zone
the original position of the item being dragged relative to top-left of the list container
for that, you would need to know the actual height of each item (I always used a fixed height on each item)
the amount of scroll in the list container (using Dom.y from elm-lang/dom)
Hope this will help you in the right direction!
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (on)
import Json.Decode as Json
import Mouse exposing (Position)
main =
Html.program
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ position : Position
, items : List String
, drag : Maybe Drag
}
type alias Drag =
{ id : Int
, start : Position
, current : Position
}
init : ( Model, Cmd Msg )
init =
Model
(Position 200 200)
[ "Apples", "Bananas", "Cherries", "Dades" ]
Nothing
! []
-- UPDATE
type Msg
= DragStart Int Position
| DragAt Position
| DragEnd Position
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
( updateHelp msg model, Cmd.none )
updateHelp : Msg -> Model -> Model
updateHelp msg ({position, items, drag} as model) =
case msg of
DragStart id xy ->
Model position items (Just (Drag id xy xy))
DragAt xy ->
Model position items (Maybe.map (\{id, start} -> Drag id start xy) drag)
DragEnd _ ->
Model position items Nothing
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model.drag of
Nothing ->
Sub.none
Just _ ->
Sub.batch [ Mouse.moves DragAt, Mouse.ups DragEnd ]
-- VIEW
(=>) = (,)
view : Model -> Html Msg
view model =
div []
<| List.indexedMap (itemView model) model.items
itemView : Model -> Int -> String -> Html Msg
itemView model index item =
let
zIndex =
case model.drag of
Just {id} ->
if index == id then
"99"
else
"0"
Nothing ->
"0"
in
div
[ onMouseDown index
, style
[ "background-color" => "#3C8D2F"
, "border" => "2px solid orange"
, "cursor" => "move"
, "position"=> "relative"
, "transform" => (getOffset model index)
, "z-index" => zIndex
, "width" => "100px"
, "height" => "100px"
, "border-radius" => "4px"
, "color" => "white"
, "display" => "flex"
, "align-items" => "center"
, "justify-content" => "center"
, "user-select" => "none"
]
]
[ text item
]
px : Int -> String
px number =
toString number ++ "px"
getOffset : Model -> Int -> String
getOffset {position, items, drag} index =
case drag of
Nothing ->
translate 0 0
Just {id, start,current} ->
if index == id then
translate (current.x - start.x) (current.y - start.y)
else
translate 0 0
translate : Int -> Int -> String
translate x y =
"translate(" ++ toString x ++ "px , " ++ toString y ++ "px)"
onMouseDown : Int -> Attribute Msg
onMouseDown id =
on "mousedown" (Json.map (DragStart id) Mouse.position)

ELM - List to table rows

In the examples, when mapping a list to html I always see something like
ul []
List.map toHtmlFunction myList
But what if the list is only a partial part of the child html elements like
...
table []
[
thead []
[
th [][text "Product"],
th [][text "Amount"]
],
List.map toTableRow myList,
tr []
[
td [][text "Total"],
td [][text toString(model.total)]
]
]
toTableRow: MyListItem -> Html Msg
toTableRow myListItem =
tr []
[
td[][text myListItem.label],
td[][text toString(myListItem.price)]
]
With this code I'm getting
The 1st element has this type:
VirtualDom.Node a
But the 2nd is:
List (Html Msg)
The problem is that thead and tr are of type Html a, while List.map returns a List (Html a), and they can't be combined just by using commas.
You could have a look a the functions for putting list together in the List package. For example you could do something like
table []
List.concat [
[ thead []
[ th [][text "Product"]
, th [][text "Amount"]
]
],
List.map toTableRow myList,
[ tr []
[ td [][text "Total"]
, td [][text toString(model.total)]
]
]
]
IMO the cleanest solution lies in #wintvelt's first suggestion: table [] ([ myHeader ] ++ List.map ...). For new users of elm, this seems the most intuitive. (BTW, I am a new user.)
Essentially, here, the takeaway realization is that the elm compiler doesn't group table [] [] ++ [] as table [] ([] ++ []) (for example). Instead, elm groups it as (table [] []) ++ []. This makes sense, if you think about it.
Thus, elm's evaluation of table [] [] ++ [] produces, at first, something of type Html msg (in Elm 0.18). Thereafter, the ++ function balks when it tries to combine that Html msg with a List.
(Naturally, also, if you try to append a List in the wrong way to some of your Html attributes, by coding table [] ++ [] [], you'll get a similar error message.)
Here's a fleshed out solution, tested with elm-make 0.18 (elm Platform 0.18.0):
module Main exposing (main)
import Html exposing (..)
main : Program Never Model Msg
main =
Html.program
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ messages : List String }
init : ( Model, Cmd Msg )
init =
( Model [], Cmd.none )
-- UPDATE
type Msg
= None
update : Msg -> Model -> ( Model, Cmd Msg )
update msg { messages } =
case msg of
None ->
( Model messages, Cmd.none )
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[]
-- VIEW
type alias MyListItem =
{ label : String
, price : Float
}
total : Float
total =
5.0
myList : List MyListItem
myList =
[ { label = "labelA", price = 2 }
, { label = "labelB", price = 3 }
]
toTableRow : MyListItem -> Html Msg
toTableRow myListItem =
tr []
[ td [] [ text myListItem.label ]
, td [] [ text (toString myListItem.price) ]
]
view : Model -> Html Msg
view model =
table
[]
([ thead []
[ th [] [ text "Product" ]
, th [] [ text "Amount" ]
]
]
++ List.map toTableRow myList
++ [ tr
[]
[ td [] [ text "Total" ]
, td [] [ text (toString total) ]
]
]
)