diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal index 118908c5..808e4185 100644 --- a/servant-client-core/servant-client-core.cabal +++ b/servant-client-core/servant-client-core.cabal @@ -52,7 +52,7 @@ library build-depends: base >= 4.9 && < 4.16 , bytestring >= 0.10.8.1 && < 0.12 - , constraints + , constraints >= 0.2 && < 0.14 , containers >= 0.5.7.1 && < 0.7 , deepseq >= 1.4.2.0 && < 1.5 , text >= 1.2.3.0 && < 1.3 diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 6f1f08eb..e25a07b0 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -1,5 +1,4 @@ {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -7,6 +6,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -14,14 +14,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802 -#define HAS_TYPE_ERROR -#endif - -#if __GLASGOW_HASKELL__ >= 806 -{-# LANGUAGE QuantifiedConstraints #-} -#endif - module Servant.Client.Core.HasClient ( clientIn, HasClient (..), @@ -804,11 +796,7 @@ instance ( HasClient m api -- > getBooks = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooks' for all books. -#ifdef HAS_TYPE_ERROR instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api -#else -instance ( HasClient m api -#endif ) => HasClient m (Fragment a :> api) where type Client m (Fragment a :> api) = Client m api @@ -833,7 +821,6 @@ 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) @@ -873,8 +860,6 @@ instance hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $ toServant @api @(AsClientT ma) clientA -#endif - infixl 1 // infixl 2 /: @@ -885,14 +870,14 @@ infixl 2 /: -- Example: -- -- @@ --- type Api = NamedAPI RootApi +-- type Api = NamedRoutes RootApi -- -- data RootApi mode = RootApi --- { subApi :: mode :- NamedAPI SubApi +-- { subApi :: mode :- NamedRoutes SubApi -- , … -- } deriving Generic -- --- data SubAmi mode = SubApi +-- data SubApi mode = SubApi -- { endpoint :: mode :- Get '[JSON] Person -- , … -- } deriving Generic @@ -912,20 +897,20 @@ x // f = f x -- | Convenience function for supplying arguments to client functions when -- working with records of clients. -- --- Intended to be use in conjunction with '(//)'. +-- Intended to be used in conjunction with '(//)'. -- -- Example: -- -- @@ --- type Api = NamedAPI RootApi +-- type Api = NamedRoutes RootApi -- -- data RootApi mode = RootApi --- { subApi :: mode :- Capture "token" String :> NamedAPI SubApi +-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi -- , hello :: mode :- Capture "name" String :> Get '[JSON] String -- , … -- } deriving Generic -- --- data SubAmi mode = SubApi +-- data SubApi mode = SubApi -- { endpoint :: mode :- Get '[JSON] Person -- , … -- } deriving Generic diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 709772f0..15b63601 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -62,7 +62,7 @@ library build-depends: base >= 4.9 && < 4.16 , bytestring >= 0.10.8.1 && < 0.12 - , constraints + , constraints >= 0.2 && < 0.14 , containers >= 0.5.7.1 && < 0.7 , mtl >= 2.2.2 && < 2.3 , text >= 1.2.3.0 && < 1.3 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 206f05ff..46cee71d 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} @@ -9,6 +8,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -17,14 +17,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802 -#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 @@ -111,12 +103,10 @@ import Servant.Server.Internal.RouteResult import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServerError -#ifdef HAS_TYPE_ERROR import GHC.TypeLits (ErrorMessage (..), TypeError) import Servant.API.TypeLevel (AtLeastOneFragment, FragmentUnique) -#endif class HasServer api context where type ServerT api (m :: * -> *) :: * @@ -794,7 +784,7 @@ instance ( KnownSymbol realm -- * helpers ct_wildcard :: B.ByteString -ct_wildcard = "*" <> "/" <> "*" -- Because CPP +ct_wildcard = "*" <> "/" <> "*" getAcceptHeader :: Request -> AcceptHeader getAcceptHeader = AcceptHeader . fromMaybe ct_wildcard . lookup hAccept . requestHeaders @@ -825,7 +815,6 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA -- TypeError helpers ------------------------------------------------------------------------------- -#ifdef HAS_TYPE_ERROR -- | This instance catches mistakes when there are non-saturated -- type applications on LHS of ':>'. -- @@ -888,7 +877,6 @@ type HasServerArrowTypeError a b = ':$$: 'ShowType a ':$$: 'Text "and" ':$$: 'ShowType b -#endif -- | Ignore @'Fragment'@ in server handlers. -- See for more details. @@ -901,11 +889,7 @@ type HasServerArrowTypeError a b = -- > server = getBooks -- > where getBooks :: Handler [Book] -- > getBooks = ...return all books... -#ifdef HAS_TYPE_ERROR instance (AtLeastOneFragment api, FragmentUnique (Fragment a1 :> api), HasServer api context) -#else -instance (HasServer api context) -#endif => HasServer (Fragment a1 :> api) context where type ServerT (Fragment a1 :> api) m = ServerT api m @@ -924,8 +908,6 @@ instance GenericMode (AsServerT m) where 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 @@ -986,5 +968,3 @@ instance toServant server servantSrvN :: ServerT (ToServantApi api) n = hoistServerWithContext (Proxy @(ToServantApi api)) pctx nat servantSrvM - -#endif diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index 8b2fc690..5a12e2e5 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -1,22 +1,18 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 806 -{-# LANGUAGE QuantifiedConstraints #-} -#endif - {-# OPTIONS_HADDOCK not-home #-} -- | Type safe generation of internal links. @@ -593,7 +589,6 @@ instance HasLink (UVerb m ct a) where toLink toA _ = toA -- Instance for NamedRoutes combinator -#if __GLASGOW_HASKELL__ >= 806 type GLinkConstraints routes a = ( MkLink (ToServant routes AsApi) a ~ ToServant routes (AsLink a) , GenericServant routes (AsLink a) @@ -620,7 +615,6 @@ instance toLink toA _ l = case proof @routes @a of Dict -> fromServant $ toLink toA (Proxy @(ToServantApi routes)) l -#endif -- AuthProtext instances instance HasLink sub => HasLink (AuthProtect tag :> sub) where