eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Cleanup

Browse source
This commit is contained in:
Gaël Deest 2021-10-04 23:21:12 +02:00
parent d81c8d9911
commit 575aa70eca
5 changed files with 13 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-client-core/servant-client-core.cabal
View file

@ -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

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

@ -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

2
servant-server/servant-server.cabal
View file

@ -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

24
servant-server/src/Servant/Server/Internal.hs
View file

@ -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 <https://ietf.org/rfc/rfc2616.html#section-15.1.3> 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

8
servant/src/Servant/Links.hs
View file

@ -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