Drag and drop example with svg in Elm

svgdragdrop.elm

import Svg (Svg, circle, svg, g, line, text)
import Svg.Attributes (cx, cy, r, fill, stroke, strokeWidth, x, y, x1, x2, y1, y2, fontSize, style)
import Html
import Html.Attributes as Html

import Signal (Signal, map, foldp)
import DragAndDrop (mouseEvents, MouseEvent(..))
import List

--------------
-- Vector Type
--------------
type alias Vector = (Int, Int)


distanceSquared : Vector -> Vector -> Int
distanceSquared (ax, ay) (bx, by) =
  (ax - bx) * (ax - bx) + (ay - by) * (ay - by)

distance : Vector -> Vector -> Int
distance p q =
  round (sqrt (toFloat (distanceSquared p q)))


--------
-- Model
--------

type alias Point =
  { position : Vector
  , selected : Bool
  , radius   : Int
  }

within : Vector -> Point -> Bool
within vector point =
  distanceSquared vector point.position <= point.radius * point.radius

type alias Triangle = (Point, Point, Point)

type alias Circle = (Point, Point)

type alias Model =
  { triangles : List Triangle
  , circles   : List Circle
  }

point : Int -> Int -> Point
point x y =
  { position = (x,y)
  , selected = False
  , radius   = 5
  }


initialTriangle : Triangle
initialTriangle =
  (point 100 100, point 200 200, point 100 200)

initialCircle : Circle
initialCircle =
  (point 250 300, point 250 250)


initialState : Model
initialState =
  { triangles = [ initialTriangle ]
  , circles   = [ initialCircle ]
  }

-------
-- View
-------

drawPoint : Point -> Svg
drawPoint {position, radius} =
  let
      (x,y) = position
  in
    circle
      [ cx    (toString x)
      , cy    (toString y)
      , r     (toString radius)
      , fill  "rgba(0, 0, 255, 1)"
      ]
      []


drawLine : Vector -> Vector -> Svg
drawLine (x1', y1') (x2', y2') =
  line
    [ stroke      "black"
    , strokeWidth "2"
    , x1          (toString x1')
    , x2          (toString x2')
    , y1          (toString y1')
    , y2          (toString y2')
    ]
    []

drawCircle : Circle -> Svg
drawCircle (center, edge) =
  let
      (x1', y1') = center.position
      radius     = distance center.position edge.position
  in
    g
      []
      [ drawPoint center
      , drawPoint edge
      , drawLine center.position edge.position
      , circle
          [ cx          (toString x1')
          , cy          (toString y1')
          , r           (toString radius)
          , fill        "rgba(255,0,0,0.1)"
          , stroke      "black"
          , strokeWidth "2"
          ]
          []
      ]


drawTriangle : Triangle -> Svg
drawTriangle (a,b,c) =
  g
    []
    [ drawPoint a
    , drawPoint b
    , drawPoint c
    , drawLine a.position b.position
    , drawLine b.position c.position
    , drawLine c.position a.position
    ]


drawText : String -> Svg
drawText string =
  text
    [ x         "20"
    , y         "20"
    , fontSize  "20"
    , Html.style
        [ ("-webkit-user-select", "none") ]
    ]
    [ Html.text string ]


view : Model -> Html.Html
view {circles, triangles} =
  let
      view' =
        drawText "The points are draggable" ::
          ( List.map drawCircle circles ++ List.map drawTriangle triangles)
  in
      svg
        [ Html.style
          [ ("border"     , "1px solid black")
          , ("width"      , "800px")
          , ("height"     , "600px")
          , ("display"    , "block")
          , ("margin"     , (toString margin) ++ "px")
          , ("font-family", "Times, serif")
          ]
        ]
        [ g [] view' ]


--------------
-- Page Config
--------------
-- The svg block has a slight margin
-- and therefore the mouse data must take that into account
-- The question of detecting mouse clicks on relatively positioned
-- elements is a common question. This is one way of solving it

margin : Int
margin = 8

correctMouseEvent : MouseEvent -> MouseEvent
correctMouseEvent mouseEvent = case mouseEvent of
  StartAt (x,y) ->
    StartAt (x - margin, y - margin)

  MoveFromTo (x1,y1) (x2,y2) ->
    MoveFromTo (x1 - margin, y1 - margin) (x2 - margin, y2 - margin)

  EndAt (x,y) ->
    EndAt (x - margin, y - margin)


-- This is the mouseEvents with the margin correction
mouseDragEvent : Signal MouseEvent
mouseDragEvent =
  map correctMouseEvent mouseEvents

---------
-- Update
---------

stepPoint : MouseEvent -> Point -> Point
stepPoint mouseEvent point = case mouseEvent of
  StartAt origin ->
    if
      origin `within` point
    then
      { point | selected <- True
              , position <- origin
      }
    else
      { point | selected <- False }

  MoveFromTo origin destination ->
    if
      point.selected
    then
      { point | position <- destination }
    else
      point

  EndAt destination ->
    if
      point.selected
    then
      { point | position <- destination
              , selected <- False
      }
    else
      point


stepTriangle : MouseEvent -> Triangle -> Triangle
stepTriangle mouseEvent (a,b,c) =
  ( stepPoint mouseEvent a
  , stepPoint mouseEvent b
  , stepPoint mouseEvent c
  )


stepCircle : MouseEvent -> Circle -> Circle
stepCircle mouseEvent (center, edge) =
  ( stepPoint mouseEvent center
  , stepPoint mouseEvent edge
  )

step : MouseEvent -> Model -> Model
step mouseEvent model =
  { model | circles   <- List.map (stepCircle mouseEvent)   model.circles
          , triangles <- List.map (stepTriangle mouseEvent) model.triangles
  }

-------
-- Main
-------

main : Signal Html.Html
main =
  map view
    (foldp step initialState mouseDragEvent)

I think this no longer works since it's for an old version of Elm (it lacks "exposing" and uses Signal). Do you have an updated version?