module Data.DOM.HTMLCollection
       (item, namedItem, get'length, getm'length) where
import Data.DOM.Html2
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
item ::
     (Monad mn, CHTMLCollection this, CNode zz) =>
       Expression Double -> Expression this -> mn (Expression zz)
item a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "item")
       return (CallExpr et r [a /\ et])
 
namedItem ::
          (Monad mn, CHTMLCollection this, CNode zz) =>
            Expression String -> Expression this -> mn (Expression zz)
namedItem a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "namedItem")
       return (CallExpr et r [a /\ et])
 
get'length ::
           (Monad mn, CHTMLCollection this) =>
             Expression this -> mn (Expression Double)
get'length thisp
  = do let et = undefined :: Double
       let r = DotRef et (thisp /\ et) (Id et "length")
       return r
 
getm'length ::
            (Monad mn, CHTMLCollection this) =>
              Expression this -> mn (Expression Double)
getm'length = get'length