Merge pull request #873 from phadej/modifiers

Servant.API.Modifiers

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs

@@ -25,7 +25,7 @@ import           Data.Monoid                            ((<>))
 import           Data.Proxy                             (Proxy (Proxy))
 import           Data.Sequence                          (fromList)
 import           Data.String                            (fromString)
-import           Data.Text                              (pack)
+import           Data.Text                              (Text, pack)
 import           GHC.TypeLits                           (KnownSymbol, symbolVal)
 import qualified Network.HTTP.Types                     as H
 import           Servant.API                            ((:<|>) ((:<|>)), (:>),
@@ -37,16 +37,17 @@ import           Servant.API                            ((:<|>) ((:<|>)), (:>),
                                                          Capture, CaptureAll,
                                                          Description, EmptyAPI,
                                                          FramingUnrender (..),
-                                                         Header, Headers (..),
+                                                         Header', Headers (..),
                                                          HttpVersion, IsSecure,
                                                          MimeRender (mimeRender),
                                                          MimeUnrender (mimeUnrender),
                                                          NoContent (NoContent),
-                                                         QueryFlag, QueryParam,
+                                                         QueryFlag, QueryParam',
                                                          QueryParams, Raw,
                                                          ReflectMethod (..),
-                                                         RemoteHost, ReqBody,
+                                                         RemoteHost, ReqBody',
                                                          ResultStream(..),
+                                                         SBoolI,
                                                          Stream,
                                                          Summary, ToHttpApiData,
                                                          Vault, Verb,
@@ -57,6 +58,9 @@ import           Servant.API                            ((:<|>) ((:<|>)), (:>),
                                                          toQueryParam,
                                                          toUrlPiece)
 import           Servant.API.ContentTypes               (contentTypes)
+import           Servant.API.Modifiers                  (FoldRequired,
+                                                         RequiredArgument,
+                                                         foldRequiredArgument)
 
 import           Servant.Client.Core.Internal.Auth
 import           Servant.Client.Core.Internal.BasicAuth
@@ -325,20 +329,20 @@ instance OVERLAPPABLE_
 -- > viewReferer = client myApi
 -- > -- 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, HasClient m api)
-      => HasClient m (Header sym a :> api) where
+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
+      => HasClient m (Header' mods sym a :> api) where
 
-  type Client m (Header sym a :> api) =
-    Maybe a -> Client m api
+  type Client m (Header' mods sym a :> api) =
+    RequiredArgument mods a -> Client m api
 
   clientWithRoute pm Proxy req mval =
-    clientWithRoute pm (Proxy :: Proxy api)
-                    (maybe req
-                           (\value -> addHeader hname value req)
-                           mval
-                    )
+    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument
+      (Proxy :: Proxy mods) add (maybe req add) mval
+    where
+      hname = fromString $ symbolVal (Proxy :: Proxy sym)
 
-    where hname = fromString $ symbolVal (Proxy :: Proxy sym)
+      add :: a -> Request
+      add value = addHeader hname value req
 
 -- | Using a 'HttpVersion' combinator in your API doesn't affect the client
 -- functions.
@@ -388,22 +392,22 @@ instance HasClient m api => HasClient m (Description desc :> api) where
 -- > -- 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, HasClient m api)
-      => HasClient m (QueryParam sym a :> api) where
+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
+      => HasClient m (QueryParam' mods sym a :> api) where
 
-  type Client m (QueryParam sym a :> api) =
-    Maybe a -> Client m api
+  type Client m (QueryParam' mods sym a :> api) =
+    RequiredArgument mods a -> Client m api
 
   -- if mparam = Nothing, we don't add it to the query string
   clientWithRoute pm Proxy req mparam =
-    clientWithRoute pm (Proxy :: Proxy api)
-                    (maybe req
-                           (flip (appendToQueryString pname) req . Just)
-                           mparamText
-                    )
+    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument
+      (Proxy :: Proxy mods) add (maybe req add) mparam
+    where
+      add :: a -> Request
+      add param = appendToQueryString pname (Just $ toQueryParam param) req
 
-    where pname  = pack $ symbolVal (Proxy :: Proxy sym)
-          mparamText = fmap toQueryParam mparam
+      pname :: Text
+      pname  = pack $ symbolVal (Proxy :: Proxy sym)
 
 -- | If you use a 'QueryParams' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
@@ -514,9 +518,9 @@ instance RunClient m => HasClient m Raw where
 -- > addBook = client myApi
 -- > -- then you can just use "addBook" to query that endpoint
 instance (MimeRender ct a, HasClient m api)
-      => HasClient m (ReqBody (ct ': cts) a :> api) where
+      => HasClient m (ReqBody' mods (ct ': cts) a :> api) where
 
-  type Client m (ReqBody (ct ': cts) a :> api) =
+  type Client m (ReqBody' mods (ct ': cts) a :> api) =
     a -> Client m api
 
   clientWithRoute pm Proxy req body =

servant-docs/src/Servant/Docs/Internal.hs

@@ -534,7 +534,7 @@ sampleByteStrings ctypes@Proxy Proxy =
 --
 -- Example of an instance:
 --
--- > instance ToParam (QueryParam "capital" Bool) where
+-- > instance ToParam (QueryParam' mods "capital" Bool) where
 -- >   toParam _ =
 -- >     DocQueryParam "capital"
 -- >                   ["true", "false"]
@@ -859,22 +859,22 @@ instance OVERLAPPING_
           p = Proxy :: Proxy a
 
 instance (KnownSymbol sym, HasDocs api)
-      => HasDocs (Header sym a :> api) where
+      => HasDocs (Header' mods sym a :> api) where
   docsFor Proxy (endpoint, action) =
     docsFor subApiP (endpoint, action')
 
     where subApiP = Proxy :: Proxy api
           action' = over headers (|> headername) action
           headername = T.pack $ symbolVal (Proxy :: Proxy sym)
 
-instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs api)
-      => HasDocs (QueryParam sym a :> api) where
+instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
+      => HasDocs (QueryParam' mods sym a :> api) where
 
   docsFor Proxy (endpoint, action) =
     docsFor subApiP (endpoint, action')
 
     where subApiP = Proxy :: Proxy api
-          paramP = Proxy :: Proxy (QueryParam sym a)
+          paramP = Proxy :: Proxy (QueryParam' mods sym a)
           action' = over params (|> toParam paramP) action
 
 instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs api)
@@ -929,7 +929,7 @@ instance (KnownSymbol desc, HasDocs api)
 -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
 -- both are even defined) for any particular type.
 instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
-      => HasDocs (ReqBody (ct ': cts) a :> api) where
+      => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
 
   docsFor Proxy (endpoint, action) opts@DocOptions{..} =
     docsFor subApiP (endpoint, action') opts

servant-docs/test/Servant/DocsSpec.hs

@@ -33,7 +33,9 @@ import           Servant.Docs.Internal
 -- This declaration simply checks that all instances are in place.
 _ = docs comprehensiveAPI
 
-instance ToParam (QueryParam "foo" Int) where
+instance ToParam (QueryParam' mods "foo" Int) where
+  toParam = error "unused"
+instance ToParam (QueryParam' mods "bar" Int) where
   toParam = error "unused"
 instance ToParam (QueryParams "foo" Int) where
   toParam = error "unused"

servant-foreign/servant-foreign.cabal

@@ -36,10 +36,11 @@ library
   exposed-modules:     Servant.Foreign
                      , Servant.Foreign.Internal
                      , Servant.Foreign.Inflections
-  build-depends:       base       == 4.*
-                     , lens       == 4.*
-                     , servant    == 0.12.*
-                     , text       >= 1.2  && < 1.3
+  build-depends:       base        >= 4.7   && <4.11
+                     , base-compat >= 0.9.3 && <0.10
+                     , lens        == 4.*
+                     , servant     == 0.12.*
+                     , text        >= 1.2  && < 1.3
                      , http-types
   hs-source-dirs:      src
   default-language:    Haskell2010

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -20,23 +20,22 @@
 -- arbitrary programming languages.
 module Servant.Foreign.Internal where
 
+import Prelude ()
+import Prelude.Compat
+
 import           Control.Lens (makePrisms, makeLenses, Getter, (&), (<>~), (%~),
                                (.~))
 import           Data.Data (Data)
-#if !MIN_VERSION_base(4,8,0)
-import           Data.Monoid
-#endif
 import           Data.Proxy
 import           Data.String
 import           Data.Text
 import           Data.Typeable (Typeable)
 import           Data.Text.Encoding (decodeUtf8)
 import           GHC.TypeLits
 import qualified Network.HTTP.Types as HTTP
-import           Prelude hiding (concat)
 import           Servant.API
 import           Servant.API.TypeLevel
-
+import           Servant.API.Modifiers (RequiredArgument)
 
 newtype FunctionName = FunctionName { unFunctionName :: [Text] }
   deriving (Data, Show, Eq, Monoid, Typeable)
@@ -238,22 +237,22 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
       method   = reflectMethod (Proxy :: Proxy method)
       methodLC = toLower $ decodeUtf8 method
 
-instance (KnownSymbol sym, HasForeignType lang ftype (Maybe a), HasForeign lang ftype api)
-  => HasForeign lang ftype (Header sym a :> api) where
-  type Foreign ftype (Header sym a :> api) = Foreign ftype api
+instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
+  => HasForeign lang ftype (Header' mods sym a :> api) where
+  type Foreign ftype (Header' mods sym a :> api) = Foreign ftype api
 
   foreignFor lang Proxy Proxy req =
     foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
     where
       hname = pack . symbolVal $ (Proxy :: Proxy sym)
       arg   = Arg
         { _argName = PathSegment hname
-        , _argType  = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (Maybe a)) }
+        , _argType  = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (RequiredArgument mods a)) }
       subP  = Proxy :: Proxy api
 
-instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
-  => HasForeign lang ftype (QueryParam sym a :> api) where
-  type Foreign ftype (QueryParam sym a :> api) = Foreign ftype api
+instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
+  => HasForeign lang ftype (QueryParam' mods sym a :> api) where
+  type Foreign ftype (QueryParam' mods sym a :> api) = Foreign ftype api
 
   foreignFor lang Proxy Proxy req =
     foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
@@ -262,7 +261,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype ap
       str = pack . symbolVal $ (Proxy :: Proxy sym)
       arg = Arg
         { _argName = PathSegment str
-        , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
+        , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (RequiredArgument mods a)) }
 
 instance
   (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype api)
@@ -299,8 +298,8 @@ instance HasForeign lang ftype Raw where
         & reqMethod .~ method
 
 instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api)
-      => HasForeign lang ftype (ReqBody list a :> api) where
-  type Foreign ftype (ReqBody list a :> api) = Foreign ftype api
+      => HasForeign lang ftype (ReqBody' mods list a :> api) where
+  type Foreign ftype (ReqBody' mods list a :> api) = Foreign ftype api
 
   foreignFor lang ftype Proxy req =
     foreignFor lang ftype (Proxy :: Proxy api) $

servant-foreign/test/Servant/ForeignSpec.hs

@@ -7,9 +7,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+#if __GLASGOW__HASKELL < 709
+{-# OPTIONS_GHC -fcontext-stack=41 #-}
+#endif
 #include "overlapping-compat.h"
 
 module Servant.ForeignSpec where
@@ -99,7 +101,7 @@ listFromAPISpec = describe "listFromAPI" $ do
     shouldBe postReq $ defReq
       { _reqUrl        = Url
           [ Segment $ Static "test" ]
-          [ QueryArg (Arg "param" "intX") Normal ]
+          [ QueryArg (Arg "param" "maybe intX") Normal ]
       , _reqMethod     = "POST"
       , _reqHeaders    = []
       , _reqBody       = Just "listX of stringX"