Initial infrastructure, doesn't build

.gitmodules

@@ -0,0 +1,9 @@
+[submodule "deps/reflex-dom-contrib"]
+	path = deps/reflex-dom-contrib
+	url = git@github.com:reflex-frp/reflex-dom-contrib.git
+[submodule "deps/try-reflex"]
+	path = deps/try-reflex
+	url = git@github.com:ryantrinkle/try-reflex.git
+[submodule "deps/servant"]
+	path = deps/servant
+	url = https://github.com/haskell-servant/servant.git

build.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+deps/try-reflex/work-on ./overrides.nix ./. --run "cabal configure --ghcjs ; cabal build"

default.nix

@@ -0,0 +1,20 @@
+{ mkDerivation, exceptions, http-types, reflex, reflex-dom,
+  reflex-dom-contrib, servant
+}:
+
+mkDerivation {
+  pname = "servant-reflex";
+  version = "0.1";
+  src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
+  isExecutable = true;
+  isLibrary = true;
+  buildDepends = [
+    exceptions
+    http-types
+    reflex
+    reflex-dom
+    reflex-dom-contrib
+    servant
+  ];
+  license = null;
+}

deps/reflex-dom-contrib

@@ -0,0 +1 @@
+Subproject commit c36670cb316f3096cbffa30ad61ae1b5e458e2a0

deps/servant

@@ -0,0 +1 @@
+Subproject commit 2ae504143a97578d62acd9bfb3d87b873c5658a7

deps/try-reflex

@@ -0,0 +1 @@
+Subproject commit 8a2b9f350d265cecdd013a8818ef32e8ed7f3114

overrides.nix

@@ -0,0 +1,8 @@
+{}:
+let try-reflex = import deps/try-reflex {};
+in try-reflex.ghcjs.override {
+  overrides = self: super: {
+    reflex-dom-contrib = self.callPackage deps/reflex-dom-contrib {};
+    servant = self.callPackage (try-reflex.cabal2nixResult deps/servant/servant) {};
+  };
+}

servant-reflex.cabal

@@ -0,0 +1,46 @@
+Name: servant-reflex
+Version: 0.1
+Synopsis: Servant reflex API generator
+Description: Servant reflex API generator
+License: AllRightsReserved
+License-file: LICENSE
+Author: Doug Beardsley
+Maintainer: mightybyte@gmail.com
+Stability: Experimental
+Category: Web
+Build-type: Simple
+Cabal-version: >=1.8
+
+library
+  exposed-modules:     
+    Servant.Reflex
+
+  other-modules:       
+    Servant.Common.BaseUrl
+    Servant.Common.Req
+
+  hs-source-dirs: src
+  build-depends:
+    base,
+    bytestring          >= 0.10 && < 0.11,
+    containers,
+    exceptions          >= 0.8  && < 0.9,
+    ghcjs-base,
+    ghcjs-dom           == 0.1.*,
+    http-media          >= 0.6  && < 0.7,
+    http-types          >= 0.8  && < 0.9,
+    mtl,
+    network-uri         >= 2.6  && < 2.7,
+    reflex,
+    reflex-dom,
+    reflex-dom-contrib,
+    safe,
+    servant             >= 0.5  && < 0.6,
+    string-conversions,
+    text,
+    transformers        >= 0.4  && < 0.5
+
+  if impl(ghcjs)
+      build-depends: ghcjs-base
+
+  ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2

shell.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+deps/try-reflex/work-on ./overrides.nix ./.

