ghcjs-ajax 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+34/−16 lines, 3 filesdep +aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson

API changes (from Hackage documentation)

Files

• ghcjs-ajax.cabal +2/−1
• jsbits/core.js +4/−1
• src/JavaScript/Ajax.hs +28/−14

@@ -1,5 +1,5 @@ name:                ghcjs-ajax-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Crossbrowser AJAX Bindings for GHCJS description:         Please see README.md homepage:            https://github.com/agrafix/ghcjs-ajax#readme@@ -19,6 +19,7 @@   build-depends:       base >=4.7 && <5                      , text                      , http-types+                     , aeson   default-language:    Haskell2010   js-sources:          jsbits/core.js   if impl(ghcjs)

@@ -7,7 +7,10 @@  * @param {string|null} contentType The content type  * @param {function(number, string)} onComplete success handler  */-function ghcjsajax$sendRequest(url, method, requestBody, contentType, onComplete) {+function ghcjsajax$sendRequest(url, method, requestBody, contentType, cont) {+    var onComplete = function (status, body) {+        cont({ "status": status, "body": body });+    };     var req = ghcjsajax$createXMLHTTPObject();     if (!req) {         onComplete(500, "Browser not supported");

@@ -1,11 +1,16 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# LANGUAGE DeriveDataTypeable #-} module JavaScript.Ajax     ( sendRequest, StdMethod(..), Status(..)     , RequestBody, ContentType+    , AjaxResponse(..)     ) where +import Data.Aeson+import Data.Typeable import Network.HTTP.Types.Method import Network.HTTP.Types.Status import qualified Data.Text as T@@ -15,25 +20,36 @@ import Data.JSString.Text (textToJSString) import GHCJS.Types import GHCJS.Marshal (ToJSVal(..), FromJSVal(..))-import GHCJS.Foreign.Callback #endif  type RequestBody = T.Text type ContentType = T.Text +data AjaxResponse+   = AjaxResponse+   { ar_status :: !Status+   , ar_body :: !T.Text+   } deriving (Show, Eq, Typeable)++instance FromJSON AjaxResponse where+    parseJSON =+        withObject "ajax_response" $ \o ->+        do st <- mkStatus <$> o .: "status" <*> pure ""+           bdy <- o .: "body"+           pure $ AjaxResponse st bdy+ -- | Send an ajax request provided a HTTP-Method, a target url, optional a request -- body and content type and a completion callback-sendRequest :: StdMethod -> T.Text -> Maybe RequestBody -> Maybe ContentType -> (Status -> T.Text -> IO ()) -> IO ()+sendRequest :: StdMethod -> T.Text -> Maybe RequestBody -> Maybe ContentType -> IO AjaxResponse #ifdef __GHCJS__-sendRequest method url mBody mContentType callback =+sendRequest method url mBody mContentType =     do jsCt <- toJSVal mContentType        jsBody <- toJSVal mBody-       jsCallback <--           asyncCallback2 $ \jsStatus jsInnerText ->-           do status <- mkStatus <$> fromJSValUnchecked jsStatus <*> pure ""-              text <- fromJSValUnchecked jsInnerText-              callback status text-       js_sendRequest (textToJSString url) jsMethod jsBody jsCt jsCallback+       jsRes <- js_sendRequest (textToJSString url) jsMethod jsBody jsCt+       val <- fromJSValUnchecked jsRes+       case fromJSON val of+         Error msg -> fail $ "Internal error (JavaScript.Ajax): " ++ msg+         Success v -> pure v     where       jsMethod =           case method of@@ -51,9 +67,7 @@ #endif  #ifdef __GHCJS__-foreign import javascript unsafe-    "ghcjsajax$sendRequest($1, $2, $3, $4, $5)"-    js_sendRequest ::-          JSString -> JSString -> JSVal -> JSVal-          -> Callback (JSVal -> JSVal -> IO ()) -> IO ()+foreign import javascript interruptible+    "ghcjsajax$sendRequest($1, $2, $3, $4, $c);"+    js_sendRequest :: JSString -> JSString -> JSVal -> JSVal -> IO JSVal #endif