Permalink
Browse files

Ajax working again, bit nice now. :)

  • Loading branch information...
1 parent 4fc75ff commit 6cdf0157901cfd80b30d213e5f43d478dd09c733 @spockz committed Dec 20, 2011
@@ -1,4 +1,4 @@
-module Language.UHC.JScript.JQuery.Ajax (AjaxOptions(..), JSAjaxOptions(..), AjaxCallback, ajaxBackend, ajax, toJSOptions) where
+module Language.UHC.JScript.JQuery.Ajax (AjaxOptions(..), JSAjaxOptions(..), AjaxCallback, Callback, AjaxRequestType(..), ajaxBackend, ajax, toJSOptions, mkJSAjaxCallback) where
import Language.UHC.JScript.ECMA.String
import Language.UHC.JScript.Types
@@ -7,11 +7,18 @@ import Language.UHC.JScript.Primitives
import Data.List
-type AjaxCallback a = JSFunPtr (JSPtr a -> IO())
+
+type Callback a b = JSPtr a -> String -> JSPtr b -> IO()
+type AjaxCallback a b = JSPtr a -> String -> JSPtr b -> IO()
+type JSAjaxCallback a b = JSFunPtr (AjaxCallback a b)
+
+data AjaxRequestType = GET | POST
+ deriving Show
+
data AjaxOptions a = AjaxOptions {
ao_url :: String,
- ao_requestType :: String,
+ ao_requestType :: AjaxRequestType,
ao_contentType :: String,
ao_dataType :: String
}
@@ -32,7 +39,7 @@ instance Show (JSAjaxOptions a) where
toJSOptions :: AjaxOptions a -> JSAjaxOptions a
toJSOptions options = let url' = toJS (ao_url options)
- requestType' = toJS (ao_requestType options)
+ requestType' = toJS (show $ ao_requestType options)
contentType' = toJS (ao_contentType options)
dataType' = toJS (ao_dataType options)
in JSAjaxOptions { url = url'
@@ -42,21 +49,28 @@ toJSOptions options = let url' = toJS (ao_url options)
}
-ajaxBackend :: (JSPtr a -> IO ()) -> AjaxOptions a -> AjaxCallback a -> AjaxCallback a -> IO ()
+ajaxBackend :: (JSPtr a -> IO ()) -> AjaxOptions a -> AjaxCallback a b -> AjaxCallback a b -> 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
- _ajax o
+ _ <- setAttr "success" onSuccess' o
+ _ <- setAttr "error" onFailure' o
+ _ajaxQ (toJS "jcu_app") o
-ajax :: AjaxOptions a -> AjaxCallback a -> AjaxCallback a -> IO ()
+ajax :: AjaxOptions a -> AjaxCallback a b -> AjaxCallback a b -> IO ()
ajax = ajaxBackend _ajax
-
+
+foreign import jscript "wrapper"
+ mkJSAjaxCallback :: AjaxCallback a b -> IO (JSAjaxCallback a b)
foreign import jscript "$.ajax(%1)"
- _ajax :: JSPtr a -> IO ()
+ _ajax :: JSPtr a -> IO ()
+
+foreign import jscript "$.ajaxq(%*)"
+ _ajaxQ :: JSString -> JSPtr a -> IO ()
@@ -8,23 +8,8 @@ import Language.UHC.JScript.JQuery.Ajax
import Language.UHC.JScript.Assorted (alert, _alert)
-ajaxQ :: String -> AjaxOptions a -> AjaxCallback a -> AjaxCallback a -> IO ()
-ajaxQ queuename options onSuccess onFailure =
- do alert (show $ options)
- -- alert (ao_url options)
- -- _alert (toJS $ ao_url options)
- -- _alert $ toJS (ao_requestType options)
- -- _alert $ toJS (ao_contentType options)
- -- _alert $ toJS (ao_dataType options)
- -- -- let foo = toJSOptions options
- -- -- _alert $ jsao_url foo
- -- -- alert (show $ toJSOptions options)
- let jsOptions = toJSOptions options
- o <- mkObj jsOptions
- setAttr "type" (requestType jsOptions) o
- _ <- setAttr "success" onSuccess o
- _ <- setAttr "error" onFailure o
- _ajaxQ (toJS queuename) o
+ajaxQ :: String -> AjaxOptions a -> AjaxCallback a b -> AjaxCallback a b -> IO ()
+ajaxQ queuename = ajaxBackend (_ajaxQ $ toJS queuename)
foreign import jscript "$.ajaxq(%*)"
_ajaxQ :: JSString -> JSPtr a -> IO ()

0 comments on commit 6cdf015

Please sign in to comment.