This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.

DragAndDrop

DragAndDrop

This model is the low-level interface for drag and drop. It can still directly be useful for applications, though.

Model

type Model dragId dropId = Dragging (DraggingData dragId dropId) | NotDragging (NotDraggingData dragId)

The model for the low level drag-and-drop api. It is ment to be stored inside the model of the component using this module.

Along the lines of this:

type alias Model =
    { draggableCatImages : List CatIdentifier
    , droppableCatBaskets : List (List CatIdentifier)
    , dragModel : DragAndDrop.Model CatIdentifier Int
    }

Where the dragId is the CatIdentifier used to find out what cat image was dragged by the user, and dropId is an Int for identifying the basked that the cat image was dropped to.

type alias DraggingData dragId dropId = { dragId : dragId , hoverDropId : Maybe dropId , dragPoint : Mouse.Position , absolutePosition : Mouse.Position }

This is the Model that is present during a Dragging action. The dragId is the element that was dragged, and the hoverDropId is Just dropId, if the user is currently dragging above a droppable element, but has not released the mouse yet, or Nothing if not hovering any droppable element.

Droppable elements are elements with attributes from the functions droppable or droppableHtml.

dragPoint and absolutePosition can be used to show a dragging image/element at the current position of the mouse. dragPoint is the position of the mouse relative to the top left corner of the dragged element when the user initiated the drag and absolutePosition is the current absolute position of the mouse on the page (see Mouse.position)

type alias NotDraggingData dragId = { hoverDragId : Maybe dragId }

This is the Model that is present while no element is being dragged. In this case hoverDragId stores Just dragId if the mouse is currently over a draggable element (see draggable and draggableHtml), but the user did not yet started to drag the element.

init : Model dragId dropId

The initial model for this module's Model

Messages

type Msg dragId dropId = EnterDraggable dragId | LeaveDraggable dragId | EnterDroppable dropId | LeaveDroppable dropId | StartDragging dragId Mouse.Position | UpdatePosition Mouse.Position | StopDragging | NoOp

The messages for this module. Include them in your Msg type like so:

type Msg
    = ...
    | DragAndDropMsg (DragAndDrop.Msg CatIdentifier Int)
type Event dragId dropId = StartedDrag dragId | SuccessfulDrop dragId dropId | FailedDrop dragId

Events that can be produced by the updateWithEvents function after a drop action, that is a user hovering a draggable element, starting to drag the mouse and then releasing the mouse.

If the user has released the mouse while hovering a droppable element, then a SuccessfulDrop dragId dropId, if not, a FailedDrop dragId is generated.

Upon starting to drag a draggable element, a StartedDrag dragId event is produced.

Updating

updateWithEvents : Bool -> Msg dragId dropId -> Model dragId dropId -> ( Model dragId dropId, Maybe (Event dragId dropId) )

Use this method in your update function to receive Events if the user sucessfully drag-and-dropped an element or failed to do so, etc.

Updating can be done sticky, that means a drop is successful, even if the user does not hover the droppable area anymore, but has done so before.

Use it in your update function:

update : Msg -> Model -> Model
update msg model =
    case DragAndDropMsg dndMsg ->
        let ( dragModel, maybeEvent ) =
                updateWithEvents True dndMsg model.dragModel

            newModel = { model | dragModel = dragModel }
        in
        Maybe.withDefault newModel (Maybe.map maybeEvent (updateDrop newModel))

updateDrop : DragAndDrop.Event CatIdentifier Int -> Model -> Model
updateDrop event = ...
update : Msg dragId dropId -> Model dragId dropId -> Model dragId dropId

Similar to updateWithEvents but non-sticky by default and without producing events.

In your own update function:

update : Msg -> Model -> Model
update msg model =
    case msg of
        DragAndDropMsg dragAndDropMsg ->
            { model | dragModel = DragAndDrop.update dragAndDropMsg model.dragModel }

        ... -> ...
subscriptions : Model dragId dropId -> Sub (Msg dragId dropId)

You need to include the subscriptions for this project in order for drop events to be registered, since this listens on Mouse.ups.

Add it to your subscriptions like this:

subscriptions : Sub Msg
subscriptions model =
    Sub.batch
        [ ...
        , Sub.map DragAndDropMsg (DragAndDrop.subscriptions model.dragModel)
        ]

