module Main where

import Prelude hiding (putStrLn)
import System.IO.UTF8
import BrownPLT.JavaScript
import BrownPLT.JavaScript.PrettyPrint
import Control.Monad
import Language.JSMW
import Language.JSMW.Arith

import BrownPLT.JavaScript.Syntax
import Control.Monad.RWS
import Foreign.WebIDL.Dom.Node
import Foreign.WebIDL.Dom.Text
import Foreign.WebIDL.Dom.Document
import Foreign.WebIDL.Dom.Element
import Foreign.WebIDL.Html2.HTMLDocument
import Foreign.WebIDL.Html2.HTMLHRElement
import Foreign.WebIDL.Html2.HTMLInputElement
import Foreign.WebIDL.Keycodes.KeyEvent
import Foreign.WebIDL.Html2.HTMLElement
import Foreign.WebIDL.Events.Event
import Foreign.WebIDL.Html2.HTMLBodyElement

-- Main function: generate Javascript.

main = putStrLn $ show $ stmt $ 
  FunctionStmt undefined (Id undefined "main") [] (getBlock (runJSMWWith currDocBody 0 q))

-- Toplevel expression.

q = do
  passive (mkText $ string 
    "Example 1: Press Enter to increase value, Shift-Enter to decrease value")
  passive mkHr
  mkInput `container` (do 
    setHandler "keypress" plusOne
    ask >>= set'value (string "0") >>= focus)

-- Handler for the input element.

plusOne :: OnHandler TKeyEvent THTMLInputElement

plusOne e = do
  c <- getm'keyCode e
  switch (c) $ do
    cDOM_VK_ENTER --> do i <- ask 
                         v <- getm'value i
                         vv <- switch v $ do
                           "" --> stringM "0"
                           none (return v)
                         n <- parseInt vv 0
                         shft <- get'shiftKey e
                         n2 <- switch shft $ do
                           True --> return (n - number 1)
                           False --> return (n + number 1)
                         once =<< (toString n2 >>= flip set'value i)
                         return false
    none (return true)

-- Helper functions.

-- These instances are needed in order to use HTML elements as containers.

instance JContainer THTMLBodyElement
instance JContainer THTMLInputElement

-- Element creation function type.

type ECRF e n = Expression THTMLDocument -> JSMW e (Expression n)

-- Type for an event handler.

type OnHandler e c = Expression e -> JSMW c (Expression Bool)

-- Body of the current document to use as a toplevel container.

currDocBody :: Expression THTMLBodyElement
currDocBody = VarRef THTMLBodyElement (Id THTMLBodyElement "window.document.body")

-- Insert a passive element into a current container

passive :: (CNode n, CElement e)
        => ECRF e n
        -> JSMW e (Expression ())

passive crf = do
  cntr <- ask
  doc <- get'ownerDocument cntr
  e <- once =<< crf doc
  once =<< addChild e cntr
  return $ NullLit ()

-- Specify a new container, nested into the current one.

container :: (JContainer n, CElement n, CElement e)
          => ECRF e n
          -> JSMW n (Expression x)
          -> JSMW e (Expression ())

container crf cnt = do
  curc <- once =<< ask
  doc <- once =<< get'ownerDocument curc
  newc <- once =<< crf doc
  once =<< addChild newc curc
  carg <- mkNewVar
  st <- get
  let et = exprType newc
      (finx, fins, stms) = runJSMWWith (VarRef et (Id et carg)) st cnt
      blk = getBlock (finx, fins, stms)
      fun = ParenExpr () (FuncExpr () [Id () carg] blk)
      call = CallExpr () fun [newc /\ ()]
  writeStmt (ExprStmt () call)
  put fins
  return $ NullLit ()

-- Install an event handler on an element.

setHandler :: (JContainer c, CHTMLElement c, CEvent e)
            => String -> OnHandler e c -> JSMW c (Expression ())

setHandler s x = do
  ctr <- once =<< ask
  earg <- mkNewVar
  st <- get
  let et = undefined :: e
      prop = "on" ++ s
      evar = VarRef et (Id et earg)
      (finx, fins, stms) = runJSMWWith ctr st (x evar)
      msievent = IfSingleStmt () (PrefixExpr () PrefixLNot (evar /\ ()))
                   (BlockStmt () [ExprStmt ()
                                   (AssignExpr () OpAssign (evar /\ ())
                                                           (VarRef () (Id () "window.event")))])
      blk = getBlock (finx, fins, msievent : stms)    
      fun = FuncExpr () [Id () earg] blk              
      seth = ExprStmt () $ AssignExpr () OpAssign (DotRef () (ctr /\ ()) (Id () prop)) (fun /\ ())
  writeStmt seth
  put fins
  return (NullLit ())

-- Create a text node (short-cut for createTextNode)

mkText :: (Monad mn, CDocument this) => 
   Expression String -> Expression this -> mn (Expression TText)
mkText = createTextNode

-- Insert a child element into a node (short-cut for appendChild)

addChild :: (Monad m, CNode c, CNode p) => Expression c -> Expression p -> m (Expression c)
addChild = appendChild