Drag and Drop

DragAndDrop.elm

import Html exposing (text, div, Attribute)
import Html.Attributes exposing (style, draggable)
import Html.Events exposing (..)
import Signal exposing (map, mailbox)
import Json.Decode as Json exposing (value)

mb = mailbox "None"

messageOn : String -> Signal.Address a -> a -> Attribute
messageOn name addr msg =
  on name value (\_ -> Signal.message addr msg)

onDrop = messageOn "drop"
onDragOver addr msg =
  onWithOptions "dragover" {preventDefault = True, stopPropagation = False}  value (\_ -> Signal.message addr msg)


view model =
  div [] [
    div [] [
        text (toString model)
    ],
    div [draggable "true",
         style [
           ("width", "80px"),
           ("height", "80px"),
           ("background-color", "red")
        ]] [
      text "drag me"
    ],
    div [style [
        ("width", "300px"),
        ("height", "300px"),
        ("background-color", "green")
      ],
      onClick mb.address "Click",
      onDrop mb.address "Drop",
      onDragOver mb.address "DragOver" ] [text "drop here"]
  ]

main = Signal.map (\v -> view (Debug.log "v" v) )  mb.signal