module Graphics.UI.Threepenny.DragNDrop (
    -- * Synopsis
    -- | API for handling drag and drop operations.
    -- 
    -- See the documentation below for details on the drag and drop model.
    -- 
    -- WARNING: Events in this module may not behave as expected.
    -- The model is currently implemented in terms of HTML 5 drag and drop,
    -- but unfortunately,
    -- the HTML 5 specification for drag and drop is horrible and
    -- browser implementations are buggy.
    
    -- * Documentation
    draggable, droppable, dragData,
    DragData,
    drag, dragStart, dragEnd, drop, dragEnter, dragLeave, dragOver,
    ) where

import Prelude hiding (drop)
import Control.Monad
import Graphics.UI.Threepenny.Core

{-----------------------------------------------------------------------------
    Attributes
------------------------------------------------------------------------------}
-- | Enable or disable whether the element can be dragged by the user.
--
-- An element with draggable set to 'True' will receive
-- 'drag', 'dragStart' and 'dragEnd' events.
draggable :: WriteAttr Element Bool
draggable :: WriteAttr Element Bool
draggable = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr Bool -> Element -> UI ()
set
    where
    set :: Bool -> Element -> UI ()
set Bool
v = forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' (String -> WriteAttr Element String
attr String
"draggable") forall a b. (a -> b) -> a -> b
$ if Bool
v then String
"true" else String
"false"

-- | Set the data that is transferred when dragging this element.
dragData :: WriteAttr Element DragData
dragData :: WriteAttr Element String
dragData = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr String -> Element -> UI ()
set
    where
    set :: String -> Element -> UI ()
set String
v = forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' (String -> WriteAttr Element String
attr String
"ondragstart") forall a b. (a -> b) -> a -> b
$
        String
"event.dataTransfer.setData('dragData', '" forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
"')"

-- | Enable or disable whether the element accepts drops.
--
-- An element with 'droppable' set to 'True' will receive
-- 'drop', 'dragOver', 'dragEnter' and 'dragLeave' events.
--
-- Child elements of a 'droppable' element may also be 'droppable'.
-- When dragging something over an element, the closest ancestor element
-- that is 'droppable' will be the target and receive corresponding
-- events.
droppable :: WriteAttr Element Bool
droppable :: WriteAttr Element Bool
droppable = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall {a}. Widget a => Bool -> a -> UI ()
enable
    where
    enable :: Bool -> a -> UI ()
enable Bool
v = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Bool
v then forall {w}. Widget w => w -> UI Element
allowDrop else forall {w}. Widget w => w -> UI Element
blockDrop
    allowDrop :: w -> UI Element
allowDrop w
el =
        forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element w
el
            # set (attr "ondragover") "event.preventDefault()"
            # set (attr "ondrop"    ) "event.preventDefault()"
    blockDrop :: w -> UI Element
blockDrop w
el =
        forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element w
el
            # set (attr "ondragover") ""
            # set (attr "ondrop"    ) ""

{-----------------------------------------------------------------------------
    Events
------------------------------------------------------------------------------}
-- | Data carried by a dragged element. 
--
-- FIXME: Empty data is currently encoded by the empty String.
-- Change this to 'Maybe String' instead.
type DragData = String

withDragData :: Event EventData -> Event String
withDragData = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> String
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => EventData -> a
unsafeFromJSON)
    where
    extract :: [String] -> String
extract [String
s] = String
s
    extract [String]
_   = String
""

-- | Occurs periodically while the element is being dragged around.
drag :: Element -> Event DragData
drag :: Element -> Event String
drag = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"drag"

-- | Dragging the element starts.
dragStart :: Element -> Event DragData
dragStart :: Element -> Event String
dragStart = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"dragstart"

-- | Dragging the element ends.
--
-- WARNING: This event can occur both before and after a corresponding 'drop' event.
dragEnd :: Element -> Event DragData
dragEnd :: Element -> Event String
dragEnd = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"dragend"

-- | The element is now the current target element for a 'drop'.
-- 
-- WARNING: This element is buggy when moving the mouse over child elements.
dragEnter :: Element -> Event DragData
dragEnter :: Element -> Event String
dragEnter = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"dragenter"

-- | Occurs periodically while the element is the current target element.
dragOver :: Element -> Event DragData
dragOver :: Element -> Event String
dragOver = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"dragover"

-- | The element is no longer the current target element for a 'drop'.
--
-- WARNING: This event is also fired when the mouse is moved over a child element.
dragLeave :: Element -> Event DragData
dragLeave :: Element -> Event String
dragLeave = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"dragleave"

-- | The drag and drop operation is being completed on this element.
drop :: Element -> Event DragData
drop :: Element -> Event String
drop = Event EventData -> Event String
withDragData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Event EventData
domEvent String
"drop"