------------------------------------------------------------------ -- | -- Module : Data.DOM -- Copyright : (c) Dmitry Golubovsky, 2009 -- License : BSD-style -- -- Maintainer : golubovsky@gmail.com -- Stability : experimental -- Portability : portable -- -- This module will most likely be imported by any Haskell program that uses DOM. -- Other modules from Data.DOM namespace are to be imported as needed, sometimes -- qualified because there are some name clashes in attributes and methods across -- the DOM interfaces. -- -- Below is an example of Haskell code which generates Javascript to display -- traditional @Hello World@. This example shows that even a simplest -- "Control.Monad.Identity" will do. Of course, a more sofisticated Monad -- might provide more benefits, such as assigning some of expressions to -- Javascript variables to share and prevent repeated evaluation, -- automatic declaration of functions, etc. -- -- @ -- module Main where -- import "BrownPLT.JavaScript" -- import "BrownPLT.JavaScript.PrettyPrint" -- import "Control.Monad" -- import "Control.Monad.Identity" -- import "Data.DOM" -- import "Data.DOM.Dom" -- import "Data.DOM.Node" -- import "Data.DOM.HTMLDocument" -- main = 'putStrLn' '$' 'show' '$' 'stmt' '$' -- 'FunctionStmt' undefined ('Id' undefined \"main\") [] -- ('ExprStmt' undefined '$' 'runIdentity' q) -- q = do -- d <- 'htmlDocument' -- t <- 'mkText' ('string' \"Hello World\") d -- b <- 'getm'body' d -- 'addChild' t b -- @ -- -- Below is Javascript generated by this example. All expressions just nest -- where necessary, and method calls may be chained. -- -- @ -- function main() -- \{ -- window.document.body.appendChild(window.document.createTextNode(\"Hello World\")); -- \} -- @ ------------------------------------------------------------------ module Data.DOM ( -- * Module Data.DOM.WBTypes re-exported for convenience module Data.DOM.WBTypes -- * Additional DOM support functions ,window ,document ,htmlDocument ,documentBody ,documentHead ,inlineStyle ,inlineStyleDecl ,mkText ,addChild -- * Functions to construct Javascript values ,string ,number ,bool ,true ,false ,unit ) where import Control.Monad import Data.DOM.WBTypes import Data.DOM.WindowObj import Data.DOM.Window import Data.DOM.Dom import Data.DOM.Html2 import Data.DOM.Css import Data.DOM.Node import Data.DOM.Document import Data.DOM.HTMLDocument import BrownPLT.JavaScript #ifdef __HADDOCK__ import BrownPLT.JavaScript.PrettyPrint #endif -- | Access the global Window object. window :: (Monad m) => m (Expression TWindow) window = return $ VarRef TWindow (Id TWindow "window") -- | Access the current document. This indeed should be made through the -- Window interface, but current (incomplete) specification does not -- provide an easy way for that. document :: (Monad m) => m (Expression TDocument) document = return $ VarRef TDocument (Id TDocument "window.document") -- | Same as above, using the HTMLDocument interface. htmlDocument :: (Monad m) => m (Expression THTMLDocument) htmlDocument = return $ VarRef THTMLDocument (Id THTMLDocument "window.document") -- | A maker function for a TEXT element. mkText :: (Monad mn, CDocument this) => Expression String -> Expression this -> mn (Expression TText) mkText = createTextNode -- | Same as 'appendChild', but with type signature reflecting that returned -- value is the node added. addChild :: (Monad m, CNode c, CNode p) => Expression c -> Expression p -> m (Expression c) addChild = appendChild -- | Access the @@ node of the current HTML document. Same as 'get\'body', but with -- proper type of the returned value. documentBody :: (Monad mn, CHTMLDocument this) => Expression this -> mn (Expression THTMLBodyElement) documentBody = get'body -- | Access the @@ node of the current HTML document. documentHead :: (Monad mn, CHTMLDocument this) => Expression this -> mn (Expression THTMLHeadElement) documentHead thisp = do let et = undefined :: THTMLHeadElement let r = DotRef et (thisp /\ et) (Id et "head") return r -- |Obtain an inline style ('TCSS2Properties') interface of an object inlineStyle :: (Monad mn, CHTMLElement this) => Expression this -> mn (Expression TCSS2Properties) inlineStyle thisp = do let et = undefined :: TCSS2Properties let r = DotRef et (thisp /\ et) (Id et "style") return r -- |Obtain an inline style ('TCSSStyleDeclaration') interface of an object inlineStyleDecl :: (Monad mn, CHTMLElement this) => Expression this -> mn (Expression TCSSStyleDeclaration) inlineStyleDecl thisp = do let et = undefined :: TCSSStyleDeclaration let r = DotRef et (thisp /\ et) (Id et "style") return r -- | Create a Javascript string literal out of a string. string :: String -> Expression String string s = StringLit s s -- | Create a Javascript numeric literal out of a numeric value. number :: (Integral n) => n -> Expression Double number n = let d = fromIntegral n in NumLit d d -- | Create a Javascript boolean literal out of a Boolean. bool :: Bool -> Expression Bool bool b = BoolLit b b -- | Javascript True value true :: Expression Bool true = bool True -- | Javascript False value false :: Expression Bool false = bool False -- | A null-expression of type () unit :: Expression () unit = NullLit ()