add support for GHCJS

README.md

@@ -71,3 +71,6 @@ getAnswers = execAPI stackOverflow () $ runRoute answersRoute
 > getAnswers
 Right (Questions [Question {title = "Using parse API with codeigniter", isAnswered = True, score = 2, tags = ["php","codeigniter","parse.com","codeigniter-2","php-5.6"]},Question {title = "Object...
 ```
+
+If you have built code with GHCJS you can open `your-bin-dir/ghcjs-example.jsexe/index.html`
+in your browser and see the result of query execution in a browser console.

api-builder.cabal

@@ -31,19 +31,28 @@ library
     Network.API.Builder.Receive
     Network.API.Builder.Routes
     Network.API.Builder.Send
-    Network.API.Builder.Send.Multipart
+  if !impl(ghcjs)
+    exposed-modules:
+      Network.API.Builder.Send.Multipart
   build-depends:
     base >= 4.6 && < 4.9,
     aeson >= 0.9 && < 0.11,
     bifunctors >= 4.0 && < 6.0,
     bytestring == 0.10.*,
     HTTP == 4000.*,
-    http-client >= 0.4.11 && < 0.4.25,
-    http-client-tls >= 0.2 && < 0.2.3,
-    http-types == 0.8.*,
+    http-types >= 0.9,
     text == 1.*,
-    tls >= 1.2 && < 1.3.2,
+    tls >= 1.2 && < 1.3.5,
     transformers >= 0.4 && < 0.5
+  if !impl(ghcjs)
+      build-depends:
+        http-client >= 0.4.11 && < 0.4.28,
+        http-client-tls >= 0.2 && < 0.3
+  if impl(ghcjs)
+      build-depends:
+        ghcjs-base
+  js-sources: jsbits/xhr.js
+
   hs-source-dirs: src/
   default-language: Haskell2010
   default-extensions:
@@ -89,3 +98,19 @@ test-suite test-io
     text,
     transformers
   GHC-options: -Wall
+
+
+executable ghcjs-example
+  if !impl(ghcjs)
+    Buildable: False
+  ghc-options: -Wall
+  cpp-options: -DGHCJS_BROWSER
+
+  default-extensions: CPP
+  default-language: Haskell2010
+  hs-source-dirs: ghcjs-example
+  main-is: Main.hs
+  build-depends: base
+               , api-builder
+  if impl(ghcjs)
+    build-depends: ghcjs-base

ghcjs-example/Main.hs

@@ -0,0 +1,10 @@
+-- |
+
+module Main where
+
+import           Network.API.Builder.Examples.StackOverflow
+
+main :: IO ()
+main = do
+  res <- getAnswers
+  print res

jsbits/xhr.js

@@ -0,0 +1,16 @@
+function h$sendXHR(xhr, d, cont) {
+    xhr.addEventListener('error', function () {
+	cont(2);
+    });
+    xhr.addEventListener('abort', function() {
+	cont(1);
+    });
+    xhr.addEventListener('load', function() {
+	cont(0);
+    });
+    if(d) {
+	xhr.send(d);
+    } else {
+	xhr.send();
+    }
+}

src/Network/API/Builder/API.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Network.API.Builder.API (
   -- * API
     API
@@ -19,26 +20,66 @@ module Network.API.Builder.API (
   , name
   , baseURL
   , customizeRoute
-  , customizeRequest ) where
-
-import Network.API.Builder.Builder
-import Network.API.Builder.Error
-import Network.API.Builder.Receive
-import Network.API.Builder.Routes
-import Network.API.Builder.Send
-
-import Data.Bifunctor
-import Control.Exception
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.State
-import Data.ByteString.Lazy (ByteString)
-import Data.Text (Text)
+  , customizeRequest
+#ifdef __GHCJS__
+  , Manager(..)
+  , ManagerSettings(..)
+  , httpLbs
+  , newManager
+  , closeManager
+  , tlsManagerSettings
+#endif
+  ) where
+
+import           Network.API.Builder.Builder
+import           Network.API.Builder.Error
+import           Network.API.Builder.Receive
+import           Network.API.Builder.Routes
+import           Network.API.Builder.Send
+
+import           Control.Exception
+import           Control.Monad.IO.Class      (MonadIO, liftIO)
+import           Control.Monad.Trans.Class   (lift)
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Reader
+import           Control.Monad.Trans.State
+import           Data.Bifunctor
+import           Data.Text                   (Text)
+
+#ifdef __GHCJS__
+
+import JavaScript.Web.XMLHttpRequest
+import           Data.ByteString        (ByteString)
+
+#else
+
+import           Data.ByteString.Lazy        (ByteString)
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
 
+#endif
+
+#ifdef __GHCJS__
+data Manager = Manager
+
+data ManagerSettings = ManagerSettings
+
+httpLbs :: Request -> Manager -> IO (Response ByteString)
+
+httpLbs req _ =
+  xhrByteString req
+
+newManager :: ManagerSettings -> IO Manager
+newManager _ = return Manager
+
+closeManager :: Manager -> IO ()
+closeManager _ = return ()
+
+tlsManagerSettings :: ManagerSettings
+tlsManagerSettings = ManagerSettings
+
+#endif
+
 -- | Main API type. @s@ is the API's internal state, @e@ is the API's custom error type,
 --   and @a@ is the result when the API runs. Based on the @APIT@ transformer.
 type API s e a = APIT s e IO a

src/Network/API/Builder/Builder.hs

@@ -1,11 +1,16 @@
+{-# LANGUAGE CPP #-}
 module Network.API.Builder.Builder
   ( Builder(..)
   , basicBuilder ) where
 
 import Network.API.Builder.Routes
 
 import Data.Text (Text)
+#ifdef __GHCJS__
+import JavaScript.Web.XMLHttpRequest (Request)
+#else
 import Network.HTTP.Client (Request)
+#endif
 import qualified Data.Text as T
 
 -- | Builder type for the API. Keeps track of the API's name and base URL, and how

src/Network/API/Builder/Error.hs

@@ -1,10 +1,19 @@
+{-# LANGUAGE CPP #-}
 module Network.API.Builder.Error
   ( APIError(..) ) where
 
 import Data.Monoid
+#ifdef __GHCJS__
+import JavaScript.Web.XMLHttpRequest (XHRError)
+#else
 import Network.HTTP.Client (HttpException)
+#endif
 import Prelude
 
+#ifdef __GHCJS__
+type HttpException = XHRError
+#endif
+
 -- | Error type for the @API@, where @a@ is the type that should be returned when
 --   something goes wrong on the other end - i.e. any error that isn't directly related
 --   to this library.

src/Network/API/Builder/Receive.hs

@@ -1,11 +1,26 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Network.API.Builder.Receive where
 
 import Network.API.Builder.Error
 
 import Control.Applicative
 import Data.Aeson
+
+#ifdef __GHCJS__
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Lazy (fromStrict)
+import Data.Maybe (fromMaybe)
+import JavaScript.Web.XMLHttpRequest
+
+#else
+
 import Data.ByteString.Lazy (ByteString)
 import Network.HTTP.Client
+
+#endif
+
 import Prelude
 
 class Receivable r where
@@ -34,7 +49,7 @@ instance (Receivable a, Receivable b, Receivable c, Receivable d, Receivable e)
 
 useFromJSON :: (FromJSON a, ErrorReceivable e) => Response ByteString -> Either (APIError e) a
 useFromJSON resp =
-  case eitherDecode $ responseBody resp of
+  case jsonDecode $ responseBody resp of
     Left err ->
       case receiveError resp of
         Just x -> Left $ APIError x
@@ -55,7 +70,7 @@ instance ErrorReceivable Value where
 
 useErrorFromJSON :: FromJSON a => Response ByteString -> Maybe a
 useErrorFromJSON resp =
-  case eitherDecode (responseBody resp) of
+  case jsonDecode (responseBody resp) of
     Right x -> Just x
     Left _ -> Nothing
 
@@ -68,3 +83,17 @@ instance FromJSON a => FromJSON (JSONResponse a) where
 instance FromJSON a => Receivable (JSONResponse a) where
   receive = useFromJSON
 
+#ifdef __GHCJS__
+
+responseBody :: Response ByteString -> ByteString
+responseBody = fromMaybe "" . contents
+
+jsonDecode :: FromJSON a => ByteString -> Either String a
+jsonDecode = eitherDecode . fromStrict
+
+#else
+
+jsonDecode :: FromJSON a => ByteString -> Either String a
+jsonDecode = eitherDecode
+
+#endif

src/Network/API/Builder/Routes.hs

@@ -49,12 +49,7 @@ routeURL baseURL (Route fs ps _) =
   where
     firstSep = if null fs then T.empty else "/"
     path = T.intercalate "/" fs
-    querySep = if null ps then T.empty else pathParamsSep fs
-
-
-pathParamsSep :: [URLPiece] -> Text
-pathParamsSep [] = "?"
-pathParamsSep xs = if T.isInfixOf "." (last xs) then "?" else "/?"
+    querySep = if null ps then T.empty else "?"
 
 buildParams :: [URLParam] -> Text
 buildParams = T.pack . HTTP.urlEncodeVars . concatMap (map (T.unpack *** T.unpack))