put parseHeaders in Servant.Client.PerformRequest.GHCJS

servant-client/servant-client.cabal

@@ -28,10 +28,9 @@ library
     Servant.Client
     Servant.Common.BaseUrl
     Servant.Common.Req
-     -- fixme: shouldn't be part of the public API:
-    Servant.Client.PerformRequest.Base
   other-modules:
     Servant.Client.PerformRequest
+    Servant.Client.PerformRequest.Base
   if impl(ghcjs)
     other-modules:
       Servant.Client.PerformRequest.GHCJS
@@ -56,11 +55,11 @@ library
     , text
     , transformers
     , transformers-compat
-    , case-insensitive
   if impl(ghcjs)
     build-depends:
         ghcjs-base
       , ghcjs-prim
+      , case-insensitive
   hs-source-dirs: src
   default-language: Haskell2010
   ghc-options: -Wall
@@ -70,11 +69,11 @@ test-suite spec
   ghc-options:
     -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures
   default-language: Haskell2010
-  hs-source-dirs: test
+  hs-source-dirs: test, src
   main-is: Spec.hs
   other-modules:
       Servant.ClientSpec
-    , Servant.Client.PerformRequest.BaseSpec
+    , Servant.Client.PerformRequest.GHCJSSpec
     , Servant.Client.TestServer
     , Servant.Common.BaseUrlSpec
     , Spec
@@ -99,7 +98,6 @@ test-suite spec
     , network >= 2.6
     , QuickCheck >= 2.7
     , servant == 0.5.*
-    , servant-client
     , servant-server == 0.5.*
     , text
     , wai
@@ -107,3 +105,12 @@ test-suite spec
     , mockery
     , safe
     , process
+    , http-api-data
+    , network-uri
+    , exceptions
+    , string-conversions
+  if impl(ghcjs)
+    build-depends:
+        ghcjs-base
+      , ghcjs-prim
+      , case-insensitive

servant-client/src/Servant/Client/PerformRequest/Base.hs

@@ -1,18 +1,9 @@
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Servant.Client.PerformRequest.Base where
 
-import           Control.Arrow
 import           Control.Exception
-import qualified Data.ByteString.Char8 as BS
 import           Data.ByteString.Lazy
-import           Data.CaseInsensitive
-import           Data.Char
-import           Data.String.Conversions
 import           Data.Typeable
 import           Network.HTTP.Media
 import           Network.HTTP.Types
@@ -42,22 +33,3 @@ data ServantError
   deriving (Show, Typeable)
 
 instance Exception ServantError
-
-parseHeaders :: String -> ResponseHeaders
-parseHeaders s =
-  fmap (first mk) $
-  fmap (first strip . second strip) $
-  fmap parseHeader $
-  splitOn "\r\n" (cs s)
-  where
-    parseHeader :: BS.ByteString -> (BS.ByteString, BS.ByteString)
-    parseHeader h = case BS.breakSubstring ":" (cs h) of
-      (key, (BS.drop 1 -> value)) -> (key, value)
-
-    splitOn :: BS.ByteString -> BS.ByteString -> [BS.ByteString]
-    splitOn separator input = case BS.breakSubstring separator input of
-      (prefix, "") -> [prefix]
-      (prefix, rest) -> prefix : splitOn separator (BS.drop (BS.length separator) rest)
-
-    strip :: BS.ByteString -> BS.ByteString
-    strip = BS.dropWhile isSpace . BS.reverse . BS.dropWhile isSpace . BS.reverse

servant-client/src/Servant/Client/PerformRequest/GHCJS.hs

@@ -1,16 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Servant.Client.PerformRequest.GHCJS (
   ServantError(..),
   performHttpRequest,
+
+  -- exported for testing
+  parseHeaders,
   ) where
 
+import           Control.Arrow
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
+import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy as LBS
 import           Data.CaseInsensitive
+import           Data.Char
 import           Data.String.Conversions
 import           GHCJS.Foreign.Callback
 import           GHCJS.Prim
@@ -149,3 +157,22 @@ getResponseText :: JSXMLHttpRequest -> IO String
 getResponseText xhr = fromJSString <$> js_responseText xhr
 foreign import javascript unsafe "$1.responseText"
   js_responseText :: JSXMLHttpRequest -> IO JSVal
+
+parseHeaders :: String -> ResponseHeaders
+parseHeaders s =
+  fmap (first mk) $
+  fmap (first strip . second strip) $
+  fmap parseHeader $
+  splitOn "\r\n" (cs s)
+  where
+    parseHeader :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+    parseHeader h = case BS.breakSubstring ":" (cs h) of
+      (key, (BS.drop 1 -> value)) -> (key, value)
+
+    splitOn :: BS.ByteString -> BS.ByteString -> [BS.ByteString]
+    splitOn separator input = case BS.breakSubstring separator input of
+      (prefix, "") -> [prefix]
+      (prefix, rest) -> prefix : splitOn separator (BS.drop (BS.length separator) rest)
+
+    strip :: BS.ByteString -> BS.ByteString
+    strip = BS.dropWhile isSpace . BS.reverse . BS.dropWhile isSpace . BS.reverse

servant-client/test/Servant/Client/PerformRequest/GHCJSSpec.hs

@@ -1,10 +1,13 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Servant.Client.PerformRequest.BaseSpec where
+module Servant.Client.PerformRequest.GHCJSSpec where
 
 import           Test.Hspec
 
-import           Servant.Client.PerformRequest.Base
+#ifdef __GHCJS__
+
+import           Servant.Client.PerformRequest.GHCJS
 
 spec :: Spec
 spec = do
@@ -18,3 +21,9 @@ spec = do
 
     it "handles colons in header values correctly" $ do
       parseHeaders "foo: bar:baz" `shouldBe` [("foo", "bar:baz")]
+
+#else
+
+spec :: Spec
+spec = return ()
+#endif

servant-client/test/ghcjs/testServer.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.5.4.
+-- This file has been generated from package.yaml by hpack version 0.8.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -30,10 +30,11 @@ executable testServer
     , transformers
     , network
   other-modules:
-      Servant.Client.PerformRequest.BaseSpec
+      Servant.Client.PerformRequest.GHCJSSpec
       Servant.Client.TestServer
       Servant.Client.TestServer.GHC
       Servant.Client.TestServer.GHCJS
+      Servant.Client.TestServer.Types
       Servant.ClientSpec
       Servant.Common.BaseUrlSpec
       Spec