------------------------------------------------------------------
-- |
-- Module      :  Data.DOM.WBTypes
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Minimal glue for BrownPLT and DOM
------------------------------------------------------------------

module Data.DOM.WBTypes (
    castExpr
   ,exprType
   ,(/\)
   ,setjsProperty
  ) where

import BrownPLT.JavaScript
import qualified Data.Foldable as F
import Control.Monad

-- | Cast a BrownPLT Javascript expression to the given type. Type is represented
-- by a value of the desired type (ofter "undefined").

castExpr :: (Functor x) => b -> x a -> x b

castExpr b e = fmap (const b) e

-- | Extract a type from an expression.

exprType :: Expression a -> a

exprType e =
  let f y z = NullLit (undefined :: a)
      (NullLit x) = F.foldr f undefined e
  in  x

-- | An infix version of "castExpr" provided for convenience.

(/\) :: (Functor x) => x a -> b -> x b

(/\) = flip castExpr

-- | A helper function to encode a property setter. This function is mostly called
-- from converted IDL files for DOM interfaces.

setjsProperty :: (Monad m) => String -> Expression a -> Expression this -> m (Expression this)

setjsProperty pn pv this = do
  let tht = exprType this
      fun = FuncExpr tht [Id tht "x"] blk
      thv = VarRef tht (Id tht "x")
      blk = BlockStmt tht [setp, retx]
      setp = ExprStmt tht $ AssignExpr tht OpAssign (DotRef tht thv (Id tht pn)) (pv /\ tht)
      retx = ReturnStmt tht (Just thv)
  return $ ParenExpr tht $ CallExpr tht fun [this]