src/Servant/Common/BaseUrl.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE ViewPatterns       #-}
+module Servant.Common.BaseUrl (
+  -- * types
+    BaseUrl (..)
+  , InvalidBaseUrlException
+  , Scheme (..)
+  -- * functions
+  , parseBaseUrl
+  , showBaseUrl
+) where
+
+import           Control.Monad.Catch (Exception, MonadThrow, throwM)
+import           Data.List
+import           Data.Typeable
+import           GHC.Generics
+import           Network.URI hiding (path)
+import           Safe
+import           Text.Read
+
+-- | URI scheme to use
+data Scheme =
+    Http  -- ^ http://
+  | Https -- ^ https://
+  deriving (Show, Eq, Ord, Generic)
+
+-- | Simple data type to represent the target of HTTP requests
+--   for servant's automatically-generated clients.
+data BaseUrl = BaseUrl
+  { baseUrlScheme :: Scheme -- ^ URI scheme to use
+  , baseUrlHost   :: String   -- ^ host (eg "haskell.org")
+  , baseUrlPort   :: Int      -- ^ port (eg 80)
+  , baseUrlPath   :: String   -- ^ path (eg "/a/b/c")
+  } deriving (Show, Ord, Generic)
+
+instance Eq BaseUrl where
+    BaseUrl a b c path == BaseUrl a' b' c' path'
+        = a == a' && b == b' && c == c' && s path == s path'
+        where s ('/':x) = x
+              s x       = x
+
+showBaseUrl :: BaseUrl -> String
+showBaseUrl (BaseUrl urlscheme host port path) =
+  schemeString ++ "//" ++ host ++ (portString </> path)
+    where
+      a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b
+      schemeString = case urlscheme of
+        Http  -> "http:"
+        Https -> "https:"
+      portString = case (urlscheme, port) of
+        (Http, 80) -> ""
+        (Https, 443) -> ""
+        _ -> ":" ++ show port
+
+data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable)
+instance Exception InvalidBaseUrlException
+
+parseBaseUrl :: MonadThrow m => String -> m BaseUrl
+parseBaseUrl s = case parseURI (removeTrailingSlash s) of
+  -- This is a rather hacky implementation and should be replaced with something
+  -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
+  Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->
+    return (BaseUrl Http host port path)
+  Just (URI "http:" (Just (URIAuth "" host "")) path "" "") ->
+    return (BaseUrl Http host 80 path)
+  Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->
+    return (BaseUrl Https host port path)
+  Just (URI "https:" (Just (URIAuth "" host "")) path "" "") ->
+    return (BaseUrl Https host 443 path)
+  _ -> if "://" `isInfixOf` s
+    then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)
+    else parseBaseUrl ("http://" ++ s)
+ where
+  removeTrailingSlash str = case lastMay str of
+    Just '/' -> init str
+    _ -> str

src/Servant/Common/Req.hs

