module Haste.Ajax (Method (..), URL, ajaxRequest, noParams) where
import Haste.Foreign
import Haste.Prim
import Haste.Prim.JSType
import Control.Monad.IO.Class
import Control.Monad (join)
ajaxReq :: Method
-> JSString
-> Bool
-> JSString
-> (Maybe JSString -> IO ())
-> IO ()
ajaxReq = ffi "(function(method, url, async, postdata, cb) {\
\var xhr = new XMLHttpRequest();\
\xhr.open(method, url, async);\
\if(method == 'POST') {\
\xhr.setRequestHeader('Content-type',\
\'application/x-www-form-urlencoded');\
\}\
\xhr.onreadystatechange = function() {\
\if(xhr.readyState == 4) {\
\cb(xhr.status == 200 ? xhr.responseText : null);\
\}\
\};\
\xhr.send(postdata);})"
data Method = GET | POST deriving Show
instance ToAny Method where
toAny GET = toAny ("GET" :: JSString)
toAny POST = toAny ("POST" :: JSString)
noParams :: [((), ())]
noParams = []
ajaxRequest :: (MonadIO m, JSType a, JSType b, JSType c)
=> Method
-> URL
-> [(a, b)]
-> (Maybe c -> IO ())
-> m ()
ajaxRequest m url kv cb = liftIO $ do
_ <- ajaxReq m url' True pd (cb . join . fmap fromJSString)
return ()
where
url' = case m of
GET
| null kv -> toJSString url
| otherwise -> catJSStr "?" [toJSString url, toQueryString kv]
POST -> toJSString url
pd = case m of
GET -> ""
POST
| null kv -> ""
| otherwise -> toQueryString kv
toQueryString :: (JSType a, JSType b) =>[(a, b)] -> JSString
toQueryString = catJSStr "&" . map f
where f (k, v) = catJSStr "=" [toJSString k,toJSString v]