content: {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, OverloadedStrings #-}
  -- | Core types and operations for DOM manipulation.
  module Haste.DOM.Core (
      Elem (..), IsElem (..), Attribute, AttrName (..),
      set, with, attribute, children,
      click, focus, blur,
      document, documentBody, documentHead,
      deleteChild, clearChildren,
      setChildren, getChildren,
      getLastChild, getFirstChild, getChildBefore,
      insertChildBefore, appendChild,
      -- Low level stuff
      jsSet, jsSetAttr, jsSetStyle, jsUnset, jsUnsetAttr,
    ) where
  import Haste.Prim
  import Control.Monad.IO.Class
  import Haste.Prim.Foreign
  import Data.String
  
  jsSet :: Elem -> JSString -> JSString -> IO ()
  jsSet = ffi "(function(e,p,v){e[p] = v;})"
  
  jsUnset :: Elem -> JSString -> IO ()
  jsUnset = ffi "(function(e,p){delete e[p];})"
  
  jsSetAttr :: Elem -> JSString -> JSString -> IO ()
  jsSetAttr = ffi "(function(e,p,v){e.setAttribute(p, v);})"
  
  jsUnsetAttr :: Elem -> JSString -> IO ()
  jsUnsetAttr = ffi "(function(e,p){e.removeAttribute(p);})"
  
  jsSetStyle :: Elem -> JSString -> JSString -> IO ()
  jsSetStyle = ffi "(function(e,p,v){e.style[p] = v;})"
  
  jsAppendChild :: Elem -> Elem -> IO ()
  jsAppendChild = ffi "(function(c,p){p.appendChild(c);})"
  
  jsGetFirstChild :: Elem -> IO (Maybe Elem)
  jsGetFirstChild = ffi "(function(e){\
  for(e = e.firstChild; e != null; e = e.nextSibling)\
    {if(e instanceof HTMLElement) {return e;}}\
  return null;})"
  
  jsGetLastChild :: Elem -> IO (Maybe Elem)
  jsGetLastChild = ffi "(function(e){\
  for(e = e.lastChild; e != null; e = e.previousSibling)\
    {if(e instanceof HTMLElement) {return e;}}\
  return null;})"
  
  jsGetChildren :: Elem -> IO [Elem]
  jsGetChildren = ffi "(function(e){\
  var ch = [];\
  for(e = e.firstChild; e != null; e = e.nextSibling)\
    {if(e instanceof HTMLElement) {ch.push(e);}}\
  return ch;})"
  
  jsSetChildren :: Elem -> [Elem] -> IO ()
  jsSetChildren = ffi "(function(e,ch){\
  while(e.firstChild) {e.removeChild(e.firstChild);}\
  for(var i in ch) {e.appendChild(ch[i]);}})"
  
  jsAddChildBefore :: Elem -> Elem -> Elem -> IO ()
  jsAddChildBefore = ffi "(function(c,p,a){p.insertBefore(c,a);})"
  
  jsGetChildBefore :: Elem -> IO (Maybe Elem)
  jsGetChildBefore = ffi "(function(e){\
  for(; e != null; e = e.previousSibling)\
    {if(e instanceof HTMLElement) {return e;}\
  return null;})"
  
  jsKillChild :: Elem -> Elem -> IO ()
  jsKillChild = ffi "(function(c,p){p.removeChild(c);})"
  
  jsClearChildren :: Elem -> IO ()
  jsClearChildren = ffi "(function(e){\
  while(e.firstChild){e.removeChild(e.firstChild);}})"
  
  -- | A DOM node.
  newtype Elem = Elem JSAny
    deriving (ToAny, FromAny)
  
  -- | The class of types backed by DOM elements.
  class IsElem a where
    -- | Get the element representing the object.
    elemOf :: a -> Elem
  
    -- | Attempt to create a DOM element backed object from an 'Elem'.
    --   The default instance always returns @Nothing@.
    fromElem :: MonadIO m => Elem -> m (Maybe a)
    fromElem = const $ return Nothing
  
  instance IsElem Elem where
    elemOf = id
    fromElem = return . Just
  
  -- | The name of an attribute. May be either a common property, an HTML
  --   attribute or a style attribute.
  data AttrName
    = PropName  !JSString
    | StyleName !JSString
    | AttrName  !JSString
    deriving (Eq, Ord)
  
  instance IsString AttrName where
    fromString = PropName . fromString
  
  -- | A key/value pair representing the value of an attribute.
  --   May represent a property, an HTML attribute, a style attribute or a list
  --   of child elements.
  data Attribute
    = Attribute !AttrName !JSString
    | Children ![Elem]
  
  -- | Construct an 'Attribute'.
  attribute :: AttrName -> JSString -> Attribute
  attribute = Attribute
  
  -- | Set a number of 'Attribute's on an element.
  set :: (IsElem e, MonadIO m) => e -> [Attribute] -> m ()
  set e as =
      liftIO $ mapM_ set' as
    where
      e' = elemOf e
      set' (Attribute (PropName k) v)  = jsSet e' k v
      set' (Attribute (StyleName k) v) = jsSetStyle e' k v
      set' (Attribute (AttrName k) v)  = jsSetAttr e' k v
      set' (Children cs)               = mapM_ (flip jsAppendChild e') cs
  
  -- | Attribute adding a list of child nodes to an element.
  children :: [Elem] -> Attribute
  children = Children
  
  -- | Set a number of 'Attribute's on the element produced by an IO action.
  --   Gives more convenient syntax when creating elements:
  --
  --   > newElem "div" `with` [
  --   >     style "border" =: "1px solid black",
  --   >     ...
  --   >   ]
  --
  with :: (IsElem e, MonadIO m) => m e -> [Attribute] -> m e
  with m attrs = do
    x <- m
    set x attrs
    return x
  
  -- | Generate a click event on an element.
  click :: (IsElem e, MonadIO m) => e -> m ()
  click = liftIO . click' . elemOf
  
  click' :: Elem -> IO ()
  click' = ffi "(function(e) {e.click();})"
  
  -- | Generate a focus event on an element.
  focus :: (IsElem e, MonadIO m) => e -> m ()
  focus = liftIO . focus' . elemOf
  
  focus' :: Elem -> IO ()
  focus' = ffi "(function(e) {e.focus();})"
  
  -- | Generate a blur event on an element.
  blur :: (IsElem e, MonadIO m) => e -> m ()
  blur = liftIO . blur' . elemOf
  
  blur' :: Elem -> IO ()
  blur' = ffi "(function(e) {e.blur();})"
  
  -- | The DOM node corresponding to @document@.
  document :: Elem
  document = constant "document"
  
  -- | The DOM node corresponding to @document.body@.
  documentBody :: Elem
  documentBody = constant "document.body"
  
  -- | The DOM node corresponding to @document.head@.
  documentHead :: Elem
  documentHead = constant "document.body"
  
  -- | Append the second element as a child of the first.
  appendChild :: (IsElem parent, IsElem child, MonadIO m) => parent -> child -> m ()
  appendChild parent child = liftIO $ jsAppendChild (elemOf child) (elemOf parent)
  
  -- | Insert an element into a container, before another element.
  --   For instance:
  -- @
  --   insertChildBefore theContainer olderChild childToAdd
  -- @
  insertChildBefore :: (IsElem parent, IsElem before, IsElem child, MonadIO m)
                 => parent -> before -> child -> m ()
  insertChildBefore parent oldChild child =
    liftIO $ jsAddChildBefore (elemOf child) (elemOf parent) (elemOf oldChild)
  
  -- | Get the sibling before the given one, if any.
  getChildBefore :: (IsElem e, MonadIO m) => e -> m (Maybe Elem)
  getChildBefore e = liftIO $ jsGetChildBefore (elemOf e)
  
  -- | Get the first of an element's children.
  getFirstChild :: (IsElem e, MonadIO m) => e -> m (Maybe Elem)
  getFirstChild e = liftIO $ jsGetFirstChild (elemOf e)
  
  -- | Get the last of an element's children.
  getLastChild :: (IsElem e, MonadIO m) => e -> m (Maybe Elem)
  getLastChild e = liftIO $ jsGetLastChild (elemOf e)
  
  -- | Get a list of all children belonging to a certain element.
  getChildren :: (IsElem e, MonadIO m) => e -> m [Elem]
  getChildren e = liftIO $ jsGetChildren (elemOf e)
  
  -- | Clear the given element's list of children, and append all given children
  --   to it.
  setChildren :: (IsElem parent, IsElem child, MonadIO m)
              => parent
              -> [child]
              -> m ()
  setChildren e ch = liftIO $ jsSetChildren (elemOf e) (map elemOf ch)
  
  -- | Remove all children from the given element.
  clearChildren :: (IsElem e, MonadIO m) => e -> m ()
  clearChildren = liftIO . jsClearChildren . elemOf
  
  -- | Remove the second element from the first's children.
  deleteChild :: (IsElem parent, IsElem child, MonadIO m)
              => parent
              -> child
              -> m ()
  deleteChild parent child = liftIO $ jsKillChild (elemOf child) (elemOf parent)
  