@@ -0,0 +1,171 @@
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Servant.Common.Req where
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative
+#endif
+import Control.Exception
+import Control.Monad
+import Control.Monad.Catch (MonadThrow)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
+import Data.String
+import Data.String.Conversions
+import Data.Proxy
+import Data.Text (Text)
+import Data.Text.Encoding
+import Data.Typeable
+import Network.HTTP.Media
+import Network.HTTP.Types
+import qualified Network.HTTP.Types.Header   as HTTP
+import Network.URI hiding (path)
+import Servant.API.ContentTypes
+import Servant.Common.BaseUrl
+
+import Web.HttpApiData
+
+data ServantError
+  = FailureResponse
+    { responseStatus            :: Status
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | DecodeFailure
+    { decodeError               :: String
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | UnsupportedContentType
+    { responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | InvalidContentTypeHeader
+    { responseContentTypeHeader :: ByteString
+    , responseBody              :: ByteString
+    }
+  | ConnectionError
+    { connectionError           :: SomeException
+    }
+  deriving (Show, Typeable)
+
+instance Exception ServantError
+
+data Req = Req
+  { reqPath   :: String
+  , qs        :: QueryText
+  , reqBody   :: Maybe (ByteString, MediaType)
+  , reqAccept :: [MediaType]
+  , headers   :: [(String, Text)]
+  }
+
+defReq :: Req
+defReq = Req "" [] Nothing [] []
+
+appendToPath :: String -> Req -> Req
+appendToPath p req =
+  req { reqPath = reqPath req ++ "/" ++ p }
+
+appendToQueryString :: Text       -- ^ param name
+                    -> Maybe Text -- ^ param value
+                    -> Req
+                    -> Req
+appendToQueryString pname pvalue req =
+  req { qs = qs req ++ [(pname, pvalue)]
+      }
+
+addHeader :: ToHttpApiData a => String -> a -> Req -> Req
+addHeader name val req = req { headers = headers req
+                                      ++ [(name, decodeUtf8 (toHeader val))]
+                             }
+
+setRQBody :: ByteString -> MediaType -> Req -> Req
+setRQBody b t req = req { reqBody = Just (b, t) }
+
+reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
+reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
+    setheaders . setAccept . setrqb . setQS <$> parseUrl url
+
+  where url = show $ nullURI { uriScheme = case reqScheme of
+                                  Http  -> "http:"
+                                  Https -> "https:"
+                             , uriAuthority = Just $
+                                 URIAuth { uriUserInfo = ""
+                                         , uriRegName = reqHost
+                                         , uriPort = ":" ++ show reqPort
+                                         }
+                             , uriPath = path ++ reqPath req
+                             }
+
+        setrqb r = case reqBody req of
+                     Nothing -> r
+                     Just (b,t) -> r { requestBody = RequestBodyLBS b
+                                     , requestHeaders = requestHeaders r
+                                                     ++ [(hContentType, cs . show $ t)] }
+        setQS = setQueryString $ queryTextToQuery (qs req)
+        setheaders r = r { requestHeaders = requestHeaders r
+                                         <> fmap toProperHeader (headers req) }
+        setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)
+                                        <> [("Accept", renderHeader $ reqAccept req)
+                                              | not . null . reqAccept $ req] }
+        toProperHeader (name, val) =
+          (fromString name, encodeUtf8 val)
+
+
+-- * performing requests
+
+displayHttpRequest :: Method -> String
+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
+
+performRequest = undefined
+performRequestCT = undefined
+performRequestNoBody = undefined
+
+-- performRequest :: Method -> Req -> BaseUrl -> Manager
+--                -> ExceptT ServantError IO ( Int, ByteString, MediaType
+--                                           , [HTTP.Header], Response ByteString)
+-- performRequest reqMethod req reqHost manager = do
+--   partialRequest <- liftIO $ reqToRequest req reqHost
+--
+--   let request = partialRequest { Client.method = reqMethod
+--                                , checkStatus = \ _status _headers _cookies -> Nothing
+--                                }
+--
+--   eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
+--   case eResponse of
+--     Left err ->
+--       throwE . ConnectionError $ SomeException err
+--
+--     Right response -> do
+--       let status = Client.responseStatus response
+--           body = Client.responseBody response
+--           hrds = 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 -> throwE $ InvalidContentTypeHeader (cs t) body
+--                    Just t' -> pure t'
+--       unless (status_code >= 200 && status_code < 300) $
+--         throwE $ FailureResponse status ct body
+--       return (status_code, body, ct, hrds, response)
+--
+--
+-- performRequestCT :: MimeUnrender ct result =>
+--   Proxy ct -> Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)
+-- performRequestCT ct reqMethod req reqHost manager = do
+--   let acceptCT = contentType ct
+--   (_status, respBody, respCT, hrds, _response) <-
+--     performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
+--   unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
+--   case mimeUnrender ct respBody of
+--     Left err -> throwE $ DecodeFailure err respCT respBody
+--     Right val -> return (hrds, val)
+--
+-- performRequestNoBody :: Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ()
+-- performRequestNoBody reqMethod req reqHost manager =
+--   void $ performRequest reqMethod req reqHost manager
+

src/Servant/Reflex.hs

