Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of https://github.com/spockz/uhc-jscript

  • Loading branch information...
commit 3470947a1d6f8ec2ad347bcec2b668c15f6c59f3 2 parents 6e39e29 + a9be3e5
@norm2782 norm2782 authored
View
2  uhc-jscript/src/Language/UHC/JScript/ECMA/Array.hs
@@ -9,6 +9,8 @@ import UHC.BoxArray
type JSArray x = BoxArray x
+instance JS (JSArray a)
+
foreign import jscript "%1.length"
lengthJSArray :: JSArray x -> Int
View
79 uhc-jscript/src/Language/UHC/JScript/JQuery/Ajax.hs
@@ -0,0 +1,79 @@
+module Language.UHC.JScript.JQuery.Ajax (AjaxOptions(..), JSAjaxOptions(..), AjaxCallback, AjaxRequestType(..), ajaxBackend, ajax, toJSOptions, mkJSAjaxCallback) where
+
+import Language.UHC.JScript.ECMA.String
+import Language.UHC.JScript.Types
+
+import Language.UHC.JScript.Primitives
+
+import Data.List
+
+data JQXHRPtr
+type JQXHR = JSPtr JQXHRPtr
+
+
+-- type AjaxCallback r = JS r => r -> String -> JQXHR -> IO()
+type AjaxCallback r = r -> String -> JQXHR -> IO()
+type JSAjaxCallback r = JSFunPtr (AjaxCallback r)
+
+data AjaxRequestType = GET | POST
+ deriving Show
+
+
+data AjaxOptions a = AjaxOptions {
+ ao_url :: String,
+ ao_requestType :: AjaxRequestType,
+ ao_contentType :: String,
+ ao_dataType :: String
+}
+
+
+data JSAjaxOptions a = JSAjaxOptions {
+ url :: JSString,
+ requestType :: JSString,
+ contentType :: JSString,
+ dataType :: JSString
+}
+
+instance Show (AjaxOptions a) where
+ show jsopt= "AjaxOptions: " ++ intercalate " " [show $ ao_url jsopt]
+
+instance Show (JSAjaxOptions a) where
+ show jsopt = "JSAjaxOptions: " ++ intercalate " " [show $ url jsopt]
+
+toJSOptions :: AjaxOptions a -> JSAjaxOptions a
+toJSOptions options = let url' = toJS (ao_url options)
+ requestType' = toJS (show $ ao_requestType options)
+ contentType' = toJS (ao_contentType options)
+ dataType' = toJS (ao_dataType options)
+ in JSAjaxOptions { url = url'
+ , requestType = requestType'
+ , contentType = contentType'
+ , dataType = dataType'
+ }
+
+
+ajaxBackend :: JS r => (JSPtr a -> IO ()) -> AjaxOptions a -> AjaxCallback r -> AjaxCallback r -> IO ()
+ajaxBackend cont options onSuccess onFailure =
+ do let jsOptions = toJSOptions options
+ onSuccess' <- mkJSAjaxCallback onSuccess
+ onFailure' <- mkJSAjaxCallback onFailure
+ o <- mkObj jsOptions
+ _ <- setAttr "type" (requestType jsOptions) o
+ _ <- setAttr "success" onSuccess' o
+ _ <- setAttr "error" onFailure' o
+ _ajaxQ (toJS "jcu_app") o
+
+ajax :: JS r => AjaxOptions a -> AjaxCallback r -> AjaxCallback r -> IO ()
+ajax = ajaxBackend _ajax
+
+
+
+foreign import jscript "wrapper"
+ mkJSAjaxCallback :: AjaxCallback r -> IO (JSAjaxCallback r)
+
+
+foreign import jscript "$.ajax(%1)"
+ _ajax :: JSPtr a -> IO ()
+
+foreign import jscript "$.ajaxq(%*)"
+ _ajaxQ :: JSString -> JSPtr a -> IO ()
View
15 uhc-jscript/src/Language/UHC/JScript/JQuery/AjaxQueue.hs
@@ -0,0 +1,15 @@
+module Language.UHC.JScript.JQuery.AjaxQueue (ajaxQ) where
+
+import Language.UHC.JScript.Primitives
+import Language.UHC.JScript.Types
+
+import Language.UHC.JScript.ECMA.String
+import Language.UHC.JScript.JQuery.Ajax
+
+import Language.UHC.JScript.Assorted (alert, _alert)
+
+ajaxQ :: JS r => String -> AjaxOptions a -> AjaxCallback r -> AjaxCallback r -> IO ()
+ajaxQ queuename = ajaxBackend (_ajaxQ $ toJS queuename)
+
+foreign import jscript "$.ajaxq(%*)"
+ _ajaxQ :: JSString -> JSPtr a -> IO ()
View
96 uhc-jscript/src/Language/UHC/JScript/JQuery/JQuery.hs
@@ -4,6 +4,8 @@ import Language.UHC.JScript.ECMA.String
import Language.UHC.JScript.Primitives
import Language.UHC.JScript.Types
+import Language.UHC.JScript.Assorted (alert)
+
data JQueryPtr
type JQuery = JSPtr JQueryPtr
@@ -50,6 +52,30 @@ foreign import jscript "jQuery.when(%*)"
foreign import jscript "jQuery.when(%*)"
when'' :: JSPtr a -> JSPtr a -> JSPtr a -> IO ()
+-------------------------------------------------------------------------------
+-- DOM
+
+foreign import jscript "%1.each(%2)"
+ each :: JQuery -> JSFunPtr (Int -> JSPtr a -> IO ()) -> IO ()
+
+foreign import jscript "jQuery.each(%*)"
+ each' :: b -> JSFunPtr (Int -> JSPtr a -> IO ()) -> IO ()
+
+
+foreign import jscript "wrapper"
+ mkEachIterator :: (Int -> JSPtr a -> IO ()) -> IO (JSFunPtr (Int -> JSPtr a -> IO ()))
+
+-------------------------------------------------------------------------------
+-- DOM
+
+findSelector :: JQuery -> String -> IO JQuery
+findSelector jq = findSelector' jq . toJS
+
+foreign import jscript "%1.find(%2)"
+ findSelector' :: JQuery -> JSString -> IO JQuery
+
+foreign import jscript "%1.find(%2)"
+ findObject :: JQuery -> JQuery -> IO JQuery
-------------------------------------------------------------------------------
-- Manipulation
@@ -64,21 +90,26 @@ foreign import jscript "%1.html()"
setHTML :: JQuery -> String -> IO ()
setHTML j s = _setHTML j (toJS s)
+
foreign import jscript "%1.html(%2)"
_setHTML :: JQuery -> JSString -> IO ()
-
+
foreign import jscript "%1.hide()"
hide :: JQuery -> IO ()
addClass :: JQuery -> String -> IO ()
addClass j s = _addClass j (toJS s)
+wrapInner :: JQuery -> String -> IO ()
+wrapInner j = _wrapInner j . toJS
+
+foreign import jscript "%1.wrapInner(%2)"
+ _wrapInner :: JQuery -> JSString -> IO ()
+
-- Or return JQuery for chaining??? Does chaining even make sense?
foreign import jscript "%1.addClass(%2)"
_addClass :: JQuery -> JSString -> IO ()
-
-
-------------------------------------------------------------------------------
-- Effects
@@ -105,3 +136,62 @@ jqshow j (Just n) (Just e) Nothing = jqshow2 j n (toJS e)
jqshow j (Just n) Nothing (Just c) = jqshow2' j n c
jqshow j (Just n) (Just e) (Just c) = jqshow3 j n (toJS e) c
+
+-------------------------------------------------------------------------------
+-- Events
+
+data JUIPtr
+type JUI = JSPtr JUIPtr
+
+type JEventResult = IO Bool
+type JEventHandler = JSFunPtr ( JQuery -> JEventResult )
+type JUIEventHandler = JSFunPtr ( JQuery -> JUI -> JEventResult )
+type JEventType = String
+
+bind :: JQuery -> JEventType -> JEventHandler -> IO ()
+bind jq event eh = do _bind jq (toJS event) eh
+
+foreign import jscript "%1.bind(%*)"
+ _bind :: JQuery -> JSString -> JEventHandler -> IO ()
+
+
+blur :: JQuery -> JEventHandler -> IO ()
+blur = undefined
+
+
+click :: JQuery -> JEventHandler -> IO ()
+click = _click
+
+foreign import jscript "%1.click(%2)"
+ _click :: JQuery -> JEventHandler -> IO ()
+
+
+keypress :: JQuery -> JEventHandler -> IO ()
+keypress = undefined
+
+
+onDocumentReady :: JSFunPtr (IO ()) -> IO ()
+onDocumentReady f = _ready f
+
+foreign import jscript "$('document').ready(%1)"
+ _ready :: JSFunPtr (IO ()) -> IO ()
+
+-------------------------------------------------------------------------------
+-- DOM Manipulation
+
+append :: JQuery -> JQuery -> IO ()
+append = _append
+
+foreign import jscript "%1.append(%*)"
+ _append :: JQuery -> JQuery -> IO ()
+
+
+-------------------------------------------------------------------------------
+-- Dynamic loading
+
+loadSrcFile :: String -> IO ()
+loadSrcFile src = do let src' = toJS src :: JSString
+ scriptTag <- jQuery "<script>"
+ scriptTag' <- setAttr "src" src' scriptTag
+ body <- jQuery "body"
+ append body scriptTag'
View
3  uhc-jscript/src/Language/UHC/JScript/Primitives.hs
@@ -7,6 +7,9 @@ import UHC.Ptr
data JSPtr a
type JSFunPtr a = FunPtr a
+instance JS (JSPtr a)
+instance JS (JSString)
+
type JSString = PackedString
type AnonObj = JSPtr ()
View
3  uhc-jscript/src/Language/UHC/JScript/Types.hs
@@ -4,6 +4,9 @@ module Language.UHC.JScript.Types where
import Control.Monad
+class JS a where
+
+
class ToJS a b where
toJS :: a -> b
View
60 uhc-jscript/src/Language/UHC/JScript/W3C/HTML5.hs
@@ -7,6 +7,7 @@ module Language.UHC.JScript.W3C.HTML5
, document
, documentWriteln, documentWrite
, documentGetElementById, documentGetElementsByName, documentGetElementsByTagName
+ , documentCreateElement
, Anchor
, anchorCharset
@@ -30,7 +31,9 @@ module Language.UHC.JScript.W3C.HTML5
, elementClientWidth
, elementClientHeight
, elementAttributes
-
+ , elementSetAttribute
+ , elementAppendChild
+
, Attr
, attrValue
@@ -51,10 +54,14 @@ module Language.UHC.JScript.W3C.HTML5
)
where
+import Language.UHC.JScript.Types
+
+import Language.UHC.JScript.Primitives
import Language.UHC.JScript.ECMA.Array
import Language.UHC.JScript.ECMA.String
-data Document
+data DocumentPtr
+type Document = JSPtr DocumentPtr
foreign import jscript "document"
document :: IO Document
@@ -83,10 +90,20 @@ foreign import jscript "%1.getElementById(%*)"
foreign import jscript "%1.getElementsByName(%*)"
documentGetElementsByName :: Document -> JSString -> IO (NodeList Node)
+documentGetElementsByTagName :: Document -> String -> IO (NodeList Node)
+documentGetElementsByTagName d = _documentGetElementsByTagName d . stringToJSString
+
foreign import jscript "%1.getElementsByTagName(%*)"
- documentGetElementsByTagName :: Document -> JSString -> IO (NodeList Node)
+ _documentGetElementsByTagName :: Document -> JSString -> IO (NodeList Node)
+
+documentCreateElement :: String -> IO Node
+documentCreateElement elem = _documentCreateElement (stringToJSString elem :: JSString)
+
+foreign import jscript "document.createElement(%*)"
+ _documentCreateElement :: JSString -> IO Node
-data Anchor
+data AnchorPtr
+type Anchor = JSPtr AnchorPtr
foreign import jscript "%1.charset"
anchorCharset :: Anchor -> JSString
@@ -112,16 +129,20 @@ foreign import jscript "%1.target"
foreign import jscript "%1.type"
anchorType :: Anchor -> JSString
-data Form
+data FormPtr
+type Form = JSPtr FormPtr
foreign import jscript "%1.elements"
formElements :: Form -> JSArray Element
-data Image
+data ImagePtr
+type Image = JSPtr ImagePtr
-data Link
+data LinkPtr
+type Link = JSPtr LinkPtr
-data Element
+data ElementPtr
+type Element = JSPtr ElementPtr
foreign import jscript "%1.innerHTML"
elementInnerHTML :: Node -> JSString
@@ -137,8 +158,18 @@ foreign import jscript "%1.clientHeight"
foreign import jscript "%1.attributes"
elementAttributes :: Node -> NamedNodeMap Node
-
-data Node
+
+elementSetAttribute :: Node -> String -> String -> IO ()
+elementSetAttribute n k v = _elementSetAttribute n (stringToJSString k :: JSString) (stringToJSString v :: JSString)
+
+foreign import jscript "%1.setAttribute(%*)"
+ _elementSetAttribute :: Node -> JSString -> JSString -> IO ()
+
+foreign import jscript "%1.appendChild(%2)"
+ elementAppendChild :: Node -> Node -> IO ()
+
+data NodePtr
+type Node = JSPtr NodePtr
foreign import jscript "%1.nodeName"
nodeName :: Node -> JSString
@@ -146,7 +177,8 @@ foreign import jscript "%1.nodeName"
foreign import jscript "%1.nodeType"
nodeType :: Node -> Int
-data NodeList x
+data NodeListPtr x
+type NodeList x = JSPtr (NodeListPtr x)
foreign import jscript "%1.length"
nodeListLength :: NodeList Node -> Int
@@ -154,7 +186,8 @@ foreign import jscript "%1.length"
foreign import jscript "%1[%2]"
nodeListItem :: NodeList Node -> Int -> IO Node
-data NamedNodeMap x
+data NamedNodeMapPtr x
+type NamedNodeMap x = JSPtr (NamedNodeMapPtr x)
foreign import jscript "%1.length"
namedNodeMapLength :: NamedNodeMap Node -> Int
@@ -171,7 +204,8 @@ foreign import jscript "%1.removeNamedItem(%*)"
foreign import jscript "%1.setNamedItem(%*)"
namedNodeMapSetNamedItem :: NamedNodeMap Node -> Node -> IO Node
-data Attr
+data AttrPtr
+type Attr = JSPtr AttrPtr
foreign import jscript "%1.value"
attrValue :: Attr -> JSString
Please sign in to comment.
Something went wrong with that request. Please try again.