Code reorganization

Move `HasServer (NamedRoutes routes)` instance

The instance has been moved to `Servant.Server.Internal`, as the
instances for other combinators. It is necessary so that the instance
can be re-exported from `Servant.Server` without circular imports.

Otherwise, users have to import `Servant.Server.Generic` manually ;
forgetting to do so will produce confusing error messages about the
missing instance.

Move `HasClient (NamedRoutes routes)` instance

Moved so that the instance is made available when importing
`Servant.Client`, avoiding possibly confusing errors when
`Servant.Client.Generic` isn't imported.

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

@@ -18,10 +18,15 @@
 #define HAS_TYPE_ERROR
 #endif
 
+#if __GLASGOW_HASKELL__ >= 806
+{-# LANGUAGE QuantifiedConstraints  #-}
+#endif
+
 module Servant.Client.Core.HasClient (
     clientIn,
     HasClient (..),
     EmptyClient (..),
+    AsClientT,
     foldMapUnion,
     matchUnion,
     ) where
@@ -39,6 +44,7 @@ import           Data.ByteString.Builder
 import qualified Data.ByteString.Lazy                     as BL
 import           Data.Either
                  (partitionEithers)
+import           Data.Constraint (Dict(..))
 import           Data.Foldable
                  (toList)
 import           Data.List
@@ -79,7 +85,10 @@ import           Servant.API
                  ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
                  StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
                  Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
-                 getResponse, toEncodedUrlPiece, toUrlPiece)
+                 getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
+import           Servant.API.Generic
+                 (GenericMode(..), ToServant, ToServantApi
+                 , GenericServant, toServant, fromServant)
 import           Servant.API.ContentTypes
                  (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
 import           Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
@@ -816,6 +825,52 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
   hoistClientMonad pm _ f cl = \bauth ->
     hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
 
+-- | A type that specifies that an API record contains a client implementation.
+data AsClientT (m :: * -> *)
+instance GenericMode (AsClientT m) where
+    type AsClientT m :- api = Client m api
+
+#if __GLASGOW_HASKELL__ >= 806
+
+type GClientConstraints api m =
+  ( GenericServant api (AsClientT m)
+  , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
+  )
+
+class GClient (api :: * -> *) m where
+  proof :: Dict (GClientConstraints api m)
+
+instance GClientConstraints api m => GClient api m where
+  proof = Dict
+
+instance
+  ( forall n. GClient api n
+  , HasClient m (ToServantApi api)
+  , RunClient m
+  )
+  => HasClient m (NamedRoutes api) where
+  type Client m (NamedRoutes api) = api (AsClientT m)
+
+  clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
+  clientWithRoute pm _ request =
+    case proof @api @m of
+      Dict -> fromServant $ clientWithRoute  pm (Proxy @(ToServantApi api)) request
+
+  hoistClientMonad
+    :: forall ma mb.
+       Proxy m
+    -> Proxy (NamedRoutes api)
+    -> (forall x. ma x -> mb x)
+    -> Client ma (NamedRoutes api)
+    -> Client mb (NamedRoutes api)
+  hoistClientMonad _ _ nat clientA =
+    case (proof @api @ma, proof @api @mb) of
+      (Dict, Dict) ->
+        fromServant @api @(AsClientT mb) $
+        hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
+        toServant @api @(AsClientT ma) clientA
+
+#endif
 
 
 {- Note [Non-Empty Content Types]

servant-client-core/src/Servant/Client/Generic.hs

@@ -1,20 +1,9 @@
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE InstanceSigs          #-}
 {-# LANGUAGE KindSignatures        #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE UndecidableInstances  #-}
-
-#if __GLASGOW_HASKELL__ >= 806
-{-# LANGUAGE QuantifiedConstraints  #-}
-#endif
 
 module  Servant.Client.Generic (
     AsClientT,
@@ -22,17 +11,12 @@ module  Servant.Client.Generic (
     genericClientHoist,
     ) where
 
-import           Data.Constraint (Dict(..))
 import           Data.Proxy
                  (Proxy (..))
 
 import           Servant.API.Generic
 import           Servant.Client.Core
-
+import           Servant.Client.Core.HasClient (AsClientT)
--- | A type that specifies that an API record contains a client implementation.
-data AsClientT (m :: * -> *)
-instance GenericMode (AsClientT m) where
-    type AsClientT m :- api = Client m api
 
 -- | Generate a record of client functions.
 genericClient
@@ -62,45 +46,3 @@ genericClientHoist nt
   where
     m = Proxy :: Proxy m
     api = Proxy :: Proxy (ToServantApi routes)
-
-#if __GLASGOW_HASKELL__ >= 806
-
-type GClientConstraints api m =
-  ( GenericServant api (AsClientT m)
-  , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
-  )
-
-class GClient (api :: * -> *) m where
-  proof :: Dict (GClientConstraints api m)
-
-instance GClientConstraints api m => GClient api m where
-  proof = Dict
-
-instance
-  ( forall n. GClient api n
-  , HasClient m (ToServantApi api)
-  , RunClient m
-  )
-  => HasClient m (NamedRoutes api) where
-  type Client m (NamedRoutes api) = api (AsClientT m)
-
-  clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
-  clientWithRoute pm _ request =
-    case proof @api @m of
-      Dict -> fromServant $ clientWithRoute  pm (Proxy @(ToServantApi api)) request
-
-  hoistClientMonad
-    :: forall ma mb.
-       Proxy m
-    -> Proxy (NamedRoutes api)
-    -> (forall x. ma x -> mb x)
-    -> Client ma (NamedRoutes api)
-    -> Client mb (NamedRoutes api)
-  hoistClientMonad _ _ nat clientA =
-    case (proof @api @ma, proof @api @mb) of
-      (Dict, Dict) ->
-        fromServant @api @(AsClientT mb) $
-        hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
-        toServant @api @(AsClientT ma) clientA
-
-#endif

servant-server/src/Servant/Server/Generic.hs

@@ -1,25 +1,9 @@
-{-# OPTIONS_GHC -fno-warn-orphans   #-}
-{-# LANGUAGE AllowAmbiguousTypes    #-}
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE CPP                    #-}
 {-# LANGUAGE DataKinds              #-}
-{-# LANGUAGE DefaultSignatures      #-}
 {-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE InstanceSigs           #-}
-{-# LANGUAGE KindSignatures         #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE QuantifiedConstraints  #-}
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeApplications       #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE UndecidableInstances   #-}
-
-#if __GLASGOW_HASKELL__ >= 806
-{-# LANGUAGE QuantifiedConstraints  #-}
-#endif
 
 -- | @since 0.14.1
 module Servant.Server.Generic (
@@ -29,29 +13,16 @@ module Servant.Server.Generic (
     genericServeT,
     genericServeTWithContext,
     genericServer,
-    genericServerT,
+    genericServerT
-    -- * Internal machinery
-    GServerConstraints,
-    GServer,
-    -- * Re-exports
-    NamedRoutes
   ) where
 
-import           Data.Constraint
 import           Data.Proxy
                  (Proxy (..))
 
-import           Servant.API.Generic
 import           Servant.Server
+import           Servant.API.Generic
 import           Servant.Server.Internal
 
--- | A type that specifies that an API record contains a server implementation.
-data AsServerT (m :: * -> *)
-instance GenericMode (AsServerT m) where
-    type AsServerT m :- api = ServerT api m
-
-type AsServer = AsServerT Handler
-
 -- | Transform a record of routes into a WAI 'Application'.
 genericServe
     :: forall routes.
@@ -119,67 +90,3 @@ genericServerT
     -> ToServant routes (AsServerT m)
 genericServerT = toServant
 
-#if __GLASGOW_HASKELL__ >= 806
-
--- | Set of constraints required to convert to / from vanilla server types.
-type GServerConstraints api m =
-  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
-  , GServantProduct (Rep (api (AsServerT m)))
-  )
-
--- | This class is a necessary evil: in the implementation of 'HasServer' for
---  @'NamedRoutes' api@, we essentially need the quantified constraint @forall
---  m. 'GServerConstraints' m@ to hold.
---
--- We cannot require do that directly as the definition of 'GServerConstraints'
--- contains type family applications ('Rep' and 'ServerT'). The trick is to hide
--- those type family applications behind a typeclass providing evidence for
--- @'GServerConstraints' api m@ in the form of a dictionary, and require that
--- @forall m. 'GServer' api m@ instead.
---
--- Users shouldn't have to worry about this class, as the only possible instance
--- is provided in this module for all record APIs.
-
-class GServer (api :: * -> *) (m :: * -> *) where
-  proof :: Dict (GServerConstraints api m)
-
-instance
-  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
-  , GServantProduct (Rep (api (AsServerT m)))
-  ) => GServer api m where
-  proof = Dict
-
-instance
-  ( HasServer (ToServantApi api) context
-  , forall m. Generic (api (AsServerT m))
-  , forall m. GServer api m
-  ) => HasServer (NamedRoutes api) context where
-
-  type ServerT (NamedRoutes api) m = api (AsServerT m)
-
-  route
-    :: Proxy (NamedRoutes api)
-    -> Context context
-    -> Delayed env (api (AsServerT Handler))
-    -> Router env
-  route _ ctx delayed =
-    case proof @api @Handler of
-      Dict -> route (Proxy @(ToServantApi api)) ctx (toServant <$> delayed)
-
-  hoistServerWithContext
-    :: forall m n. Proxy (NamedRoutes api)
-    -> Proxy context
-    -> (forall x. m x -> n x)
-    -> api (AsServerT m)
-    -> api (AsServerT n)
-  hoistServerWithContext _ pctx nat server =
-    case (proof @api @m, proof @api @n) of
-      (Dict, Dict) ->
-        fromServant servantSrvN
-        where
-          servantSrvM :: ServerT (ToServantApi api) m =
-            toServant server
-          servantSrvN :: ServerT (ToServantApi api) n =
-            hoistServerWithContext (Proxy @(ToServantApi api)) pctx nat servantSrvM
-
-#endif

servant-server/src/Servant/Server/Internal.hs

@@ -1,15 +1,18 @@
 {-# LANGUAGE CPP                   #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveDataTypeable    #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE InstanceSigs          #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
@@ -18,6 +21,10 @@
 #define HAS_TYPE_ERROR
 #endif
 
+#if __GLASGOW_HASKELL__ >= 806
+{-# LANGUAGE QuantifiedConstraints  #-}
+#endif
+
 module Servant.Server.Internal
   ( module Servant.Server.Internal
   , module Servant.Server.Internal.BasicAuth
@@ -42,6 +49,7 @@ import qualified Data.ByteString                            as B
 import qualified Data.ByteString.Builder                    as BB
 import qualified Data.ByteString.Char8                      as BC8
 import qualified Data.ByteString.Lazy                       as BL
+import           Data.Constraint (Dict(..))
 import           Data.Either
                  (partitionEithers)
 import           Data.Maybe
@@ -54,6 +62,7 @@ import           Data.Tagged
                  (Tagged (..), retag, untag)
 import qualified Data.Text                                  as T
 import           Data.Typeable
+import           GHC.Generics
 import           GHC.TypeLits
                  (KnownNat, KnownSymbol, natVal, symbolVal)
 import qualified Network.HTTP.Media                         as NHM
@@ -75,7 +84,8 @@ import           Servant.API
                  QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
                  RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
                  Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
-                 WithNamedContext)
+                 WithNamedContext, NamedRoutes)
+import           Servant.API.Generic (GenericMode(..), ToServant, ToServantApi, GServantProduct, toServant, fromServant)
 import           Servant.API.ContentTypes
                  (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
                  AllMime, MimeRender (..), MimeUnrender (..), NoContent,
@@ -905,3 +915,76 @@ instance (HasServer api context)
 
 -- $setup
 -- >>> import Servant
+
+-- | A type that specifies that an API record contains a server implementation.
+data AsServerT (m :: * -> *)
+instance GenericMode (AsServerT m) where
+    type AsServerT m :- api = ServerT api m
+
+type AsServer = AsServerT Handler
+
+
+#if __GLASGOW_HASKELL__ >= 806
+
+-- | Set of constraints required to convert to / from vanilla server types.
+type GServerConstraints api m =
+  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
+  , GServantProduct (Rep (api (AsServerT m)))
+  )
+
+-- | This class is a necessary evil: in the implementation of 'HasServer' for
+--  @'NamedRoutes' api@, we essentially need the quantified constraint @forall
+--  m. 'GServerConstraints' m@ to hold.
+--
+-- We cannot require do that directly as the definition of 'GServerConstraints'
+-- contains type family applications ('Rep' and 'ServerT'). The trick is to hide
+-- those type family applications behind a typeclass providing evidence for
+-- @'GServerConstraints' api m@ in the form of a dictionary, and require that
+-- @forall m. 'GServer' api m@ instead.
+--
+-- Users shouldn't have to worry about this class, as the only possible instance
+-- is provided in this module for all record APIs.
+
+class GServer (api :: * -> *) (m :: * -> *) where
+  proof :: Dict (GServerConstraints api m)
+
+instance
+  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
+  , GServantProduct (Rep (api (AsServerT m)))
+  ) => GServer api m where
+  proof = Dict
+
+instance
+  ( HasServer (ToServantApi api) context
+  , forall m. Generic (api (AsServerT m))
+  , forall m. GServer api m
+  ) => HasServer (NamedRoutes api) context where
+
+  type ServerT (NamedRoutes api) m = api (AsServerT m)
+
+  route
+    :: Proxy (NamedRoutes api)
+    -> Context context
+    -> Delayed env (api (AsServerT Handler))
+    -> Router env
+  route _ ctx delayed =
+    case proof @api @Handler of
+      Dict -> route (Proxy @(ToServantApi api)) ctx (toServant <$> delayed)
+
+  hoistServerWithContext
+    :: forall m n. Proxy (NamedRoutes api)
+    -> Proxy context
+    -> (forall x. m x -> n x)
+    -> api (AsServerT m)
+    -> api (AsServerT n)
+  hoistServerWithContext _ pctx nat server =
+    case (proof @api @m, proof @api @n) of
+      (Dict, Dict) ->
+        fromServant servantSrvN
+        where
+          servantSrvM :: ServerT (ToServantApi api) m =
+            toServant server
+          servantSrvN :: ServerT (ToServantApi api) n =
+            hoistServerWithContext (Proxy @(ToServantApi api)) pctx nat servantSrvM
+
+#endif

servant/servant.cabal

@@ -46,6 +46,7 @@ library
     Servant.API.HttpVersion
     Servant.API.IsSecure
     Servant.API.Modifiers
+    Servant.API.NamedRoutes
     Servant.API.QueryParam
     Servant.API.Raw
     Servant.API.RemoteHost
@@ -80,7 +81,7 @@ library
   build-depends:
       base                   >= 4.9      && < 4.16
     , bytestring             >= 0.10.8.1 && < 0.12
-    , constraints
+    , constraints            >= 0.2
     , mtl                    >= 2.2.2    && < 2.3
     , sop-core               >= 0.4.0.0  && < 0.6
     , transformers           >= 0.5.2.0  && < 0.6

servant/src/Servant/API.hs

@@ -36,6 +36,9 @@ module Servant.API (
   module Servant.API.Verbs,
   module Servant.API.UVerb,
 
+  -- * Sub-APIs defined as records of routes
+  module Servant.API.NamedRoutes,
+
   -- * Streaming endpoints, distinguished by HTTP method
   module Servant.API.Stream,
 
@@ -130,6 +133,8 @@ import           Servant.API.UVerb
                  Unique, WithStatus (..), inject, statusOf)
 import           Servant.API.Vault
                  (Vault)
+import           Servant.API.NamedRoutes
+                 (NamedRoutes)
 import           Servant.API.Verbs
                  (Delete, DeleteAccepted, DeleteNoContent,
                  DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,

servant/src/Servant/API/Generic.hs

@@ -37,8 +37,6 @@ module Servant.API.Generic (
     ToServant,
     toServant,
     fromServant,
-    -- * NamedRoutes combinator
-    NamedRoutes,
     -- * AsApi
     AsApi,
     ToServantApi,
@@ -122,9 +120,6 @@ genericApi
     -> Proxy (ToServantApi routes)
 genericApi _ = Proxy
 
--- | Combinator for embedding a record of named routes into a Servant API type.
-data NamedRoutes (api :: * -> *)
-
 -------------------------------------------------------------------------------
 -- Class
 -------------------------------------------------------------------------------

servant/src/Servant/API/NamedRoutes.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE KindSignatures #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+
+module Servant.API.NamedRoutes (
+    -- * NamedRoutes combinator
+    NamedRoutes
+  ) where
+
+-- | Combinator for embedding a record of named routes into a Servant API type.
+data NamedRoutes (api :: * -> *)

servant/src/Servant/Links.hs

@@ -173,6 +173,8 @@ import           Servant.API.IsSecure
                  (IsSecure)
 import           Servant.API.Modifiers
                  (FoldRequired)
+import           Servant.API.NamedRoutes
+                 (NamedRoutes)
 import           Servant.API.QueryParam
                  (QueryFlag, QueryParam', QueryParams)
 import           Servant.API.Raw