@@ -0,0 +1,576 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE InstanceSigs         #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+#if !MIN_VERSION_base(4,8,0)
+{-# LANGUAGE OverlappingInstances #-}
+#endif
+-- | This module provides 'client' which can automatically generate
+-- querying functions for each endpoint just from the type representing your
+-- API.
+module Servant.Reflex
+  ( client
+  , HasReflexClient(..)
+  , ServantError(..)
+  , module Servant.Common.BaseUrl
+  ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import           Control.Applicative        ((<$>))
+#endif
+import           Control.Monad
+import           Control.Monad.Trans.Except
+import           Data.ByteString.Lazy       (ByteString)
+import           Data.List
+import           Data.Proxy
+import           Data.String.Conversions
+import           Data.Text                  (unpack)
+import           GHC.TypeLits
+import           Network.HTTP.Media
+import qualified Network.HTTP.Types         as H
+import qualified Network.HTTP.Types.Header  as HTTP
+import           Servant.API
+import           Servant.Common.BaseUrl
+import           Servant.Common.Req
+import Web.HttpApiData
+
+-- * Accessing APIs as a Client
+
+-- | 'client' allows you to produce operations to query an API from a client.
+--
+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
+-- >         :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getAllBooks :: ExceptT String IO [Book]
+-- > postNewBook :: Book -> ExceptT String IO Book
+-- > (getAllBooks :<|> postNewBook) = client myApi host
+-- >   where host = BaseUrl Http "localhost" 8080
+client :: HasReflexClient layout => Proxy layout -> BaseUrl -> Input layout -> Client layout
+client p baseurl = clientWithRoute p defReq baseurl
+
+type Final a = forall m. m a
+
+data a ::> b = a ::> b deriving (Eq,Ord,Show,Read)
+
+infixr 3 ::>
+
+-- | This class lets us define how each API combinator
+-- influences the creation of an HTTP request. It's mostly
+-- an internal class, you can just use 'client'.
+class HasReflexClient layout where
+  type Input layout :: *
+  type Client layout :: *
+  clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Input layout -> Client layout
+
+
+-- | If you have a 'Get' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance
+#if MIN_VERSION_base(4,8,0)
+         {-# OVERLAPPABLE #-}
+#endif
+  (MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where
+  type Input (Get (ct ': cts) result) = ()
+  type Client (Get (ct ': cts) result) = Final result
+  clientWithRoute Proxy req baseurl _ =
+    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
+
+instance
+#if MIN_VERSION_base(4,8,0)
+         {-# OVERLAPPING #-}
+#endif
+  HasReflexClient (Get (ct ': cts) ()) where
+  type Input (Get (ct ': cts) ()) = ()
+  type Client (Get (ct ': cts) ()) = Final ()
+  clientWithRoute Proxy req baseurl _ =
+    performRequestNoBody H.methodGet req baseurl
+
+-- | Pick a 'Method' and specify where the server you want to query is. You get
+-- back the full `Response`.
+instance HasReflexClient Raw where
+  type Input Raw = H.Method ::> ()
+  type Client Raw = Final (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
+
+  clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Input Raw -> Client Raw
+  clientWithRoute Proxy req baseurl (httpMethod ::> ()) = do
+    performRequest httpMethod req baseurl
+
+-- -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
+-- -- corresponding headers.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   ( MimeUnrender ct a, BuildHeadersTo ls
+--   ) => HasReflexClient (Get (ct ': cts) (Headers ls a)) where
+--   type Input (Get (ct ': cts) (Headers ls a)) = ()
+--   type Client (Get (ct ': cts) (Headers ls a)) = Final (Headers ls a)
+--   clientWithRoute Proxy req baseurl _ = do
+--     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
+--     return $ Headers { getResponse = resp
+--                      , getHeadersHList = buildHeadersTo hdrs
+--                      }
+--
+-- -- | A client querying function for @a ':<|>' b@ will actually hand you
+-- --   one function for querying @a@ and another one for querying @b@,
+-- --   stitching them together with ':<|>', which really is just like a pair.
+-- --
+-- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
+-- -- >         :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > getAllBooks :: ExceptT String IO [Book]
+-- -- > postNewBook :: Book -> ExceptT String IO Book
+-- -- > (getAllBooks :<|> postNewBook) = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- instance (HasReflexClient a, HasReflexClient b) => HasReflexClient (a :<|> b) where
+--   type Input (a :<|> b) = Input a :<|> Input b
+--   type Client (a :<|> b) = Client a :<|> Client b
+--   clientWithRoute Proxy req baseurl (a :<|> b) =
+--     clientWithRoute (Proxy :: Proxy a) req baseurl a :<|>
+--     clientWithRoute (Proxy :: Proxy b) req baseurl b
+--
+-- ------------------------------------------------------------------------------
+-- -- | If you use a 'Capture' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional argument of the type specified by your 'Capture'.
+-- -- That function will take care of inserting a textual representation
+-- -- of this value at the right place in the request path.
+-- --
+-- -- You can control how values for this type are turned into
+-- -- text by specifying a 'ToHttpApiData' instance for your type.
+-- --
+-- -- Example:
+-- --
+-- -- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > getBook :: Text -> ExceptT String IO Book
+-- -- > getBook = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "getBook" to query that endpoint
+-- instance (KnownSymbol capture, ToHttpApiData a, HasReflexClient sublayout)
+--       => HasReflexClient (Capture capture a :> sublayout) where
+--
+--   type Input (Capture cap a :> sublayout) = a ::> Input sublayout
+--   type Client (Capture capture a :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl (val ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (appendToPath p req) baseurl rest
+--
+--     where p = unpack (toUrlPiece val)
+--
+-- -- | If you have a 'Delete' endpoint in your API, the client
+-- -- side querying function that is created when calling 'client'
+-- -- will just require an argument that specifies the scheme, host
+-- -- and port to send the request to.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPABLE #-}
+-- #endif
+--   (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasReflexClient (Delete cts' a) where
+--   type Input (Delete cts' a) = ()
+--   type Client (Delete cts' a) = Final a
+--   clientWithRoute Proxy req baseurl val =
+--     snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl val
+--
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   HasReflexClient (Delete cts ()) where
+--   type Input (Delete cts ()) = ()
+--   type Client (Delete cts ()) = Final ()
+--   clientWithRoute Proxy req baseurl val =
+--     void $ performRequestNoBody H.methodDelete req baseurl val
+--
+-- -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
+-- -- corresponding headers.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
+--   ) => HasReflexClient (Delete cts' (Headers ls a)) where
+--   type Input (Delete cts' (Headers ls a)) = ()
+--   type Client (Delete cts' (Headers ls a)) = Final (Headers ls a)
+--   clientWithRoute Proxy req baseurl _ = do
+--     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl
+--     return $ Headers { getResponse = resp
+--                      , getHeadersHList = buildHeadersTo hdrs
+--                      }
+--
+-- -- | If you use a 'Header' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional argument of the type specified by your 'Header',
+-- -- wrapped in Maybe.
+-- --
+-- -- That function will take care of encoding this argument as Text
+-- -- in the request headers.
+-- --
+-- -- All you need is for your type to have a 'ToHttpApiData' instance.
+-- --
+-- -- Example:
+-- --
+-- -- > newtype Referer = Referer { referrer :: Text }
+-- -- >   deriving (Eq, Show, Generic, FromText, ToHttpApiData)
+-- -- >
+-- -- >            -- GET /view-my-referer
+-- -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > viewReferer :: Maybe Referer -> ExceptT String IO Book
+-- -- > viewReferer = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "viewRefer" to query that endpoint
+-- -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
+--       => HasReflexClient (Header sym a :> sublayout) where
+--
+--   type Input (Header sym a :> sublayout) = Maybe a ::> Input sublayout
+--   type Client (Header sym a :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl (mval ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (maybe req
+--                            (\value -> Servant.Common.Req.addHeader hname value req)
+--                            mval
+--                     )
+--                     baseurl rest
+--
+--     where hname = symbolVal (Proxy :: Proxy sym)
+--
+-- -- | If you have a 'Post' endpoint in your API, the client
+-- -- side querying function that is created when calling 'client'
+-- -- will just require an argument that specifies the scheme, host
+-- -- and port to send the request to.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPABLE #-}
+-- #endif
+--   (MimeUnrender ct a) => HasReflexClient (Post (ct ': cts) a) where
+--   type Input (Post (ct ': cts) a) = ()
+--   type Client (Post (ct ': cts) a) = Final a
+--   clientWithRoute Proxy req baseurl _ =
+--     snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
+--
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   HasReflexClient (Post (ct ': cts) ()) where
+--   type Input (Post (ct ': cts) ()) = ()
+--   type Client (Post (ct ': cts) ()) = Final ()
+--   clientWithRoute Proxy req baseurl _ =
+--     void $ performRequestNoBody H.methodPost req baseurl
+--
+-- -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
+-- -- corresponding headers.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   ( MimeUnrender ct a, BuildHeadersTo ls
+--   ) => HasReflexClient (Post (ct ': cts) (Headers ls a)) where
+--   type Input (Post (ct ': cts) (Headers ls a)) = ()
+--   type Client (Post (ct ': cts) (Headers ls a)) = Final (Headers ls a)
+--   clientWithRoute Proxy req baseurl _ = do
+--     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
+--     return $ Headers { getResponse = resp
+--                      , getHeadersHList = buildHeadersTo hdrs
+--                      }
+--
+-- -- | If you have a 'Put' endpoint in your API, the client
+-- -- side querying function that is created when calling 'client'
+-- -- will just require an argument that specifies the scheme, host
+-- -- and port to send the request to.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPABLE #-}
+-- #endif
+--   (MimeUnrender ct a) => HasReflexClient (Put (ct ': cts) a) where
+--   type Input (Put (ct ': cts) a) = ()
+--   type Client (Put (ct ': cts) a) = Final a
+--   clientWithRoute Proxy req baseurl _ =
+--     snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
+--
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   HasReflexClient (Put (ct ': cts) ()) where
+--   type Input (Put (ct ': cts) ()) = ()
+--   type Client (Put (ct ': cts) ()) = Final ()
+--   clientWithRoute Proxy req baseurl _ =
+--     void $ performRequestNoBody H.methodPut req baseurl
+--
+-- -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
+-- -- corresponding headers.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   ( MimeUnrender ct a, BuildHeadersTo ls
+--   ) => HasReflexClient (Put (ct ': cts) (Headers ls a)) where
+--   type Input (Put (ct ': cts) (Headers ls a)) = ()
+--   type Client (Put (ct ': cts) (Headers ls a)) = Final (Headers ls a)
+--   clientWithRoute Proxy req baseurl _ = do
+--     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
+--     return $ Headers { getResponse = resp
+--                      , getHeadersHList = buildHeadersTo hdrs
+--                      }
+--
+-- -- | If you have a 'Patch' endpoint in your API, the client
+-- -- side querying function that is created when calling 'client'
+-- -- will just require an argument that specifies the scheme, host
+-- -- and port to send the request to.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPABLE #-}
+-- #endif
+--   (MimeUnrender ct a) => HasReflexClient (Patch (ct ': cts) a) where
+--   type Input (Patch (ct ': cts) a) = ()
+--   type Client (Patch (ct ': cts) a) = Final a
+--   clientWithRoute Proxy req baseurl _ =
+--     snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
+--
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   HasReflexClient (Patch (ct ': cts) ()) where
+--   type Input (Patch (ct ': cts) ()) = ()
+--   type Client (Patch (ct ': cts) ()) = Final ()
+--   clientWithRoute Proxy req baseurl _ =
+--     void $ performRequestNoBody H.methodPatch req baseurl
+--
+-- -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
+-- -- corresponding headers.
+-- instance
+-- #if MIN_VERSION_base(4,8,0)
+--          {-# OVERLAPPING #-}
+-- #endif
+--   ( MimeUnrender ct a, BuildHeadersTo ls
+--   ) => HasReflexClient (Patch (ct ': cts) (Headers ls a)) where
+--   type Input (Patch (ct ': cts) (Headers ls a)) = ()
+--   type Client (Patch (ct ': cts) (Headers ls a)) = Final (Headers ls a)
+--   clientWithRoute Proxy req baseurl _ = do
+--     (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
+--     return $ Headers { getResponse = resp
+--                      , getHeadersHList = buildHeadersTo hdrs
+--                      }
+--
+-- -- | If you use a 'QueryParam' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional argument of the type specified by your 'QueryParam',
+-- -- enclosed in Maybe.
+-- --
+-- -- If you give Nothing, nothing will be added to the query string.
+-- --
+-- -- If you give a non-'Nothing' value, this function will take care
+-- -- of inserting a textual representation of this value in the query string.
+-- --
+-- -- You can control how values for your type are turned into
+-- -- text by specifying a 'ToHttpApiData' instance for your type.
+-- --
+-- -- Example:
+-- --
+-- -- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
+-- -- > getBooksBy = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "getBooksBy" to query that endpoint.
+-- -- > -- 'getBooksBy Nothing' for all books
+-- -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
+--       => HasReflexClient (QueryParam sym a :> sublayout) where
+--
+--   type Input (QueryParam sym a :> sublayout) = Maybe a ::> Input sublayout
+--   type Client (QueryParam sym a :> sublayout) = Client sublayout
+--
+--   -- if mparam = Nothing, we don't add it to the query string
+--   clientWithRoute Proxy req baseurl (mparam ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (maybe req
+--                            (flip (appendToQueryString pname) req . Just)
+--                            mparamText
+--                     )
+--                     baseurl rest
+--
+--     where pname  = cs pname'
+--           pname' = symbolVal (Proxy :: Proxy sym)
+--           mparamText = fmap toQueryParam mparam
+--
+-- -- | If you use a 'QueryParams' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional argument, a list of values of the type specified
+-- -- by your 'QueryParams'.
+-- --
+-- -- If you give an empty list, nothing will be added to the query string.
+-- --
+-- -- Otherwise, this function will take care
+-- -- of inserting a textual representation of your values in the query string,
+-- -- under the same query string parameter name.
+-- --
+-- -- You can control how values for your type are turned into
+-- -- text by specifying a 'ToHttpApiData' instance for your type.
+-- --
+-- -- Example:
+-- --
+-- -- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > getBooksBy :: [Text] -> ExceptT String IO [Book]
+-- -- > getBooksBy = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "getBooksBy" to query that endpoint.
+-- -- > -- 'getBooksBy []' for all books
+-- -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
+-- -- > --   to get all books by Asimov and Heinlein
+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
+--       => HasReflexClient (QueryParams sym a :> sublayout) where
+--
+--   type Input (QueryParams sym a :> sublayout) = [a] ::> Input sublayout
+--   type Client (QueryParams sym a :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl (paramlist ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
+--                             req
+--                             paramlist'
+--                     )
+--                     baseurl rest
+--
+--     where pname  = cs pname'
+--           pname' = symbolVal (Proxy :: Proxy sym)
+--           paramlist' = map (Just . toQueryParam) paramlist
+--
+-- -- | If you use a 'QueryFlag' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional 'Bool' argument.
+-- --
+-- -- If you give 'False', nothing will be added to the query string.
+-- --
+-- -- Otherwise, this function will insert a value-less query string
+-- -- parameter under the name associated to your 'QueryFlag'.
+-- --
+-- -- Example:
+-- --
+-- -- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > getBooks :: Bool -> ExceptT String IO [Book]
+-- -- > getBooks = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "getBooks" to query that endpoint.
+-- -- > -- 'getBooksBy False' for all books
+-- -- > -- 'getBooksBy True' to only get _already published_ books
+-- instance (KnownSymbol sym, HasReflexClient sublayout)
+--       => HasReflexClient (QueryFlag sym :> sublayout) where
+--
+--   type Input (QueryFlag sym :> sublayout) = Bool ::> Input sublayout
+--   type Client (QueryFlag sym :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl (flag ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (if flag
+--                        then appendToQueryString paramname Nothing req
+--                        else req
+--                     )
+--                     baseurl rest
+--
+--     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
+--
+--
+-- -- | If you use a 'ReqBody' in one of your endpoints in your API,
+-- -- the corresponding querying function will automatically take
+-- -- an additional argument of the type specified by your 'ReqBody'.
+-- -- That function will take care of encoding this argument as JSON and
+-- -- of using it as the request body.
+-- --
+-- -- All you need is for your type to have a 'ToJSON' instance.
+-- --
+-- -- Example:
+-- --
+-- -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
+-- -- >
+-- -- > myApi :: Proxy MyApi
+-- -- > myApi = Proxy
+-- -- >
+-- -- > addBook :: Book -> ExceptT String IO Book
+-- -- > addBook = client myApi host
+-- -- >   where host = BaseUrl Http "localhost" 8080
+-- -- > -- then you can just use "addBook" to query that endpoint
+-- instance (MimeRender ct a, HasReflexClient sublayout)
+--       => HasReflexClient (ReqBody (ct ': cts) a :> sublayout) where
+--
+--   type Input (ReqBody (ct ': cts) a :> sublayout) = a ::> Input sublayout
+--   type Client (ReqBody (ct ': cts) a :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl (body ::> rest) =
+--     clientWithRoute (Proxy :: Proxy sublayout)
+--                     (let ctProxy = Proxy :: Proxy ct
+--                      in setRQBody (mimeRender ctProxy body)
+--                                   (contentType ctProxy)
+--                                   req
+--                     )
+--                     baseurl rest
+--
+-- -- | Make the querying function append @path@ to the request path.
+-- instance (KnownSymbol path, HasReflexClient sublayout) => HasReflexClient (path :> sublayout) where
+--   type Input (path :> sublayout) = Input sublayout
+--   type Client (path :> sublayout) = Client sublayout
+--
+--   clientWithRoute Proxy req baseurl val =
+--      clientWithRoute (Proxy :: Proxy sublayout)
+--                      (appendToPath p req)
+--                      baseurl val
+--
+--     where p = symbolVal (Proxy :: Proxy path)
+--
+-- instance HasReflexClient api => HasReflexClient (Vault :> api) where
+--   type Input (Vault :> api) = Input api
+--   type Client (Vault :> api) = Client api
+--
+--   clientWithRoute Proxy req baseurl val =
+--     clientWithRoute (Proxy :: Proxy api) req baseurl val
+--
+-- instance HasReflexClient api => HasReflexClient (RemoteHost :> api) where
+--   type Input (RemoteHost :> api) = Input api
+--   type Client (RemoteHost :> api) = Client api
+--
+--   clientWithRoute Proxy req baseurl val =
+--     clientWithRoute (Proxy :: Proxy api) req baseurl val
+--
+-- instance HasReflexClient api => HasReflexClient (IsSecure :> api) where
+--   type Input (IsSecure :> api) = Input api
+--   type Client (IsSecure :> api) = Client api
+--
+--   clientWithRoute Proxy req baseurl val =
+--     clientWithRoute (Proxy :: Proxy api) req baseurl val