HJScript 0.4.6 → 0.4.7
raw patch · 26 files changed
+796/−796 lines, 26 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- HJScript.cabal +2/−2
- src/HJScript.hs +14/−14
- src/HJScript/Ajax.hs +1/−1
- src/HJScript/DOM.hs +13/−13
- src/HJScript/DOM/AttributeNode.hs +36/−36
- src/HJScript/DOM/Document.hs +23/−23
- src/HJScript/DOM/ElementNode.hs +66/−66
- src/HJScript/DOM/NamedNodeMap.hs +31/−31
- src/HJScript/DOM/Node.hs +64/−64
- src/HJScript/DOM/NodeTypes.hs +52/−52
- src/HJScript/DOM/TextNode.hs +57/−57
- src/HJScript/DOM/Window.hs +42/−42
- src/HJScript/DOM/XHTML.hs +79/−79
- src/HJScript/Lang.hs +47/−47
- src/HJScript/Monad.hs +20/−20
- src/HJScript/Objects/ActiveXObject.hs +26/−26
- src/HJScript/Objects/Array.hs +7/−7
- src/HJScript/Objects/Boolean.hs +6/−6
- src/HJScript/Objects/Date.hs +7/−7
- src/HJScript/Objects/JQuery.hs +1/−1
- src/HJScript/Objects/Math.hs +6/−6
- src/HJScript/Objects/RegExp.hs +6/−6
- src/HJScript/Objects/String.hs +7/−7
- src/HJScript/Objects/XMLHttpRequest.hs +67/−67
- src/HJScript/Utils.hs +6/−6
- src/HJScript/XMLGenerator.hs +110/−110
HJScript.cabal view
@@ -1,5 +1,5 @@ Name: HJScript-Version: 0.4.6+Version: 0.4.7 License: BSD3 Author: Joel Bjornson, joel.bjornson@gmail.com, Niklas Broberg, nibro@cs.chalmers.se@@ -45,7 +45,7 @@ Cabal-Version: >= 1.2.3-Build-Depends: base <= 4, HJavaScript >= 0.4.4, mtl, hsx >= 0.4.4+Build-Depends: base < 5, HJavaScript >= 0.4.4, mtl, hsx >= 0.4.4 Build-Type: Simple Category: Web, Language
src/HJScript.hs view
@@ -1,19 +1,19 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- | --- Module : HJScript --- License : BSD-style +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : HJScript+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript ( module HJScript.Monad,- module HJScript.Lang, - module HJScript.XMLGenerator, - module HJScript.Events, - module HJScript.Ajax, + module HJScript.Lang,+ module HJScript.XMLGenerator,+ module HJScript.Events,+ module HJScript.Ajax, module HJScript.Objects.Array, module HJScript.Objects.Boolean, module HJScript.Objects.Date,@@ -24,9 +24,9 @@ import HJScript.Monad import HJScript.Lang-import HJScript.XMLGenerator -import HJScript.Events -import HJScript.Ajax +import HJScript.XMLGenerator+import HJScript.Events+import HJScript.Ajax import HJScript.Objects.Array import HJScript.Objects.Boolean import HJScript.Objects.Date
src/HJScript/Ajax.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ----------------------------------------------------------------------------- -- Module : HJScript.Ajax -- Copyright : (c) Joel Björnson 2006
src/HJScript/DOM.hs view
@@ -1,29 +1,29 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM --- Copyright : (c) Joel Bjornson 2008 --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM+-- Copyright : (c) Joel Bjornson 2008+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM ( module HJScript.DOM.NodeTypes,- module HJScript.DOM.Node, + module HJScript.DOM.Node, module HJScript.DOM.Document, module HJScript.DOM.ElementNode,- module HJScript.DOM.AttributeNode, - module HJScript.DOM.TextNode, + module HJScript.DOM.AttributeNode,+ module HJScript.DOM.TextNode, module HJScript.DOM.Window, module HJScript.DOM.XHTML ) where import HJScript.DOM.NodeTypes (NodeType(..), nodeTypeVal)-import HJScript.DOM.Node +import HJScript.DOM.Node import HJScript.DOM.Document import HJScript.DOM.ElementNode-import HJScript.DOM.AttributeNode -import HJScript.DOM.TextNode +import HJScript.DOM.AttributeNode+import HJScript.DOM.TextNode import HJScript.DOM.Window import HJScript.DOM.XHTML
src/HJScript/DOM/AttributeNode.hs view
@@ -1,36 +1,36 @@-module HJScript.DOM.AttributeNode - ( - AttributeNode(..), - - name, specified, value - - ) where - -import HJScript.Lang - -import HJScript.DOM.NodeTypes -import HJScript.DOM.Node - - ----------------------------------------------------- --- the AttributeNode object type ----------------------------------------------------- --- data AttributeNode = AttributeNode deriving Show (in NodeTypes - -instance IsClass AttributeNode - --- inherit all the Node properties and methods -instance IsNode AttributeNode - ----------------------------------------------------- --- properties ----------------------------------------------------- - -name :: Exp AttributeNode -> JString -name = deref "name" - -specified :: Exp AttributeNode -> JBool -specified = deref "specified" - -value :: Exp AttributeNode -> Var String -value = derefVar "value" +module HJScript.DOM.AttributeNode + (+ AttributeNode(..),+ + name, specified, value ++ ) where++import HJScript.Lang++import HJScript.DOM.NodeTypes+import HJScript.DOM.Node+++----------------------------------------------------+-- the AttributeNode object type+----------------------------------------------------+-- data AttributeNode = AttributeNode deriving Show (in NodeTypes++instance IsClass AttributeNode++-- inherit all the Node properties and methods+instance IsNode AttributeNode++----------------------------------------------------+-- properties+----------------------------------------------------++name :: Exp AttributeNode -> JString+name = deref "name"++specified :: Exp AttributeNode -> JBool+specified = deref "specified"++value :: Exp AttributeNode -> Var String+value = derefVar "value"
src/HJScript/DOM/Document.hs view
@@ -1,10 +1,10 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM.Document --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM.Document+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM.Document (@@ -22,14 +22,14 @@ -- Methods createAttribute, createElement, createTextNode, getElementById, getElementsByTagName,- write, writeln + write, writeln ) where import HJScript.Lang import HJScript.DOM.NodeTypes import HJScript.DOM.XHTML- + -- In NodeTypes to avoid cyclic dependency: -- data Document = Document deriving Show instance IsClass Document@@ -43,11 +43,11 @@ ---------------------------------------------------- anchors :: Exp Document -> JArray Anchor anchors = deref "anchors"- + -- Not standard? applets :: Exp Document -> JArray Object applets = deref "applets"- + -- Not standard? embeds :: Exp Document -> JArray ElementNode embeds = deref "embeds"@@ -61,11 +61,11 @@ links :: Exp Document -> JArray Link links = deref "links" --- Not standard? +-- Not standard? stylesheets :: Exp Document -> JArray Style stylesheets = deref "stylesheets" --- Not standard? +-- Not standard? alinkColor :: Exp Document -> JString alinkColor = deref "alinkColor" @@ -84,7 +84,7 @@ lastModified :: Exp Document -> JString lastModified = deref "lastModified" --- Not standard? +-- Not standard? linkColor :: Exp Document -> JString linkColor = deref "linkColor" @@ -94,9 +94,9 @@ url :: Exp Document -> JString url = deref "url" -title :: Exp Document -> JString -title = deref "title" - +title :: Exp Document -> JString +title = deref "title"+ vlinkColor :: Exp Document -> JString vlinkColor = deref "vlinkColor" @@ -115,11 +115,11 @@ getElementById :: JString -> Exp Document -> Exp ElementNode getElementById = methodCall "getElementById" -getElementsByTagName :: JString -> Exp Document -> JArray ElementNode -getElementsByTagName = methodCall "getElementsByTagName" - -write :: JString -> Exp Document -> HJScript () -write = callVoidMethod "write" - -writeln :: JString -> Exp Document -> HJScript () +getElementsByTagName :: JString -> Exp Document -> JArray ElementNode+getElementsByTagName = methodCall "getElementsByTagName"++write :: JString -> Exp Document -> HJScript ()+write = callVoidMethod "write"++writeln :: JString -> Exp Document -> HJScript () writeln = callVoidMethod "writeln"
src/HJScript/DOM/ElementNode.hs view
@@ -1,16 +1,16 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM.ElementNode --- Copyright : (c) Joel Bjornson 2008 --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM.ElementNode+-- Copyright : (c) Joel Bjornson 2008+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM.ElementNode (- ElementNode(..), IsElementNode, - + ElementNode(..), IsElementNode,+ -- Properties attributes, childNodes, firstChild, lastChild, localName, nextSibling,@@ -27,48 +27,48 @@ import HJScript.Lang import HJScript.DOM.NodeTypes-import HJScript.DOM.Node -import HJScript.DOM.NamedNodeMap - ----------------------------------------------------- --- The ElementNode type ----------------------------------------------------- --- data ElementNode = ElementNode deriving Show - -instance IsClass ElementNode -instance IsNode ElementNode - -class IsClass n => IsElementNode n -instance IsElementNode ElementNode +import HJScript.DOM.Node+import HJScript.DOM.NamedNodeMap ----------------------------------------------------+-- The ElementNode type+----------------------------------------------------+-- data ElementNode = ElementNode deriving Show++instance IsClass ElementNode+instance IsNode ElementNode++class IsClass n => IsElementNode n+instance IsElementNode ElementNode++---------------------------------------------------- -- Properties ---------------------------------------------------- attributes :: IsElementNode n => Exp n -> Exp NamedNodeMap attributes = deref "attributes" -childNodes :: IsElementNode n => Exp n -> JArray Node -childNodes = deref "childNodes" - -firstChild :: IsElementNode n => Exp n -> Exp Node -firstChild = deref "firstChild" - -lastChild :: IsElementNode n => Exp n -> Exp Node -lastChild = deref "lastChild" - -localName :: IsElementNode n => Exp n -> JString -localName = deref "localName" - -nextSibling :: IsElementNode n => Exp n -> Exp Node -nextSibling = deref "nextSibling" - -parentNode :: IsElementNode n => Exp n -> Exp Node -parentNode = deref "parentNode" - -previousSibling :: IsElementNode n => Exp n -> Exp Node -previousSibling = deref "previousSibling" +childNodes :: IsElementNode n => Exp n -> JArray Node+childNodes = deref "childNodes" -tagName :: IsElementNode o => Exp o -> JString +firstChild :: IsElementNode n => Exp n -> Exp Node+firstChild = deref "firstChild"++lastChild :: IsElementNode n => Exp n -> Exp Node+lastChild = deref "lastChild"++localName :: IsElementNode n => Exp n -> JString+localName = deref "localName"++nextSibling :: IsElementNode n => Exp n -> Exp Node+nextSibling = deref "nextSibling"++parentNode :: IsElementNode n => Exp n -> Exp Node+parentNode = deref "parentNode"++previousSibling :: IsElementNode n => Exp n -> Exp Node+previousSibling = deref "previousSibling"++tagName :: IsElementNode o => Exp o -> JString tagName = deref "tagName" scrollTop :: IsElementNode o => Exp o -> Exp JInt@@ -84,13 +84,13 @@ scrollHeightVar exp = JDerefVar exp "scrollHeight" - + ---------------------------------------------------- -- Methods -----------------------------------------------------appendChild :: (IsElementNode n, IsNode c) => Exp c -> Exp n -> HJScript () -appendChild = callVoidMethod "appendChild" - +appendChild :: (IsElementNode n, IsNode c) => Exp c -> Exp n -> HJScript ()+appendChild = callVoidMethod "appendChild"+ getAttribute :: IsElementNode n => JString -> Exp n -> JString getAttribute = methodCall "getAttribute" @@ -100,32 +100,32 @@ hasAttribute :: IsElementNode n => JString -> Exp n -> JBool hasAttribute = methodCall "hasAttribute" -hasAttributes :: IsElementNode n => Exp n -> JBool -hasAttributes = methodCall "hasAttributes" () - -hasChildNodes :: IsElementNode n => Exp n -> JBool -hasChildNodes = methodCall "hasChildNodes" () - -insertBefore :: IsElementNode n => - Exp Node -> Exp Node -> Exp n -> HJScript () -insertBefore b a = callVoidMethod "insertBefore" (b,a) - -normalize :: IsElementNode n => Exp n -> HJScript () -normalize = callVoidMethod "normalize" () - +hasAttributes :: IsElementNode n => Exp n -> JBool+hasAttributes = methodCall "hasAttributes" ()++hasChildNodes :: IsElementNode n => Exp n -> JBool +hasChildNodes = methodCall "hasChildNodes" ()++insertBefore :: IsElementNode n => + Exp Node -> Exp Node -> Exp n -> HJScript ()+insertBefore b a = callVoidMethod "insertBefore" (b,a)++normalize :: IsElementNode n => Exp n -> HJScript ()+normalize = callVoidMethod "normalize" ()+ removeAttribute :: IsElementNode n => JString -> Exp n -> HJScript () removeAttribute = callVoidMethod "removeAttribute" removeAttributeNode :: IsElementNode n => Exp AttributeNode -> Exp n -> HJScript () removeAttributeNode = callVoidMethod "removeAttributeNode" -removeChild :: (IsElementNode n, IsNode c) => Exp c -> Exp n -> HJScript () -removeChild = callVoidMethod "removeChild" - +removeChild :: (IsElementNode n, IsNode c) => Exp c -> Exp n -> HJScript ()+removeChild = callVoidMethod "removeChild"+ replaceChild :: (IsElementNode n, IsNode c, IsNode d) => - Exp c -> Exp d -> Exp n -> HJScript () -replaceChild = curry $ callVoidMethod "replaceChild" - + Exp c -> Exp d -> Exp n -> HJScript ()+replaceChild = curry $ callVoidMethod "replaceChild"+ setAttribute :: IsElementNode n => JString -> JString -> Exp n -> HJScript () setAttribute = curry $ callVoidMethod "setAttribute"
src/HJScript/DOM/NamedNodeMap.hs view
@@ -1,32 +1,32 @@-module HJScript.DOM.NamedNodeMap where - -import HJScript.Lang - -import HJScript.DOM.NodeTypes (AttributeNode) - ----------------------------------------------------- --- the NamedNodeMap object type ----------------------------------------------------- -data NamedNodeMap = NamedNodeMap deriving Show - -instance IsClass NamedNodeMap - ----------------------------------------------------- --- properties ----------------------------------------------------- - -length :: Exp NamedNodeMap -> JInt -length = deref "length" - ----------------------------------------------------- --- methods ----------------------------------------------------- - -getNamedItem :: JString -> Exp NamedNodeMap -> Exp AttributeNode -getNamedItem = methodCall "getNamedItem" - -item :: JInt -> Exp NamedNodeMap -> Exp AttributeNode -item = methodCall "item" - -removeNamedItem :: JString -> Exp NamedNodeMap -> Exp AttributeNode +module HJScript.DOM.NamedNodeMap where++import HJScript.Lang++import HJScript.DOM.NodeTypes (AttributeNode)++----------------------------------------------------+-- the NamedNodeMap object type+----------------------------------------------------+data NamedNodeMap = NamedNodeMap deriving Show++instance IsClass NamedNodeMap++----------------------------------------------------+-- properties+----------------------------------------------------++length :: Exp NamedNodeMap -> JInt+length = deref "length"++----------------------------------------------------+-- methods+----------------------------------------------------++getNamedItem :: JString -> Exp NamedNodeMap -> Exp AttributeNode+getNamedItem = methodCall "getNamedItem"++item :: JInt -> Exp NamedNodeMap -> Exp AttributeNode+item = methodCall "item"++removeNamedItem :: JString -> Exp NamedNodeMap -> Exp AttributeNode removeNamedItem = methodCall "removeNamedItem"
src/HJScript/DOM/Node.hs view
@@ -1,64 +1,64 @@-module HJScript.DOM.Node ( - Node(..), IsNode(..), - - NodeType(..), nodeTypeVal, - - nodeName, nodeType, nodeValue, - ownerDocument, prefix, cloneNode - ) where - -import HJScript.Lang - ---import HJScript.DOM.Document -import HJScript.DOM.NodeTypes - ----------------------------------------------------- --- the Node object type ----------------------------------------------------- --- data Node = Node deriving Show (is in NodeTypes) - -instance IsClass Node - -class IsClass n => IsNode n where - castToNode :: JObject n -> JObject Node - castToNode = castObject - castFromNode :: JObject Node -> JObject n - castFromNode = castObject - -instance IsNode Node where - castToNode = id - castFromNode = id - - - ----------------------------------------------------- --- Properties for Nodes ----------------------------------------------------- - --- We move all properties dealing with children, siblings --- and parents to ElementNode, since in our simple model --- they only make sense on (subclasses of) Element nodes --- anyway. - -nodeName :: IsNode n => Exp n -> JString -nodeName = deref "nodeName" - -nodeType :: IsNode n => Exp n -> JInt -nodeType = deref "nodeType" - -nodeValue :: IsNode n => Exp n -> Var String -nodeValue = derefVar "nodeValue" - -ownerDocument :: IsNode n => Exp n -> Exp Document -ownerDocument = deref "ownerDocument" - -prefix :: IsNode n => Exp n -> Exp String -prefix = deref "prefix" - ----------------------------------------------------- --- Methods for Nodes ----------------------------------------------------- - -cloneNode :: IsNode n => JBool -> Exp n -> Exp n -cloneNode = methodCall "cloneNode" - +module HJScript.DOM.Node (+ Node(..), IsNode(..),+ + NodeType(..), nodeTypeVal,+ + nodeName, nodeType, nodeValue, + ownerDocument, prefix, cloneNode+ ) where++import HJScript.Lang++--import HJScript.DOM.Document+import HJScript.DOM.NodeTypes++----------------------------------------------------+-- the Node object type+----------------------------------------------------+-- data Node = Node deriving Show (is in NodeTypes)++instance IsClass Node++class IsClass n => IsNode n where+ castToNode :: JObject n -> JObject Node+ castToNode = castObject+ castFromNode :: JObject Node -> JObject n+ castFromNode = castObject++instance IsNode Node where+ castToNode = id+ castFromNode = id++++----------------------------------------------------+-- Properties for Nodes+----------------------------------------------------++-- We move all properties dealing with children, siblings+-- and parents to ElementNode, since in our simple model +-- they only make sense on (subclasses of) Element nodes +-- anyway.++nodeName :: IsNode n => Exp n -> JString +nodeName = deref "nodeName"++nodeType :: IsNode n => Exp n -> JInt +nodeType = deref "nodeType"++nodeValue :: IsNode n => Exp n -> Var String +nodeValue = derefVar "nodeValue"++ownerDocument :: IsNode n => Exp n -> Exp Document+ownerDocument = deref "ownerDocument"++prefix :: IsNode n => Exp n -> Exp String+prefix = deref "prefix"++----------------------------------------------------+-- Methods for Nodes+----------------------------------------------------++cloneNode :: IsNode n => JBool -> Exp n -> Exp n+cloneNode = methodCall "cloneNode"+
src/HJScript/DOM/NodeTypes.hs view
@@ -1,14 +1,14 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM.NodeTypes --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM.NodeTypes+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM.NodeTypes (- NodeType(..), + NodeType(..), -- Node types Node(..), ElementNode(..), AttributeNode(..), TextNode(..), -- CDataSectionNode, EntityReferenceNode, EntityNode,@@ -17,54 +17,54 @@ -- Functions nodeTypeVal,- - -- Document to avoid cycle - Document(..) + + -- Document to avoid cycle+ Document(..) ) where import HJScript.Lang ----------------------------------------------------- --- Node types ----------------------------------------------------- - --- | Different node types -data NodeType - = NodeElement - | NodeAttribute - | NodeText - | NodeCDataSection - | NodeEntety - | NodeEntetyRef - | NodeProccInstr - | NodeComment - | NodeDocument - | NodeDocType - | NodeDocFrag - | NodeNotation - - --- Maps node type to type value -nodeTypeVal :: NodeType -> JInt -nodeTypeVal tp = JInt $ case tp of - NodeElement -> 1 - NodeAttribute -> 2 - NodeText -> 3 - NodeCDataSection -> 4 - NodeEntety -> 5 - NodeEntetyRef -> 6 - NodeProccInstr -> 7 - NodeComment -> 8 - NodeDocument -> 9 - NodeDocType -> 10 - NodeDocFrag -> 11 - NodeNotation -> 12 - ----------------------------------------------------+-- Node types+----------------------------------------------------++-- | Different node types+data NodeType + = NodeElement+ | NodeAttribute+ | NodeText+ | NodeCDataSection+ | NodeEntety+ | NodeEntetyRef+ | NodeProccInstr+ | NodeComment+ | NodeDocument+ | NodeDocType+ | NodeDocFrag+ | NodeNotation+++-- Maps node type to type value+nodeTypeVal :: NodeType -> JInt +nodeTypeVal tp = JInt $ case tp of+ NodeElement -> 1+ NodeAttribute -> 2+ NodeText -> 3+ NodeCDataSection -> 4+ NodeEntety -> 5+ NodeEntetyRef -> 6+ NodeProccInstr -> 7+ NodeComment -> 8+ NodeDocument -> 9+ NodeDocType -> 10+ NodeDocFrag -> 11+ NodeNotation -> 12++---------------------------------------------------- -- Classes for shared properties and methods ---------------------------------------------------- --- Generic Node -data Node = Node deriving Show +-- Generic Node+data Node = Node deriving Show -- ElementNode data ElementNode = ElementNode deriving Show@@ -74,7 +74,7 @@ -- TextNode data TextNode = TextNode deriving Show- + {- I see no need to include these at this point. -- CDataSectionNode data CDataSectionNode = CDataSectionNode deriving Show@@ -99,7 +99,7 @@ -- NotationNode data NotationNode = NotationNode deriving Show--} - --- We need to include this here to avoid a cyclic dependency +-}++-- We need to include this here to avoid a cyclic dependency data Document = Document deriving Show
src/HJScript/DOM/TextNode.hs view
@@ -1,58 +1,58 @@-module HJScript.DOM.TextNode - ( - TextNode(..), - - text, length, - - appendData, deleteData, insertData, - replaceData, splitText, substringData - - ) where - -import HJScript.Lang -import HJScript.DOM.NodeTypes -import HJScript.DOM.Node - -import Prelude hiding (length) - ----------------------------------------------------- --- the TextNode object type ----------------------------------------------------- --- data TextNode = TextNode deriving Show (in NodeTypes) - -instance IsClass TextNode - -instance IsNode TextNode - ----------------------------------------------------- --- properties ----------------------------------------------------- - --- data is a keyword -text :: Exp TextNode -> Var String -text = derefVar "data" - -length :: Exp TextNode -> JInt -length = deref "length" - ----------------------------------------------------- --- methods ----------------------------------------------------- - -appendData :: JString -> Exp TextNode -> HJScript () -appendData = callVoidMethod "appendData" - -deleteData :: JInt -> JInt -> Exp TextNode -> HJScript () -deleteData = curry $ callVoidMethod "deleteData" - -insertData :: JInt -> JString -> Exp TextNode -> HJScript () -insertData = curry $ callVoidMethod "insertData" - -replaceData :: JInt -> JInt -> JString -> Exp TextNode -> HJScript () -replaceData st ln txt = callVoidMethod "replaceData" (st,ln,txt) -- curry3 !! - -splitText :: JInt -> Exp TextNode -> Exp TextNode -splitText = methodCall "splitText" - -substringData :: JInt -> JInt -> Exp TextNode -> JString +module HJScript.DOM.TextNode + (+ TextNode(..),+ + text, length,+ + appendData, deleteData, insertData,+ replaceData, splitText, substringData++ ) where++import HJScript.Lang+import HJScript.DOM.NodeTypes+import HJScript.DOM.Node++import Prelude hiding (length)++----------------------------------------------------+-- the TextNode object type+----------------------------------------------------+-- data TextNode = TextNode deriving Show (in NodeTypes)++instance IsClass TextNode++instance IsNode TextNode++----------------------------------------------------+-- properties+----------------------------------------------------++-- data is a keyword+text :: Exp TextNode -> Var String+text = derefVar "data"++length :: Exp TextNode -> JInt+length = deref "length"++----------------------------------------------------+-- methods+----------------------------------------------------++appendData :: JString -> Exp TextNode -> HJScript ()+appendData = callVoidMethod "appendData"++deleteData :: JInt -> JInt -> Exp TextNode -> HJScript ()+deleteData = curry $ callVoidMethod "deleteData"++insertData :: JInt -> JString -> Exp TextNode -> HJScript ()+insertData = curry $ callVoidMethod "insertData"++replaceData :: JInt -> JInt -> JString -> Exp TextNode -> HJScript ()+replaceData st ln txt = callVoidMethod "replaceData" (st,ln,txt) -- curry3 !!++splitText :: JInt -> Exp TextNode -> Exp TextNode+splitText = methodCall "splitText"++substringData :: JInt -> JInt -> Exp TextNode -> JString substringData = curry $ methodCall "substringData"
src/HJScript/DOM/Window.hs view
@@ -1,10 +1,10 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM.Window --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM.Window+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM.Window (@@ -31,8 +31,8 @@ -- Accessing the window object window :: Exp Window window = JConst "window"- + -- Window properties closed :: Exp Window -> JBool closed = deref "closed"@@ -40,9 +40,9 @@ defaultStatus :: Exp Window -> JString defaultStatus = deref "defaultStatus" -winDocument :: Exp Window -> Exp Document -winDocument = deref "document" - +winDocument :: Exp Window -> Exp Document+winDocument = deref "document"+ frames :: Exp Window -> JArray Frame frames = deref "frames" @@ -70,18 +70,18 @@ -- Window methods alert :: Exp t -> Exp Window -> HJScript () alert = callVoidMethod "alert" - -blur :: Exp Window -> HJScript () -blur = callVoidMethod "blur" () - -{- Not yet supported. -clearInterval, clearTimeout :: Exp Window -> HJScript () -clearInterval = callVoidMethod "clearInterval" -clearTimeout = callVoidMethod "clearTimeout" --} - ++blur :: Exp Window -> HJScript ()+blur = callVoidMethod "blur" ()++{- Not yet supported.+clearInterval, clearTimeout :: Exp Window -> HJScript ()+clearInterval = callVoidMethod "clearInterval"+clearTimeout = callVoidMethod "clearTimeout"+-}+ close :: Exp Window -> HJScript ()-close = callVoidMethod "close" () +close = callVoidMethod "close" () confirm :: JString -> Exp Window -> JBool confirm = methodCall "confirm"@@ -89,22 +89,22 @@ createPopup :: Exp Window -> Exp Window createPopup = methodCall "createPopup" () -focus :: Exp Window -> HJScript () -focus = callVoidMethod "focus" () - -moveBy :: JInt -> JInt -> Exp Window -> HJScript () -moveBy x y = callVoidMethod "moveBy" (x,y) - -moveTo :: JInt -> JInt -> Exp Window -> HJScript () -moveTo x y = callVoidMethod "moveTo" (x,y) - +focus :: Exp Window -> HJScript ()+focus = callVoidMethod "focus" ()++moveBy :: JInt -> JInt -> Exp Window -> HJScript ()+moveBy x y = callVoidMethod "moveBy" (x,y) ++moveTo :: JInt -> JInt -> Exp Window -> HJScript ()+moveTo x y = callVoidMethod "moveTo" (x,y)+ open :: JString -> JString -> Exp Window -> HJScript () open url sett = callVoidMethod "open" (url, sett) promt :: JString -> Exp Window -> JString promt = methodCall "promt" --- Not standard? +-- Not standard? navigate :: JString -> Exp Window -> HJScript () navigate = callVoidMethod "navigate" @@ -113,15 +113,15 @@ scrollTo :: JInt -> JInt -> Exp Window -> HJScript () scrollTo x y = callVoidMethod "scrollTo" (x,y)- -resizeBy :: JInt -> JInt -> Exp Window -> HJScript () -resizeBy x y = callVoidMethod "resizeBy" (x,y) - -resizeTo :: JInt -> JInt -> Exp Window -> HJScript () -resizeTo x y = callVoidMethod "resizeTo" (x,y) - -{- Not yet supported -setInterval, setTimeout :: JString -> JInt -> Exp Window -> HJScript () -setInterval = callVoidMethod "setInterval" -setTimeout = callVoidMethod "setTimeout" ++resizeBy :: JInt -> JInt -> Exp Window -> HJScript ()+resizeBy x y = callVoidMethod "resizeBy" (x,y)++resizeTo :: JInt -> JInt -> Exp Window -> HJScript ()+resizeTo x y = callVoidMethod "resizeTo" (x,y)++{- Not yet supported+setInterval, setTimeout :: JString -> JInt -> Exp Window -> HJScript ()+setInterval = callVoidMethod "setInterval"+setTimeout = callVoidMethod "setTimeout" -}
src/HJScript/DOM/XHTML.hs view
@@ -1,16 +1,16 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.DOM.XHTML --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.DOM.XHTML+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.DOM.XHTML (- -- * Standard properties - IsXHTMLElement, asXHTMLElement, className, - + -- * Standard properties+ IsXHTMLElement, asXHTMLElement, className, + -- * XHTML DOM elements Anchor(..), Area(..), Base(..), Body(..), Event(..), Form(..), Frame(..), Frameset(..), History(..), @@ -24,12 +24,12 @@ import HJScript.DOM.NodeTypes import HJScript.Lang-import HJScript.DOM.Node -import HJScript.DOM.ElementNode - ------------------------------------ --- Class gathering all standard methods - +import HJScript.DOM.Node+import HJScript.DOM.ElementNode++-----------------------------------+-- Class gathering all standard methods+ class IsElementNode a => IsXHTMLElement a -- General XHTML element type.@@ -39,60 +39,60 @@ instance IsXHTMLElement XHTMLElement asXHTMLElement :: IsElementNode n => Exp n -> Exp XHTMLElement-asXHTMLElement = castObject - --- Standard methods - -className :: IsXHTMLElement n => Exp n -> Var String -className = derefVar "className" - -dir :: IsXHTMLElement n => Exp n -> Var String -dir = derefVar "lang" - -lang :: IsXHTMLElement n => Exp n -> Var String -lang = derefVar "lang" - -title :: IsXHTMLElement n => Exp n -> Var String -title = derefVar "title" - - --- Going to and from ElementNode. -generalize :: IsXHTMLElement a => Exp a -> Exp ElementNode -generalize = castObject -specialize :: IsXHTMLElement a => Exp ElementNode -> Exp a -specialize = castObject - - - --- A lot more work should be done here, to the point --- where each separate element should have its own --- module. - +asXHTMLElement = castObject++-- Standard methods++className :: IsXHTMLElement n => Exp n -> Var String+className = derefVar "className"++dir :: IsXHTMLElement n => Exp n -> Var String+dir = derefVar "lang"++lang :: IsXHTMLElement n => Exp n -> Var String+lang = derefVar "lang"++title :: IsXHTMLElement n => Exp n -> Var String+title = derefVar "title"+++-- Going to and from ElementNode.+generalize :: IsXHTMLElement a => Exp a -> Exp ElementNode+generalize = castObject+specialize :: IsXHTMLElement a => Exp ElementNode -> Exp a+specialize = castObject++++-- A lot more work should be done here, to the point+-- where each separate element should have its own+-- module.+ -- Anchor data Anchor = Anchor deriving Show instance IsClass Anchor-instance IsNode Anchor +instance IsNode Anchor instance IsElementNode Anchor-instance IsXHTMLElement Anchor +instance IsXHTMLElement Anchor -- Area data Area = Area deriving Show-instance IsNode Area +instance IsNode Area instance IsClass Area instance IsElementNode Area-instance IsXHTMLElement Area - +instance IsXHTMLElement Area+ -- Base data Base = Base deriving Show instance IsClass Base-instance IsNode Base +instance IsNode Base instance IsElementNode Base-instance IsXHTMLElement Base +instance IsXHTMLElement Base -- Body data Body = Body deriving Show instance IsClass Body-instance IsNode Body +instance IsNode Body instance IsElementNode Body instance IsXHTMLElement Body @@ -103,16 +103,16 @@ -- Form data Form = Form deriving Show instance IsClass Form-instance IsNode Form +instance IsNode Form instance IsElementNode Form-instance IsXHTMLElement Form +instance IsXHTMLElement Form -- Frame data Frame = Frame deriving Show instance IsClass Frame-instance IsNode Frame +instance IsNode Frame instance IsElementNode Frame-instance IsXHTMLElement Frame +instance IsXHTMLElement Frame -- Frameset data Frameset = Frameset deriving Show@@ -125,30 +125,30 @@ -- IFrame data IFrame = IFrame deriving Show instance IsClass IFrame-instance IsNode IFrame +instance IsNode IFrame instance IsElementNode IFrame-instance IsXHTMLElement IFrame +instance IsXHTMLElement IFrame -- Image data Image = Image deriving Show instance IsClass Image-instance IsNode Image +instance IsNode Image instance IsElementNode Image-instance IsXHTMLElement Image +instance IsXHTMLElement Image -- InputButton data InputButton = InputButton deriving Show instance IsClass InputButton-instance IsNode InputButton +instance IsNode InputButton instance IsElementNode InputButton-instance IsXHTMLElement InputButton - +instance IsXHTMLElement InputButton+ -- InputCheckbox data InputCheckbox = InputCheckbox deriving Show instance IsClass InputCheckbox-instance IsNode InputCheckbox +instance IsNode InputCheckbox instance IsElementNode InputCheckbox-instance IsXHTMLElement InputCheckbox +instance IsXHTMLElement InputCheckbox -- InputFile data InputFile = InputFile deriving Show@@ -177,16 +177,16 @@ -- InputText data InputText = InputText deriving Show instance IsClass InputText-instance IsNode InputText +instance IsNode InputText instance IsElementNode InputText-instance IsXHTMLElement InputText +instance IsXHTMLElement InputText -- Link data Link = Link deriving Show instance IsClass Link-instance IsNode Link +instance IsNode Link instance IsElementNode Link-instance IsXHTMLElement Link +instance IsXHTMLElement Link -- Location data Location = Location deriving Show@@ -223,34 +223,34 @@ -- Table data Table = Table deriving Show instance IsClass Table-instance IsNode Table +instance IsNode Table instance IsElementNode Table-instance IsXHTMLElement Table +instance IsXHTMLElement Table -- TableData data TableData = TableData deriving Show instance IsClass TableData-instance IsNode TableData +instance IsNode TableData instance IsElementNode TableData-instance IsXHTMLElement TableData +instance IsXHTMLElement TableData -- TableHeader data TableHeader = TableHeader deriving Show instance IsClass TableHeader-instance IsNode TableHeader +instance IsNode TableHeader instance IsElementNode TableHeader-instance IsXHTMLElement TableHeader +instance IsXHTMLElement TableHeader -- TableRow data TableRow = TableRow deriving Show instance IsClass TableRow-instance IsNode TableRow +instance IsNode TableRow instance IsElementNode TableRow-instance IsXHTMLElement TableRow +instance IsXHTMLElement TableRow -- Textarea data Textarea = Textarea deriving Show instance IsClass Textarea-instance IsNode Textarea +instance IsNode Textarea instance IsElementNode Textarea-instance IsXHTMLElement Textarea +instance IsXHTMLElement Textarea
src/HJScript/Lang.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- | --- Module : HJScript.Lang --- License : BSD-style +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : HJScript.Lang+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Lang (@@ -25,22 +25,22 @@ -- Objects var, varWith, inVar, new ,( # ), ( #. ),- rec, first, second, x, y, + rec, first, second, x, y, -- Helpers ( #! ) , jnull, jShow, castObject, hasFeature, break, continue, true ,ifOp, false, int, float, bool, string,- + -- Re-exports from internal module HJScript.Monad- HJScript, IsHJScript(..), - outputBlock, outputStmt, - - -- Evaluating HJScript - evaluateHJScript, evalHJScript, - - -- Re-export all of Language.HJavaScript.Syntax - module Language.HJavaScript.Syntax - + HJScript, IsHJScript(..), + outputBlock, outputStmt,+ + -- Evaluating HJScript+ evaluateHJScript, evalHJScript,++ -- Re-export all of Language.HJavaScript.Syntax+ module Language.HJavaScript.Syntax+ ) where import Language.HJavaScript.Syntax@@ -132,7 +132,7 @@ name <- newVarName (_,body) <- hjsInside $ script (val $ JVar name) outputStmt $ For (pre name) (cond name) (inc name) body- where + where inc name = JIncrement Pst (JVar name) :: JInt pre name = VarDeclAssign name from cond name = (val $ JVar name) .<=. to@@ -182,7 +182,7 @@ -- | No else branch. noElse :: HJScript (Elses ()) noElse = return NoElse- + ----------------------------------------------------------- -- HJScript function declarations -----------------------------------------------------------@@ -191,7 +191,7 @@ function :: (FormalParams a t, VarsToExps a e) => (e -> HJScript (Exp r)) -> HJScript (Exp (t -> r)) function fun = do - n <- newVarNum + n <- newVarNum let args = mkFParams (\_ -> ()) n let script = fun $ v2e args (ret, body) <- hjsInside script@@ -202,7 +202,7 @@ procedure :: (FormalParams a t, VarsToExps a e) => (e -> HJScript ()) -> HJScript (Exp (t -> ())) procedure fun = do- n <- newVarNum + n <- newVarNum let args = mkFParams (\_ -> ()) n body <- return . snd =<< (hjsInside $ fun $ v2e args) return $ JFunction Nothing args body@@ -211,7 +211,7 @@ functionDecl :: (FormalParams a t, VarsToExps a e) => String -> (e -> HJScript (Exp r)) -> HJScript () functionDecl name fun = do- n <- newVarNum + n <- newVarNum let args = mkFParams (\_ -> ()) n let script = fun $ v2e args (ret,body) <- hjsInside script@@ -223,7 +223,7 @@ String -> (e -> HJScript ()) -> HJScript () procedureDecl name fun = do- n <- newVarNum + n <- newVarNum let args = mkFParams (\_ -> ()) n let script = fun $ v2e args (_, body) <- hjsInside script@@ -235,16 +235,16 @@ ------------------------------------------------------------ --- A return-adding evaluator ------------------------------------------------------------ - -evaluateHJScript :: HJScript (Exp t) -> Block t -evaluateHJScript m = - let (v,b) = evalHJScript m - in addReturn v b - -----------------------------------------------------------+-- A return-adding evaluator+-----------------------------------------------------------++evaluateHJScript :: HJScript (Exp t) -> Block t+evaluateHJScript m = + let (v,b) = evalHJScript m+ in addReturn v b++----------------------------------------------------------- -- HJScript method calls ----------------------------------------------------------- @@ -273,9 +273,9 @@ name <- newVarName outputStmt $ VarDeclAssign name e return $ JVar name - + inVar :: Exp t -> HJScript (Exp t)-inVar = fmap val . varWith +inVar = fmap val . varWith this :: IsClass c => Exp c this = JThis@@ -296,18 +296,18 @@ -- e.g. "style #. display" ( #. ) :: (a -> b) -> (b -> c) -> (a -> c) ( #. ) = flip (.) - --- Creating a record -rec :: Exp a -> Exp b -> Exp (Rec a b) -rec = JRec - -first, x :: Exp (Rec a b) -> Exp a -first = JFst -x = first - -second, y :: Exp (Rec a b) -> Exp b -second = JSnd -y = second ++-- Creating a record+rec :: Exp a -> Exp b -> Exp (Rec a b)+rec = JRec++first, x :: Exp (Rec a b) -> Exp a+first = JFst+x = first++second, y :: Exp (Rec a b) -> Exp b+second = JSnd+y = second ----------------------------------------------------------- -- Helpers
src/HJScript/Monad.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances, GADTs #-} ------------------------------------------------------------------------------ --- | --- Module : HJScript.Monad --- License : BSD-style +{-# LANGUAGE OverlappingInstances, UndecidableInstances, GADTs #-}+-----------------------------------------------------------------------------+-- |+-- Module : HJScript.Monad+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Monad (@@ -19,19 +19,19 @@ outputBlock, outputStmt, newVarName,- newVarNum, + newVarNum, hjsInside,- + ) where import Language.HJavaScript.Syntax import Control.Monad.Writer import Control.Monad.State -import HSX.XMLGenerator (XMLGenT, unXMLGenT) - +import HSX.XMLGenerator (XMLGenT, unXMLGenT)+ -- | HJScript Monad-type HJScript'= StateT HJState (Writer (Block ())) +type HJScript'= StateT HJState (Writer (Block ())) type HJScript = XMLGenT HJScript' -- | To keep track of number of created variables@@ -80,19 +80,19 @@ outputBlock :: Block () -> HJScript () outputBlock = lift . lift . tell --- Creates a fresh variable number -newVarNum :: HJScript Int -newVarNum = lift $ do - n <- get - put $ n + 1 - return n - +-- Creates a fresh variable number+newVarNum :: HJScript Int+newVarNum = lift $ do+ n <- get+ put $ n + 1+ return n+ -- Creates a fresh variable name newVarName :: HJScript String newVarName = do n <- newVarNum return $ "var" ++ "_" ++ (show n)- + -- | Runs one script inside another hjsInside :: HJScript t -> HJScript (t, Block ()) hjsInside script = do
src/HJScript/Objects/ActiveXObject.hs view
@@ -1,26 +1,26 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- Module : HJScript.Objects.ActiveXObject --- Copyright : (c) Joel Björnson 2006 --- License : BSD-style --- Maintainer : Joel Björnson, joel.bjornson@gmail.com --- Stability : experimental --- Microsoft active-x object. ------------------------------------------------------------------------------ -module HJScript.Objects.ActiveXObject - ( - ActiveXObject(..), - msXMLHttp - ) where - - -import HJScript.Lang - - --- ActiveXObject -data ActiveXObject = ActiveXObject deriving Show -instance IsClass ActiveXObject -instance HasConstructor ActiveXObject JString String - - -msXMLHttp = string "Microsoft.XMLHTTP" +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- Module : HJScript.Objects.ActiveXObject+-- Copyright : (c) Joel Björnson 2006+-- License : BSD-style+-- Maintainer : Joel Björnson, joel.bjornson@gmail.com+-- Stability : experimental+-- Microsoft active-x object.+-----------------------------------------------------------------------------+module HJScript.Objects.ActiveXObject + (+ ActiveXObject(..),+ msXMLHttp+ ) where+++import HJScript.Lang+++-- ActiveXObject+data ActiveXObject = ActiveXObject deriving Show+instance IsClass ActiveXObject+instance HasConstructor ActiveXObject JString String+++msXMLHttp = string "Microsoft.XMLHTTP"
src/HJScript/Objects/Array.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- | --- Module : HJScript.Objects.Array --- License : BSD-style +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : HJScript.Objects.Array+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.Array (
src/HJScript/Objects/Boolean.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -------------------------------------------------------------------------------- | --- Module : HJScript.Objects.Boolean --- License : BSD-style +-- |+-- Module : HJScript.Objects.Boolean+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.Boolean (
src/HJScript/Objects/Date.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -------------------------------------------------------------------------------- | --- Module : HJScript.Object.Date --- Copyright : (c) Joel Bjornson 2008 --- License : BSD-style +-- |+-- Module : HJScript.Object.Date+-- Copyright : (c) Joel Bjornson 2008+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.Date (
src/HJScript/Objects/JQuery.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} module HJScript.Objects.JQuery where import HJScript.Lang
src/HJScript/Objects/Math.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -------------------------------------------------------------------------------- | --- Module : HJScript.Objects.Math --- License : BSD-style +-- |+-- Module : HJScript.Objects.Math+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.Math (
src/HJScript/Objects/RegExp.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -------------------------------------------------------------------------------- | --- Module : HJScript.Objects.RegExp --- License : BSD-style +-- |+-- Module : HJScript.Objects.RegExp+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.RegExp (
src/HJScript/Objects/String.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -------------------------------------------------------------------------------- | --- Module : HJScript.Object.String --- Copyright : (c) Joel Bjornson 008 --- License : BSD-style +-- |+-- Module : HJScript.Object.String+-- Copyright : (c) Joel Bjornson 008+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com,--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Objects.String (
src/HJScript/Objects/XMLHttpRequest.hs view
@@ -1,68 +1,68 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- Module : HJScript.Objects.XMLHttpRequest --- Copyright : (c) Joel Björnson 2006 --- License : BSD-style --- Maintainer : Joel Björnson, joel.bjornson@gmail.com --- Stability : experimental --- XMLHttpRequest implementation ------------------------------------------------------------------------------ -module HJScript.Objects.XMLHttpRequest - ( - -- * Data - XMLHttpRequest(..), - - -- * Properties - statusReq, - onReadyStateChange, - responseXML, - responseText, +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- Module : HJScript.Objects.XMLHttpRequest +-- Copyright : (c) Joel Björnson 2006+-- License : BSD-style+-- Maintainer : Joel Björnson, joel.bjornson@gmail.com+-- Stability : experimental+-- XMLHttpRequest implementation+-----------------------------------------------------------------------------+module HJScript.Objects.XMLHttpRequest + (+ -- * Data+ XMLHttpRequest(..),+ + -- * Properties+ statusReq,+ onReadyStateChange,+ responseXML,+ responseText, readyState,- - -- * Methods - openReq, - sendReq, - setRequestHeader - - ) where - -import HJScript.Lang -import HJScript.DOM.Document (Document) - --- | XMLHttpRequest -data XMLHttpRequest = XMLHttpRequest deriving Show - -instance IsClass XMLHttpRequest -instance HasConstructor XMLHttpRequest () () - ----------------------------------------------------- --- Special XMLHttpRequest properties ----------------------------------------------------- - -statusReq :: JObject XMLHttpRequest -> JInt -statusReq = deref "status" - -onReadyStateChange :: JObject XMLHttpRequest -> Var (() -> ()) -onReadyStateChange = derefVar "onreadystatechange" - -responseXML :: JObject XMLHttpRequest -> JObject Document -responseXML = deref "responseXML" - -responseText :: JObject XMLHttpRequest -> JString -responseText = deref "responseText" - -readyState :: JObject XMLHttpRequest -> JInt -readyState = deref "readyState" - ----------------------------------------------------- --- Special XMLHttpRequest methods ----------------------------------------------------- - -openReq :: JString -> JString -> JBool -> JObject XMLHttpRequest -> HJScript () -openReq a1 a2 a3 = callVoidMethod "open" (a1, a2, a3) - -sendReq :: JString -> JObject XMLHttpRequest -> HJScript () -sendReq = callVoidMethod "send" - -setRequestHeader :: JString -> JString -> JObject XMLHttpRequest -> HJScript () -setRequestHeader = curry $ callVoidMethod "setRequestHeader" + + -- * Methods+ openReq,+ sendReq,+ setRequestHeader + + ) where+ +import HJScript.Lang+import HJScript.DOM.Document (Document)++-- | XMLHttpRequest+data XMLHttpRequest = XMLHttpRequest deriving Show++instance IsClass XMLHttpRequest+instance HasConstructor XMLHttpRequest () ()++----------------------------------------------------+-- Special XMLHttpRequest properties+----------------------------------------------------++statusReq :: JObject XMLHttpRequest -> JInt+statusReq = deref "status"++onReadyStateChange :: JObject XMLHttpRequest -> Var (() -> ())+onReadyStateChange = derefVar "onreadystatechange"++responseXML :: JObject XMLHttpRequest -> JObject Document+responseXML = deref "responseXML"++responseText :: JObject XMLHttpRequest -> JString+responseText = deref "responseText"++readyState :: JObject XMLHttpRequest -> JInt+readyState = deref "readyState"++----------------------------------------------------+-- Special XMLHttpRequest methods+----------------------------------------------------++openReq :: JString -> JString -> JBool -> JObject XMLHttpRequest -> HJScript ()+openReq a1 a2 a3 = callVoidMethod "open" (a1, a2, a3)++sendReq :: JString -> JObject XMLHttpRequest -> HJScript ()+sendReq = callVoidMethod "send"++setRequestHeader :: JString -> JString -> JObject XMLHttpRequest -> HJScript ()+setRequestHeader = curry $ callVoidMethod "setRequestHeader"
src/HJScript/Utils.hs view
@@ -1,10 +1,10 @@------------------------------------------------------------------------------ --- | --- Module : HJScript.Utils --- License : BSD-style +-----------------------------------------------------------------------------+-- |+-- Module : HJScript.Utils+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module HJScript.Utils (
src/HJScript/XMLGenerator.hs view
@@ -1,111 +1,111 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-} -module HJScript.XMLGenerator ( --- ToChildNodes(..), ToAttributeNode(..), - - genElement, genEElement, asChild, asAttr, Attr(..) - ) where - -import qualified HSX.XMLGenerator as HSX (XMLGen(..)) -import HSX.XMLGenerator hiding (XMLGen(..)) -import HSX.XMLGenerator (genElement, genEElement) - -import HJScript.Monad -import HJScript.Lang - -import HJScript.DOM.Node -import HJScript.DOM.AttributeNode -import HJScript.DOM.ElementNode -import HJScript.DOM.TextNode -import HJScript.DOM.Document - -type XML = Exp ElementNode -type Child = Exp Node -type Attribute = Exp AttributeNode - -instance HSX.XMLGen HJScript' where - type HSX.XML HJScript' = XML - newtype HSX.Child HJScript' = HJSChild Child - newtype HSX.Attribute HJScript' = HJSAttr Attribute - genElement = element - genEElement = eElement - xmlToChild = HJSChild . castToNode - -element :: (EmbedAsChild HJScript' c, - EmbedAsAttr HJScript' a) - => Name -> [a] -> [c] -> HJScript XML -element (ns, ln) atts xmls = do - let name = (maybe id (\x y -> y ++ ':':x) ns) ln - elem <- fmap val $ varWith $ document # createElement (string name) - cxml <- fmap concat $ mapM asChild xmls - ats <- fmap concat $ mapM asAttr atts - mapM (\attr -> elem # setAttributeNode attr) $ map stripAttr ats - mapM (\child -> elem # appendChild child) $ map stripChild cxml - return elem - -eElement :: EmbedAsAttr HJScript' a => Name -> [a] -> HJScript XML -eElement n attrs = element n attrs ([] :: [Child]) - - -instance XMLGenerator HJScript' - --------------------------------------------- --- EmbedAsChild and EmbedAsAttr - -instance EmbedAsChild HJScript' Child where - asChild = asChild . HJSChild - -instance EmbedAsChild HJScript' JString where - asChild jstr = asChild $ castToNode $ document # createTextNode jstr - -instance EmbedAsChild HJScript' String where - asChild = asChild . string - -instance EmbedAsChild HJScript' Char where - asChild = asChild . (:[]) - --- This instance should already be there, probably doesn't work due --- to type families not being fully supported yet. -instance EmbedAsChild HJScript' XML where - asChild = return . return . HSX.xmlToChild - -instance EmbedAsAttr HJScript' Attribute where - asAttr = asAttr . HJSAttr - -instance (IsName n, IsAttrNodeValue a) => EmbedAsAttr HJScript' (Attr n a) where - asAttr (k := a) = asAttr $ do - let (ns, ln) = toName k - name = (maybe id (\x y -> y ++ ':':x) ns) ln - v <- toAttrNodeValue a - an <- inVar $ document # createAttribute (string name) - an # value .=. v - return an - - -class IsAttrNodeValue a where - toAttrNodeValue :: a -> HJScript JString - -instance JShow a => IsAttrNodeValue a where - toAttrNodeValue = return . jshow - -instance IsAttrNodeValue a => IsAttrNodeValue (HJScript a) where - toAttrNodeValue = (>>= toAttrNodeValue) - ------------------------------------ --- SetAttr and AppendChild. - -instance SetAttr HJScript' XML where - setAll en ats = do - ev <- inVar en - as <- ats - mapM (\attr -> ev # setAttributeNode attr) (map stripAttr as) - return ev - -instance AppendChild HJScript' XML where - appAll en cns = do - ev <- inVar en - cs <- cns - mapM (\child -> ev # appendChild child) (map stripChild cs) - return ev - -stripAttr (HJSAttr a) = a +{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+module HJScript.XMLGenerator (+-- ToChildNodes(..), ToAttributeNode(..),+ + genElement, genEElement, asChild, asAttr, Attr(..)+ ) where++import qualified HSX.XMLGenerator as HSX (XMLGen(..))+import HSX.XMLGenerator hiding (XMLGen(..))+import HSX.XMLGenerator (genElement, genEElement)++import HJScript.Monad+import HJScript.Lang++import HJScript.DOM.Node+import HJScript.DOM.AttributeNode+import HJScript.DOM.ElementNode+import HJScript.DOM.TextNode+import HJScript.DOM.Document++type XML = Exp ElementNode+type Child = Exp Node+type Attribute = Exp AttributeNode++instance HSX.XMLGen HJScript' where+ type HSX.XML HJScript' = XML+ newtype HSX.Child HJScript' = HJSChild Child+ newtype HSX.Attribute HJScript' = HJSAttr Attribute+ genElement = element+ genEElement = eElement+ xmlToChild = HJSChild . castToNode++element :: (EmbedAsChild HJScript' c, + EmbedAsAttr HJScript' a) + => Name -> [a] -> [c] -> HJScript XML+element (ns, ln) atts xmls = do+ let name = (maybe id (\x y -> y ++ ':':x) ns) ln+ elem <- fmap val $ varWith $ document # createElement (string name)+ cxml <- fmap concat $ mapM asChild xmls+ ats <- fmap concat $ mapM asAttr atts+ mapM (\attr -> elem # setAttributeNode attr) $ map stripAttr ats+ mapM (\child -> elem # appendChild child) $ map stripChild cxml+ return elem++eElement :: EmbedAsAttr HJScript' a => Name -> [a] -> HJScript XML+eElement n attrs = element n attrs ([] :: [Child])+++instance XMLGenerator HJScript'++--------------------------------------------+-- EmbedAsChild and EmbedAsAttr++instance EmbedAsChild HJScript' Child where+ asChild = asChild . HJSChild++instance EmbedAsChild HJScript' JString where+ asChild jstr = asChild $ castToNode $ document # createTextNode jstr++instance EmbedAsChild HJScript' String where+ asChild = asChild . string++instance EmbedAsChild HJScript' Char where+ asChild = asChild . (:[])++-- This instance should already be there, probably doesn't work due+-- to type families not being fully supported yet.+instance EmbedAsChild HJScript' XML where+ asChild = return . return . HSX.xmlToChild++instance EmbedAsAttr HJScript' Attribute where+ asAttr = asAttr . HJSAttr++instance (IsName n, IsAttrNodeValue a) => EmbedAsAttr HJScript' (Attr n a) where+ asAttr (k := a) = asAttr $ do+ let (ns, ln) = toName k+ name = (maybe id (\x y -> y ++ ':':x) ns) ln+ v <- toAttrNodeValue a+ an <- inVar $ document # createAttribute (string name)+ an # value .=. v+ return an+++class IsAttrNodeValue a where+ toAttrNodeValue :: a -> HJScript JString++instance JShow a => IsAttrNodeValue a where+ toAttrNodeValue = return . jshow++instance IsAttrNodeValue a => IsAttrNodeValue (HJScript a) where+ toAttrNodeValue = (>>= toAttrNodeValue)++-----------------------------------+-- SetAttr and AppendChild.++instance SetAttr HJScript' XML where+ setAll en ats = do+ ev <- inVar en+ as <- ats+ mapM (\attr -> ev # setAttributeNode attr) (map stripAttr as)+ return ev++instance AppendChild HJScript' XML where+ appAll en cns = do+ ev <- inVar en+ cs <- cns+ mapM (\child -> ev # appendChild child) (map stripChild cs)+ return ev++stripAttr (HJSAttr a) = a stripChild (HJSChild c) = c