Make Elements draggable/droppable in your View

draggable : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Element.Attribute varying msg)

Make a style-element Element draggable in your view by appending these attributes:

viewCatImage : Model -> CatIdentifier -> Element Style Variation Msg
viewCatImage model identifier =
    Element.el Style
        (DragAndDrop.draggable model.dragModel DragAndDropMsg identifier)
        (viewImage model identifier)
draggableInstant : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Element.Attribute varying msg)

Make a style-element Element draggable in your view by appending these attributes:

viewCatImage : Model -> CatIdentifier -> Element Style Variation Msg
viewCatImage model identifier =
    Element.el Style
        (DragAndDrop.draggable model.dragModel DragAndDropMsg identifier)
        (viewImage model identifier)
droppable : Model dragId dropId -> (Msg dragId dropId -> msg) -> dropId -> List (Element.Attribute varying msg)

Make a style-element Element droppable in your view by appending these attributes:

viewBasket : Model -> Int -> Element Style Variation Msg
viewBasket model basketIndex =
    Element.el Style
        (DragAndDrop.droppable model.dragModel DragAndDropMsg basketIndex)
        renderedBasket
draggableHtml : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Html.Attribute msg)

A version of draggable for usage without the style-elements package, but with elm-lang/html.

droppableHtml : Model dragId dropId -> (Msg dragId dropId -> msg) -> dropId -> List (Html.Attribute msg)

A version of droppable for usage without the style-elements package, but with elm-lang/html.

Querying the Dragging Model

isDragging : Model dragId dropId -> Bool

Find out whether the user is currently dragging an element.

isDraggingId : dragId -> Model dragId dropId -> Bool

Find out whether the user is currently dragging a specific element

isHoveringDraggableId : dragId -> Model dragId dropId -> Bool

Find out wheter the user is currently hovering over a specific draggable element (while not dragging)

isHoveringDroppableId : dropId -> Model dragId dropId -> Bool

Find out whether the user is currently hovering over a specific droppable element (while dragging)

module DragAndDrop
    exposing
        ( DraggingData
        , Event(..)
        , Model(..)
        , Msg(..)
        , NotDraggingData
        , draggable
        , draggableHtml
        , draggableInstant
        , droppable
        , droppableHtml
        , init
        , isDragging
        , isDraggingId
        , isHoveringDraggableId
        , isHoveringDroppableId
        , subscriptions
        , update
        , updateWithEvents
        )

{-|


# DragAndDrop

This model is the low-level interface for drag and drop. It can still directly be
useful for applications, though.


# Model

@docs Model, DraggingData, NotDraggingData, init


# Messages

@docs Msg, Event


# Updating

@docs updateWithEvents, update, subscriptions


# Make Elements draggable/droppable in your View

@docs draggable, draggableInstant, droppable, draggableHtml, droppableHtml


# Querying the Dragging Model

@docs isDragging, isDraggingId, isHoveringDraggableId, isHoveringDroppableId

-}

import Element exposing (Element)
import Element.Attributes as Attr
import Focus exposing (..)
import FocusMore as Focus
import Html exposing (Html)
import Html.Events as HtmlEvents
import Html5.DragDrop
import Json.Decode as Decode exposing (Decoder)
import Mouse


-- Model


