content: -- |
  --
  -- Copyright   : (C) Keera Studios Ltd, 2013
  -- License     : BSD3
  -- Maintainer  : support@keera.co.uk
  module Hails.MVC.View.HTML where
  
  import Control.Applicative            ((<$>))
  import Control.Monad                  (void)
  import Control.Monad.IO.Class         (liftIO)
  import Control.Monad.Reader           (ask)
  import Data.CBMVar                    (installCallbackCBMVar, newCBMVar,
                                         readCBMVar, writeCBMVar)
  import Data.CBMVar.Reactive           (cbmvarReactiveRO, cbmvarReactiveRW)
  import Data.ReactiveValue
  import Data.String
  import GHCJS.DOM.Element              (IsElement, setInnerHTML)
  import GHCJS.DOM.EventM               (mouseButton, mouseClientXY, on)
  import GHCJS.DOM.EventTargetClosures  (EventName, unsafeEventName)
  import GHCJS.DOM.GlobalEventHandlers  (input, mouseDown, mouseMove)
  import GHCJS.DOM.HTMLElement          (setInnerText)
  import GHCJS.DOM.HTMLInputElement     (getValue, setValue)
  import GHCJS.DOM.HTMLParagraphElement (HTMLParagraphElement (..))
  import GHCJS.DOM.MessageEvent         (getData)
  import GHCJS.DOM.Types                (HTMLElement, HTMLInputElement (..),
                                         IsGlobalEventHandlers, IsHTMLElement,
                                         JSString, MouseEvent, fromJSValUnchecked,
                                         toHTMLElement, toJSString)
  import GHCJS.DOM.WebSocket            (WebSocket, message, sendString)
  
  -- * GHCJS DOM Reactive API
  inputTextReactive :: HTMLInputElement -> ReactiveFieldReadWrite IO String
  inputTextReactive x = ReactiveFieldReadWrite setter getter notifier
   where setter = setValue x
         getter = getValue x
         notifier p = void $ on x input (liftIO p)
  
  htmlElementClick :: IsHTMLElement e => e -> ReactiveFieldRead IO ()
  htmlElementClick e = ReactiveFieldRead (return ()) (\p -> void $ on e' click (liftIO p))
    where
      e' = toHTMLElement e
  
  click :: EventName HTMLElement MouseEvent
  click = unsafeEventName (toJSString "click")
  
  paragraphTextReactive :: HTMLParagraphElement -> ReactiveFieldWrite IO String
  paragraphTextReactive x = ReactiveFieldWrite setter
   where setter = setInnerHTML x
  
  websocketReactive :: WebSocket -> IO (ReactiveFieldReadWrite IO String)
  websocketReactive socket = do
      p <- newCBMVar ""
      void $ on socket message (ask >>= \dt -> getData dt >>= \js -> liftIO (fromJSValUnchecked js) >>= \jss -> liftIO (writeCBMVar p (show (jss :: JSString))))
      let getter     = readCBMVar p
          notifier n = installCallbackCBMVar p n
          setter x   = do
             sendString socket (fromString x :: JSString)
             writeCBMVar p x
      return (ReactiveFieldReadWrite setter getter notifier)
  
  mouseDownReactive :: (IsGlobalEventHandlers a, IsElement a) => a -> ReactiveFieldRead IO ()
  mouseDownReactive s = eventR $ \p -> void $ on s mouseDown (liftIO p)
  
  mousePosElementReactive :: (IsGlobalEventHandlers e, IsElement e) => e -> IO (ReactiveFieldRead IO (Int, Int))
  mousePosElementReactive e = do
    p <- newCBMVar (0,0)
    void $ on e mouseMove (mouseClientXY >>= \pos -> liftIO (writeCBMVar p pos))
    return (cbmvarReactiveRO p)
  