Begin freer-servant-client

cabal.project

@@ -1,6 +1,7 @@
 packages:
   servant/
   servant-client/
+  freer-servant-client/
   servant-docs/
   servant-foreign/
   servant-server/

freer-servant-client/Setup.hs

@@ -0,0 +1,2 @@
+import           Distribution.Simple
+main = defaultMain

freer-servant-client/freer-servant-client.cabal

@@ -0,0 +1,100 @@
+name:                freer-servant-client
+version:             0.1
+synopsis: automatical derivation of querying functions for servant webservices
+description:
+  This library lets you derive automatically Haskell functions that
+  let you query each endpoint of a <http://hackage.haskell.org/package/servant servant> webservice.
+license:             BSD3
+license-file:        LICENSE
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+copyright:           2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
+category:            Servant Web
+build-type:          Simple
+cabal-version:       >=1.10
+tested-with:         GHC >= 7.8
+homepage:            http://haskell-servant.readthedocs.org/
+Bug-reports:         http://github.com/haskell-servant/servant/issues
+extra-source-files:
+  include/*.h
+  CHANGELOG.md
+  README.md
+source-repository head
+  type: git
+  location: http://github.com/haskell-servant/servant.git
+
+library
+  exposed-modules:
+    Servant.FreerClient
+  build-depends:
+      base                  >= 4.7      && < 4.11
+    , base-compat           >= 0.9.1    && < 0.10
+    , aeson                 >= 0.7      && < 1.3
+    , attoparsec            >= 0.12     && < 0.14
+    , base64-bytestring     >= 1.0.0.1  && < 1.1
+    , bytestring            >= 0.10     && < 0.11
+    , containers            >= 0.5.7.1
+    , exceptions            >= 0.8      && < 0.9
+    , freer-effects         == 0.3.*
+    , generics-sop          >= 0.1.0.0  && < 0.4
+    , http-api-data         >= 0.3.6    && < 0.4
+    , http-client           >= 0.4.18.1 && < 0.6
+    , http-client-tls       >= 0.2.2    && < 0.4
+    , http-media            >= 0.6.2    && < 0.7
+    , http-types            >= 0.8.6    && < 0.10
+    , monad-control         >= 1.0.0.4  && < 1.1
+    , network-uri           >= 2.6      && < 2.7
+    , safe                  >= 0.3.9    && < 0.4
+    , semigroupoids         >= 4.3      && < 5.3
+    , servant               == 0.11.*
+    , servant-client        == 0.11.*
+    , string-conversions    >= 0.3      && < 0.5
+    , text                  >= 1.2      && < 1.3
+    , transformers          >= 0.3      && < 0.6
+    , transformers-base     >= 0.4.4    && < 0.5
+    , transformers-compat   >= 0.4      && < 0.6
+    , mtl
+    , freer-http
+  if !impl(ghc >= 8.0)
+    build-depends:
+        semigroups          >=0.16.2.2 && <0.19
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -Wall
+  if impl(ghc >= 8.0)
+    ghc-options: -Wno-redundant-constraints
+  include-dirs: include
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  ghc-options: -Wall
+  default-language: Haskell2010
+  hs-source-dirs: test
+  main-is: Spec.hs
+  other-modules:
+      Servant.ClientSpec
+    , Servant.Common.BaseUrlSpec
+  build-depends:
+      base == 4.*
+    , aeson
+    , base-compat
+    , bytestring
+    , deepseq
+    , hspec == 2.*
+    , http-api-data
+    , http-client
+    , http-media
+    , http-types
+    , HUnit
+    , mtl
+    , network >= 2.6
+    , QuickCheck >= 2.7
+    , servant
+    , servant-client
+    , servant-server == 0.11.*
+    , text
+    , transformers
+    , transformers-compat
+    , wai
+    , warp
+    , generics-sop

freer-servant-client/src/Servant/FreerClient.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RankNTypes            #-}
+
+module Servant.FreerClient where
+
+import Control.Exception (toException)
+import Control.Monad.Freer
+import Control.Monad.Freer.Exception
+import Control.Monad.Freer.Http
+import Control.Monad.Freer.Reader
+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
+import Data.String.Conversions (cs)
+import Network.HTTP.Client (Response)
+import Network.HTTP.Types
+import Network.HTTP.Media
+import Servant.Common.Req hiding (ClientM, runClientM')
+
+import qualified Network.HTTP.Client as Client
+import qualified Network.HTTP.Types.Header   as HTTP
+
+newtype ClientM r a = ClientM { runClientM' :: ( Member (Reader ClientEnv) r
+                                               , Member (Exc ServantError) r
+                                               , Member Http r) => (Eff r) a }
+
+instance Functor (ClientM r) where
+  fmap f a = ClientM $ fmap f (runClientM' a)
+
+instance Applicative (ClientM r) where
+  pure a = ClientM $ pure a
+  f <*> a = ClientM $ (runClientM' f) <*> (runClientM' a)
+
+instance Monad (ClientM r) where
+  a >>= f = ClientM $ (runClientM' a) >>= (runClientM' . f)
+
+performRequest :: ( Member Http r
+                  , Member (Reader ClientEnv) r
+                  , Member (Exc ServantError) r)
+               => Method -> Req -> ClientM r ( Int, ByteString, MediaType
+                                             , [HTTP.Header], Response ByteString)
+performRequest reqMethod req = ClientM $ do
+  m <- asks manager
+  reqHost <- asks baseUrl
+  response <- case (reqToRequest req reqHost) of
+    Left some -> throwError . ConnectionError $ toException some
+    Right request -> doRequest request
+  let status = Client.responseStatus response
+      body = Client.responseBody response
+      hdrs = Client.responseHeaders response
+      status_code = statusCode status
+  ct <- case lookup "Content-Type" $ Client.responseHeaders response of
+    Nothing -> pure $ "application"//"octet-stream"
+    Just t -> case parseAccept t of
+      Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
+      Just t' -> pure t'
+  return (status_code, body, ct, hdrs, response)
+
+runClientM :: ClientM ('[ Reader ClientEnv
+                        , Exc ServantError
+                        , Http
+                        , IO]) a -> ClientEnv -> IO (Either ServantError a)
+runClientM cm ce@ClientEnv { manager = mgr } =
+  runM . (runHttp mgr) . runError . (flip runReader ce) $ runClientM' cm

servant-client/servant-client.cabal

@@ -47,7 +47,7 @@ library
     , http-api-data         >= 0.3.6    && < 0.4
     , http-client           >= 0.4.18.1 && < 0.6
     , http-client-tls       >= 0.2.2    && < 0.4
-    , http-media            >= 0.6.2    && < 0.8
+    , http-media            >= 0.6.2    && < 0.7
     , http-types            >= 0.8.6    && < 0.10
     , monad-control         >= 1.0.0.4  && < 1.1
     , network-uri           >= 2.6      && < 2.7

servant/servant.cabal

@@ -64,7 +64,7 @@ library
     , bytestring            >= 0.10 && < 0.11
     , case-insensitive      >= 1.2  && < 1.3
     , http-api-data         >= 0.3  && < 0.4
-    , http-media            >= 0.4  && < 0.8
+    , http-media            >= 0.4  && < 0.7
     , http-types            >= 0.8  && < 0.10
     , natural-transformation >= 0.4 && < 0.5
     , mtl                   >= 2.0  && < 2.3

stack-ghc-7.10.3.yaml

@@ -2,6 +2,7 @@ flags: {}
 packages:
 - servant/
 - servant-client/
+- freer-servant-client/
 - servant-docs/
 - servant-foreign/
 - servant-server/

stack-ghc-7.8.4.yaml

@@ -2,6 +2,7 @@ flags: {}
 packages:
 - servant/
 - servant-client/
+- freer-servant-client/
 - servant-docs/
 - servant-foreign/
 - servant-server/

stack-ghc-8.2.1.yaml

@@ -1,6 +1,7 @@
 resolver: ghc-8.2.0.20170507
 packages:
 - servant-client/
+- freer-servant-client/
 - servant-docs/
 - servant-foreign/
 - servant-server/

stack.yaml

@@ -2,14 +2,18 @@ resolver: nightly-2017-04-01
 packages:
 - servant/
 - servant-client/
+- freer-servant-client/
 - servant-docs/
 - servant-foreign/
 - servant-server/
 - doc/tutorial
+- location:
+    git: git@gitlab.com:costar-astrology/freer-http.git
+    commit: 23310fb0d4d91197a2c6cda071e9f5fb6fe34fcc
+  extra-dep: true
 extra-deps:
 - aeson-1.2.0.0
 - attoparsec-iso8601-1.0.0.0
-- http-media-0.7.0
 - cabal-doctest-1.0.2
 - http-api-data-0.3.7
 - servant-js-0.9.3