{-| This is the Model that is present during a Dragging action. The `dragId`
is the element that was dragged, and the `hoverDropId` is `Just dropId`, if
the user is currently dragging above a droppable element, but has not released
the mouse yet, or `Nothing` if not hovering any droppable element.

Droppable elements are elements with attributes from the functions
`droppable` or `droppableHtml`.

`dragPoint` and `absolutePosition` can be used to show a dragging image/element
at the current position of the mouse. `dragPoint` is the position of the mouse
relative to the top left corner of the dragged element when the user initiated
the drag and `absolutePosition` is the current absolute position of the mouse
on the page (see [Mouse.position](http://package.elm-lang.org/packages/elm-lang/mouse/1.0.1/Mouse))

-}
type alias DraggingData dragId dropId =
    { dragId : dragId
    , hoverDropId : Maybe dropId
    , dragPoint : Mouse.Position
    , absolutePosition : Mouse.Position
    }


{-| This is the Model that is present while no element is being dragged.
In this case `hoverDragId` stores `Just dragId` if the mouse is currently
over a draggable element (see [`draggable`](#draggable) and
[`draggableHtml`](#draggableHtml)), but the user did not yet started to
drag the element.
-}
type alias NotDraggingData dragId =
    { hoverDragId : Maybe dragId }


{-| The model for the low level drag-and-drop api. It is ment to be stored
inside the model of the component using this module.

Along the lines of this:

    type alias Model =
        { draggableCatImages : List CatIdentifier
        , droppableCatBaskets : List (List CatIdentifier)
        , dragModel : DragAndDrop.Model CatIdentifier Int
        }

Where the `dragId` is the `CatIdentifier` used to find out what cat image
was dragged by the user, and `dropId` is an `Int` for identifying the
basked that the cat image was dropped to.

-}
type Model dragId dropId
    = Dragging (DraggingData dragId dropId)
    | NotDragging (NotDraggingData dragId)


{-| The messages for this module. Include them in your Msg type like so:

    type Msg
        = ...
        | DragAndDropMsg (DragAndDrop.Msg CatIdentifier Int)

-}
type Msg dragId dropId
    = EnterDraggable dragId
    | LeaveDraggable dragId
    | EnterDroppable dropId
    | LeaveDroppable dropId
    | StartDragging dragId Mouse.Position
    | UpdatePosition Mouse.Position
    | StopDragging
    | NoOp


{-| Events that can be produced by the [`updateWithEvents`](#updateWithEvents)
function after a drop action, that is a user hovering a draggable element,
starting to drag the mouse and then releasing the mouse.

If the user has released the mouse while hovering a droppable element,
then a `SuccessfulDrop dragId dropId`, if not, a
`FailedDrop dragId` is generated.

Upon starting to drag a draggable element, a `StartedDrag dragId` event is
produced.

-}
type Event dragId dropId
    = StartedDrag dragId
    | SuccessfulDrop dragId dropId
    | FailedDrop dragId


{-| The initial model for this module's `Model`
-}
init : Model dragId dropId
init =
    NotDragging
        { hoverDragId = Nothing }



-- Subscriptions


{-| You need to include the subscriptions for this project in order for
drop events to be registered, since this listens on `Mouse.ups`.

Add it to your subscriptions like this:

    subscriptions : Sub Msg
    subscriptions model =
        Sub.batch
            [ ...
            , Sub.map DragAndDropMsg (DragAndDrop.subscriptions model.dragModel)
            ]

-}
subscriptions : Model dragId dropId -> Sub (Msg dragId dropId)
subscriptions model =
    if isDragging model then
        Sub.batch
            [ Mouse.ups (always StopDragging)
            , Mouse.moves UpdatePosition
            ]
    else
        Sub.none



-- Update


{-| Similar to [`updateWithEvents`](#udpateWithEvents) but non-sticky by
default and without producing events.

In your own update function:

    update : Msg -> Model -> Model
    update msg model =
        case msg of
            DragAndDropMsg dragAndDropMsg ->
                { model | dragModel = DragAndDrop.update dragAndDropMsg model.dragModel }

            ... -> ...

-}
update : Msg dragId dropId -> Model dragId dropId -> Model dragId dropId
update =
    updateHelp False


updateHelp : Bool -> Msg dragId dropId -> Model dragId dropId -> Model dragId dropId
updateHelp sticky msg =
    updateWithEvents sticky msg >> Tuple.first


{-| Use this method in your update function to receive [`Event`](#Event)s if
the user sucessfully drag-and-dropped an element or failed to do so, etc.

Updating can be done sticky, that means a drop is successful, even if the user
does not hover the droppable area anymore, but has done so before.

Use it in your update function:

    update : Msg -> Model -> Model
    update msg model =
        case DragAndDropMsg dndMsg ->
            let ( dragModel, maybeEvent ) =
                    updateWithEvents True dndMsg model.dragModel

                newModel = { model | dragModel = dragModel }
            in
            Maybe.withDefault newModel (Maybe.map maybeEvent (updateDrop newModel))

    updateDrop : DragAndDrop.Event CatIdentifier Int -> Model -> Model
    updateDrop event = ...

-}
updateWithEvents :
    Bool
    -> Msg dragId dropId
    -> Model dragId dropId
    -> ( Model dragId dropId, Maybe (Event dragId dropId) )
updateWithEvents sticky msg model =
    let
        replaceNothingIfEqual value maybe =
            case maybe of
                Just sth ->
                    if value == sth then
                        Nothing
                    else
                        Just sth

                Nothing ->
                    Nothing
    in
    case msg of
        EnterDraggable dragId ->
            ( model & notDragging => hoverDragId .= Just dragId, Nothing )

        LeaveDraggable dragId ->
            ( model & notDragging => hoverDragId $= replaceNothingIfEqual dragId, Nothing )

        EnterDroppable dropId ->
            ( model & dragging => hoverDropId .= Just dropId, Nothing )

        LeaveDroppable dropId ->
            ( model
                |> Focus.when (not sticky)
                    (dragging => hoverDropId $= replaceNothingIfEqual dropId)
            , Nothing
            )

        StartDragging dragId pos ->
            if not (isDragging model) then
                ( Dragging
                    { dragId = dragId
                    , dragPoint = pos
                    , absolutePosition = { x = 0, y = 0 }
                    , hoverDropId = Nothing
                    }
                , Just (StartedDrag dragId)
                )
            else
                ( model, Nothing )

        UpdatePosition newMousePosition ->
            ( model & dragging => absolutePosition .= newMousePosition, Nothing )

        StopDragging ->
            let
                dropEvent dragId =
                    case model of
                        Dragging { hoverDropId } ->
                            case hoverDropId of
                                Just dropId ->
                                    SuccessfulDrop dragId dropId

                                _ ->
                                    FailedDrop dragId

                        _ ->
                            FailedDrop dragId
            in
            ( NotDragging { hoverDragId = Nothing }
            , case model of
                Dragging { dragId } ->
                    Just (dropEvent dragId)

                _ ->
                    Nothing
            )

        NoOp ->
            ( model, Nothing )



-- Attributes


{-| A version of [`draggable`](#draggable) for usage without the
style-elements package, but with elm-lang/html.
-}
draggableHtml : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Html.Attribute msg)
draggableHtml =
    draggableHtmlHelp False


{-| A version of [`draggableHtml`](#draggableHtml) that instantly activates
a drag. Uses dom's mousedown instead of dragstart event.
-}
draggableHtmlInstant : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Html.Attribute msg)
draggableHtmlInstant =
    draggableHtmlHelp True


draggableHtmlHelp : Bool -> Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Html.Attribute msg)
draggableHtmlHelp instant model inject dragId =
    if not (isDragging model) then
        [ HtmlEvents.onMouseOver (inject (EnterDraggable dragId))
        , HtmlEvents.onMouseLeave (inject (LeaveDraggable dragId))
        , (if instant then
            preventingMouseDown
           else
            preventingDragStart
          )
            (\mousePosition -> inject (StartDragging dragId mousePosition))
        ]
            ++ Html5.DragDrop.draggable (\msg -> inject NoOp) dragId
    else
        []


{-| A version of [`droppable`](#droppable) for usage without the
style-elements package, but with elm-lang/html.
-}
droppableHtml : Model dragId dropId -> (Msg dragId dropId -> msg) -> dropId -> List (Html.Attribute msg)
droppableHtml model inject dropId =
    if isDragging model then
        [ HtmlEvents.onMouseOver (inject (EnterDroppable dropId))
        , HtmlEvents.onMouseLeave (inject (LeaveDroppable dropId))

        -- we find out on what droppable was dropped on by model.droppableHover
        ]
    else
        []


{-| Make a style-element `Element` draggable in your view by appending these attributes:

    viewCatImage : Model -> CatIdentifier -> Element Style Variation Msg
    viewCatImage model identifier =
        Element.el Style
            (DragAndDrop.draggable model.dragModel DragAndDropMsg identifier)
            (viewImage model identifier)

-}
draggableInstant : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Element.Attribute varying msg)
draggableInstant model inject dragId =
    List.map Attr.toAttr (draggableHtmlInstant model inject dragId)


{-| Make a style-element `Element` draggable in your view by appending these attributes:

    viewCatImage : Model -> CatIdentifier -> Element Style Variation Msg
    viewCatImage model identifier =
        Element.el Style
            (DragAndDrop.draggable model.dragModel DragAndDropMsg identifier)
            (viewImage model identifier)

-}
draggable : Model dragId dropId -> (Msg dragId dropId -> msg) -> dragId -> List (Element.Attribute varying msg)
draggable model inject dragId =
    List.map Attr.toAttr (draggableHtml model inject dragId)


{-| Make a style-element `Element` droppable in your view by appending these attributes:

    viewBasket : Model -> Int -> Element Style Variation Msg
    viewBasket model basketIndex =
        Element.el Style
            (DragAndDrop.droppable model.dragModel DragAndDropMsg basketIndex)
            renderedBasket

-}
droppable : Model dragId dropId -> (Msg dragId dropId -> msg) -> dropId -> List (Element.Attribute varying msg)
droppable model inject dropId =
    List.map Attr.toAttr (droppableHtml model inject dropId)



-- Querying


{-| Find out whether the user is currently dragging an element.
-}
isDragging : Model dragId dropId -> Bool
isDragging model =
    case model of
        Dragging _ ->
            True

        NotDragging _ ->
            False


{-| Find out whether the user is currently dragging a specific element
-}
isDraggingId : dragId -> Model dragId dropId -> Bool
isDraggingId droppableId model =
    case model of
        Dragging { dragId } ->
            dragId == droppableId

        NotDragging _ ->
            False


{-| Find out wheter the user is currently hovering over a specific draggable
element (while not dragging)
-}
isHoveringDraggableId : dragId -> Model dragId dropId -> Bool
isHoveringDraggableId dragId model =
    case model of
        NotDragging { hoverDragId } ->
            equalsMaybe dragId hoverDragId

        Dragging _ ->
            False


{-| Find out whether the user is currently hovering over a specific droppable
element (while dragging)
-}
isHoveringDroppableId : dropId -> Model dragId dropId -> Bool
isHoveringDroppableId dropId model =
    case model of
        Dragging { hoverDropId } ->
            equalsMaybe dropId hoverDropId

        NotDragging _ ->
            False



-- Internal


equalsMaybe : a -> Maybe a -> Bool
equalsMaybe a maybe =
    Maybe.withDefault False (Maybe.map ((==) a) maybe)


preventingDragStart : (Mouse.Position -> msg) -> Html.Attribute msg
preventingDragStart makeMsg =
    HtmlEvents.onWithOptions "dragstart"
        { stopPropagation = True
        , preventDefault = True
        }
        (relativeMousePosition
            |> Decode.map makeMsg
        )


preventingMouseDown : (Mouse.Position -> msg) -> Html.Attribute msg
preventingMouseDown makeMsg =
    HtmlEvents.onWithOptions "mousedown"
        { stopPropagation = True
        , preventDefault = True
        }
        (relativeMousePosition
            |> Decode.map makeMsg
        )


{-| TODO: Maybe change this to decode to floats, since it's spec actually says so...
-}
relativeMousePosition : Decoder Mouse.Position
relativeMousePosition =
    Decode.map2 Mouse.Position
        (Decode.field "offsetX" Decode.int)
        (Decode.field "offsetY" Decode.int)



-- Lenses


dragging : Focus.FieldSetter (Model dragId dropId) (DraggingData dragId dropId)
dragging f model =
    case model of
        Dragging data ->
            Dragging (f data)

        _ ->
            model


notDragging : Focus.FieldSetter (Model dragId dropId) (NotDraggingData dragId)
notDragging f model =
    case model of
        NotDragging data ->
            NotDragging (f data)

        _ ->
            model


hoverDragId : Focus.FieldSetter (NotDraggingData dragId) (Maybe dragId)
hoverDragId f model =
    { model | hoverDragId = f model.hoverDragId }


hoverDropId : Focus.FieldSetter (DraggingData dragId dropId) (Maybe dropId)
hoverDropId f model =
    { model | hoverDropId = f model.hoverDropId }


absolutePosition : Focus.FieldSetter (DraggingData dragId dropId) Mouse.Position
absolutePosition f model =
    { model | absolutePosition = f model.absolutePosition }