Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-servant for openSUSE:Factory checked in at 2022-02-11 23:09:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-servant (Old) and /work/SRC/openSUSE:Factory/.ghc-servant.new.1956 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-servant" Fri Feb 11 23:09:35 2022 rev:9 rq:953524 version:0.19 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-servant/ghc-servant.changes 2021-09-10 23:41:12.414552721 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-servant.new.1956/ghc-servant.changes 2022-02-11 23:11:32.347315536 +0100 @@ -1,0 +2,119 @@ +Wed Feb 2 13:15:43 UTC 2022 - Peter Simons <psim...@suse.com> + +- Update servant to version 0.19. + Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions. + + 0.19 + ---- + + ### Significant changes + + - Drop support for GHC < 8.6. + - Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet). + - Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)), + which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864) + related to hash collisions. + - Add `NamedRoutes` combinator, making support for records first-class in Servant + ([#1388](https://github.com/haskell-servant/servant/pull/1388)). + + Users can now directly mark part as an API as defined by a record, instead of + using `(:<|>)` to combine routes. Concretely, the anonymous: + + ```haskell + type API = + "version" :> Get '[JSON] String :<|> + "products" :> Get '[JSON] [Product] + ``` + + can be replaced with the explicitly-named: + + ```haskell + type API = NamedRoutes NamedAPI + data NamedAPI mode = NamedAPI + { version :: mode :- "version" :> Get '[JSON] String + , products :: mode :- "products" :> Get '[JSON] [Product] + } + ``` + + `NamedRoutes` builds upon `servant-generic`, but improves usability by freeing + users from the need to perform `toServant` / `fromServant` conversions + manually. Serving `NamedRoutes NamedAPI` is now done directly by providing a + record of handlers, and servant generates clients directly as records as well. + In particular, it makes it much more practical to work with nested hierarchies + of named routes. + + Two convenience functions, `(//)` and `(/:)`, have been added to make the + usage of named route hierarchies more pleasant: + + ```haskell + rootClient :: RootApi (AsClientT ClientM) + rootClient = client (Proxy @API) + + hello :: String -> ClientM String + hello name = rootClient // hello /: name + + endpointClient :: ClientM Person + endpointClient = client // subApi /: "foobar123" // endpoint + + type Api = NamedRoutes RootApi + + data RootApi mode = RootApi + { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi + , hello :: mode :- Capture "name" String :> Get '[JSON] String + , ??? + } deriving Generic + + data SubApi mode = SubApi + { endpoint :: mode :- Get '[JSON] Person + , ??? + } deriving Generic + ``` + + - Add custom type errors for partially applied combinators + ([#1289](https://github.com/haskell-servant/servant/pull/1289), + [#1486](https://github.com/haskell-servant/servant/pull/1486)). + + For example, forgetting to document the expected type for a query parameter, + as in: + + ``` haskell + type API = QueryParam "param" :> Get '[JSON] NoContent + ``` + + will raise to the following error when trying to serve the API: + + ``` + ??? There is no instance for HasServer (QueryParam' + '[Optional, Strict] "param" :> ...) + QueryParam' '[Optional, Strict] "1" expects 1 more arguments + ``` + + As a consequence of this change, unsaturated types are now forbidden before `(:>)`. + + - Add a `HeadNoContent` verb ([#1502](https://github.com/haskell-servant/servant/pull/1502)). + + - *servant-client* / *servant-client-core* / *servant-http-streams*: + Fix erroneous behavior, where only 2XX status codes would be considered + successful, irrelevant of the status parameter specified by the verb + combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469)) + + - *servant-client* / *servant-client-core*: Fix `Show` instance for + `Servant.Client.Core.Request`. + + - *servant-client* / *servant-client-core*: Allow passing arbitrary binary data + in Query parameters. + ([#1432](https://github.com/haskell-servant/servant/pull/1432)). + + - *servant-docs*: Generate sample cURL requests + ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)). + + Breaking change: requires sample header values to be supplied with `headers`. + + ### Other changes + + - Various bit rotten cookbooks have been updated and re-introduced on + [docs.servant.dev](https://docs.servant.dev). + + - Various version bumps. + +------------------------------------------------------------------- Old: ---- servant-0.18.3.tar.gz New: ---- servant-0.19.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-servant.spec ++++++ --- /var/tmp/diff_new_pack.8PLBtS/_old 2022-02-11 23:11:32.743316682 +0100 +++ /var/tmp/diff_new_pack.8PLBtS/_new 2022-02-11 23:11:32.747316694 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-servant # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name servant %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.18.3 +Version: 0.19 Release: 0 Summary: A family of combinators for defining webservices APIs License: BSD-3-Clause @@ -33,6 +33,7 @@ BuildRequires: ghc-bifunctors-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-case-insensitive-devel +BuildRequires: ghc-constraints-devel BuildRequires: ghc-deepseq-devel BuildRequires: ghc-http-api-data-devel BuildRequires: ghc-http-media-devel @@ -75,8 +76,8 @@ %prep %autosetup -n %{pkg_name}-%{version} -cabal-tweak-dep-ver mmorph '< 1.2' '< 1.3' -cabal-tweak-dep-ver base-compat '< 0.12' '< 0.13' +cabal-tweak-dep-ver base-compat '< 0.12' '< 1' +cabal-tweak-dep-ver mmorph '< 1.2' '< 2' %build %ghc_lib_build ++++++ servant-0.18.3.tar.gz -> servant-0.19.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/CHANGELOG.md new/servant-0.19/CHANGELOG.md --- old/servant-0.18.3/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,121 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions. + +0.19 +---- + +### Significant changes + +- Drop support for GHC < 8.6. +- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet). +- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)), + which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864) + related to hash collisions. +- Add `NamedRoutes` combinator, making support for records first-class in Servant + ([#1388](https://github.com/haskell-servant/servant/pull/1388)). + + Users can now directly mark part as an API as defined by a record, instead of + using `(:<|>)` to combine routes. Concretely, the anonymous: + + ```haskell + type API = + "version" :> Get '[JSON] String :<|> + "products" :> Get '[JSON] [Product] + ``` + + can be replaced with the explicitly-named: + + ```haskell + type API = NamedRoutes NamedAPI + data NamedAPI mode = NamedAPI + { version :: mode :- "version" :> Get '[JSON] String + , products :: mode :- "products" :> Get '[JSON] [Product] + } + ``` + + `NamedRoutes` builds upon `servant-generic`, but improves usability by freeing + users from the need to perform `toServant` / `fromServant` conversions + manually. Serving `NamedRoutes NamedAPI` is now done directly by providing a + record of handlers, and servant generates clients directly as records as well. + In particular, it makes it much more practical to work with nested hierarchies + of named routes. + + Two convenience functions, `(//)` and `(/:)`, have been added to make the + usage of named route hierarchies more pleasant: + + ```haskell + rootClient :: RootApi (AsClientT ClientM) + rootClient = client (Proxy @API) + + hello :: String -> ClientM String + hello name = rootClient // hello /: name + + endpointClient :: ClientM Person + endpointClient = client // subApi /: "foobar123" // endpoint + + type Api = NamedRoutes RootApi + + data RootApi mode = RootApi + { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi + , hello :: mode :- Capture "name" String :> Get '[JSON] String + , ??? + } deriving Generic + + data SubApi mode = SubApi + { endpoint :: mode :- Get '[JSON] Person + , ??? + } deriving Generic + ``` + +- Add custom type errors for partially applied combinators + ([#1289](https://github.com/haskell-servant/servant/pull/1289), + [#1486](https://github.com/haskell-servant/servant/pull/1486)). + + For example, forgetting to document the expected type for a query parameter, + as in: + + ``` haskell + type API = QueryParam "param" :> Get '[JSON] NoContent + ``` + + will raise to the following error when trying to serve the API: + + ``` + ??? There is no instance for HasServer (QueryParam' + '[Optional, Strict] "param" :> ...) + QueryParam' '[Optional, Strict] "1" expects 1 more arguments + ``` + + As a consequence of this change, unsaturated types are now forbidden before `(:>)`. + +- Add a `HeadNoContent` verb ([#1502](https://github.com/haskell-servant/servant/pull/1502)). + +- *servant-client* / *servant-client-core* / *servant-http-streams*: + Fix erroneous behavior, where only 2XX status codes would be considered + successful, irrelevant of the status parameter specified by the verb + combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469)) + +- *servant-client* / *servant-client-core*: Fix `Show` instance for + `Servant.Client.Core.Request`. + + +- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data + in Query parameters. + ([#1432](https://github.com/haskell-servant/servant/pull/1432)). + +- *servant-docs*: Generate sample cURL requests + ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)). + + Breaking change: requires sample header values to be supplied with `headers`. + +### Other changes + +- Various bit rotten cookbooks have been updated and re-introduced on + [docs.servant.dev](https://docs.servant.dev). + +- Various version bumps. + 0.18.3 ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/servant.cabal new/servant-0.19/servant.cabal --- old/servant-0.18.3/servant.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/servant.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ -cabal-version: >=1.10 +cabal-version: 2.2 name: servant -version: 0.18.3 +version: 0.19 synopsis: A family of combinators for defining webservices APIs category: Servant, Web @@ -13,15 +13,15 @@ homepage: http://docs.servant.dev/ bug-reports: http://github.com/haskell-servant/servant/issues -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintain...@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 - , GHCJS == 8.4 +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 + , GHCJS ==8.6.0.1 extra-source-files: CHANGELOG.md @@ -46,6 +46,7 @@ Servant.API.HttpVersion Servant.API.IsSecure Servant.API.Modifiers + Servant.API.NamedRoutes Servant.API.QueryParam Servant.API.Raw Servant.API.RemoteHost @@ -54,6 +55,7 @@ Servant.API.Status Servant.API.Stream Servant.API.Sub + Servant.API.TypeErrors Servant.API.TypeLevel Servant.API.UVerb Servant.API.UVerb.Union @@ -80,6 +82,7 @@ build-depends: base >= 4.9 && < 4.16 , bytestring >= 0.10.8.1 && < 0.12 + , constraints >= 0.2 , mtl >= 2.2.2 && < 2.3 , sop-core >= 0.4.0.0 && < 0.6 , transformers >= 0.5.2.0 && < 0.6 @@ -96,7 +99,7 @@ -- Here can be exceptions if we really need features from the newer versions. build-depends: base-compat >= 0.10.5 && < 0.12 - , aeson >= 1.4.1.0 && < 1.6 + , aeson >= 1.4.1.0 && < 3 , attoparsec >= 0.13.2.2 && < 0.15 , bifunctors >= 5.5.3 && < 5.6 , case-insensitive >= 1.2.0.11 && < 1.3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/Alternative.hs new/servant-0.19/src/Servant/API/Alternative.hs --- old/servant-0.18.3/src/Servant/API/Alternative.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/Alternative.hs 2001-09-09 03:46:40.000000000 +0200 @@ -16,8 +16,6 @@ (Bifunctor (..)) import Data.Bitraversable (Bitraversable (..)) -import Data.Semigroup - (Semigroup (..)) import Data.Typeable (Typeable) import Prelude () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/ContentTypes.hs new/servant-0.19/src/Servant/API/ContentTypes.hs --- old/servant-0.18.3/src/Servant/API/ContentTypes.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/ContentTypes.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/NamedRoutes.hs new/servant-0.19/src/Servant/API/NamedRoutes.hs --- old/servant-0.18.3/src/Servant/API/NamedRoutes.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/servant-0.19/src/Servant/API/NamedRoutes.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 :: * -> *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/ResponseHeaders.hs new/servant-0.19/src/Servant/API/ResponseHeaders.hs --- old/servant-0.18.3/src/Servant/API/ResponseHeaders.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/ResponseHeaders.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,10 +3,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -51,9 +49,6 @@ import Prelude () import Prelude.Compat -import Servant.API.ContentTypes - (JSON, PlainText, FormUrlEncoded, OctetStream, - MimeRender(..)) import Servant.API.Header (Header) @@ -117,7 +112,7 @@ `HCons` buildHeadersTo headers Right h -> Header h `HCons` buildHeadersTo headers --- * Getting +-- * Getting headers class GetHeaders ls where getHeaders :: ls -> [HTTP.Header] @@ -158,20 +153,20 @@ where getHeaders' hs = getHeadersFromHList $ getHeadersHList hs --- * Adding +-- * Adding headers -- We need all these fundeps to save type inference class AddHeader h v orig new | h v orig -> new, new -> h, new -> v, new -> orig where addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times - +-- In this instance, we add a Header on top of something that is already decorated with some headers instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads) -instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v - , new ~ (Headers '[Header h v] a) ) +-- In this instance, 'a' parameter is decorated with a Header. +instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header h v] a) => AddHeader h v a new where addOptionalHeader hdr resp = Headers resp (HCons hdr HNil) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/Status.hs new/servant-0.19/src/Servant/API/Status.hs --- old/servant-0.18.3/src/Servant/API/Status.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/Status.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,15 @@ {-# LANGUAGE DataKinds #-} -- Flexible instances is necessary on GHC 8.4 and earlier {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.Status where +import GHC.TypeLits (KnownNat, natVal) import Network.HTTP.Types.Status -import GHC.TypeLits + +-- | Retrieve a known or unknown Status from a KnownNat +statusFromNat :: forall a proxy. KnownNat a => proxy a -> Status +statusFromNat = toEnum . fromInteger . natVal -- | Witness that a type-level natural number corresponds to a HTTP status code class KnownNat n => KnownStatus n where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/Stream.hs new/servant-0.19/src/Servant/API/Stream.hs --- old/servant-0.18.3/src/Servant/API/Stream.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/Stream.hs 2001-09-09 03:46:40.000000000 +0200 @@ -47,8 +47,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS8 import Data.List.NonEmpty (NonEmpty (..)) -import Data.Monoid - ((<>)) import Data.Proxy (Proxy) import Data.Typeable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/TypeErrors.hs new/servant-0.19/src/Servant/API/TypeErrors.hs --- old/servant-0.18.3/src/Servant/API/TypeErrors.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/servant-0.19/src/Servant/API/TypeErrors.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,40 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | This module defines the error messages used in type-level errors. +-- Type-level errors can signal non-existing instances, for instance when +-- a combinator is not applied to the correct number of arguments. + +module Servant.API.TypeErrors ( + PartialApplication, + NoInstanceFor, + NoInstanceForSub, +) where + +import Data.Kind +import GHC.TypeLits + +-- | No instance exists for @tycls (expr :> ...)@ because +-- @expr@ is not recognised. +type NoInstanceForSub (tycls :: k) (expr :: k') = + Text "There is no instance for " :<>: ShowType tycls + :<>: Text " (" :<>: ShowType expr :<>: Text " :> ...)" + +-- | No instance exists for @expr@. +type NoInstanceFor (expr :: k) = + Text "There is no instance for " :<>: ShowType expr + +-- | No instance exists for @tycls (expr :> ...)@ because @expr@ is not fully saturated. +type PartialApplication (tycls :: k) (expr :: k') = + NoInstanceForSub tycls expr + :$$: ShowType expr :<>: Text " expects " :<>: ShowType (Arity expr) :<>: Text " more arguments" + +-- The arity of a combinator, i.e. the number of required arguments. +type Arity (ty :: k) = Arity' k + +type family Arity' (ty :: k) :: Nat where + Arity' (_ -> ty) = 1 + Arity' ty + Arity' _ = 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API/Verbs.hs new/servant-0.19/src/Servant/API/Verbs.hs --- old/servant-0.18.3/src/Servant/API/Verbs.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API/Verbs.hs 2001-09-09 03:46:40.000000000 +0200 @@ -128,7 +128,8 @@ type PatchNoContent = NoContentVerb 'PATCH -- | 'PUT' with 204 status code. type PutNoContent = NoContentVerb 'PUT - +-- | 'HEAD' with 204 status code. +type HeadNoContent = NoContentVerb 'HEAD -- ** 205 Reset Content -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/API.hs new/servant-0.19/src/Servant/API.hs --- old/servant-0.18.3/src/Servant/API.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/API.hs 2001-09-09 03:46:40.000000000 +0200 @@ -36,6 +36,9 @@ 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 @@ 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, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/Links.hs new/servant-0.19/src/Servant/Links.hs --- old/servant-0.18.3/src/Servant/Links.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/Links.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,18 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} + {-# OPTIONS_HADDOCK not-home #-} -- | Type safe generation of internal links. @@ -125,10 +130,9 @@ ) where import Data.List +import Data.Constraint import Data.Proxy (Proxy (..)) -import Data.Semigroup - ((<>)) import Data.Singletons.Bool (SBool (..), SBoolI (..)) import qualified Data.Text as Text @@ -136,7 +140,7 @@ import Data.Type.Bool (If) import GHC.TypeLits - (KnownSymbol, symbolVal) + (KnownSymbol, TypeError, symbolVal) import Network.URI (URI (..), escapeURIString, isUnreserved) import Prelude () @@ -165,6 +169,8 @@ (IsSecure) import Servant.API.Modifiers (FoldRequired) +import Servant.API.NamedRoutes + (NamedRoutes) import Servant.API.QueryParam (QueryFlag, QueryParam', QueryParams) import Servant.API.Raw @@ -177,6 +183,7 @@ (Stream, StreamBody') import Servant.API.Sub (type (:>)) +import Servant.API.TypeErrors import Servant.API.TypeLevel import Servant.API.UVerb import Servant.API.Vault @@ -581,6 +588,34 @@ instance HasLink (UVerb m ct a) where type MkLink (UVerb m ct a) r = r toLink toA _ = toA +-- Instance for NamedRoutes combinator + +type GLinkConstraints routes a = + ( MkLink (ToServant routes AsApi) a ~ ToServant routes (AsLink a) + , GenericServant routes (AsLink a) + ) + +class GLink (routes :: * -> *) (a :: *) where + gLinkProof :: Dict (GLinkConstraints routes a) + +instance GLinkConstraints routes a => GLink routes a where + gLinkProof = Dict + +instance + ( HasLink (ToServantApi routes) + , forall a. GLink routes a + ) => HasLink (NamedRoutes routes) where + + type MkLink (NamedRoutes routes) a = routes (AsLink a) + + toLink + :: forall a. (Link -> a) + -> Proxy (NamedRoutes routes) + -> Link + -> routes (AsLink a) + + toLink toA _ l = case gLinkProof @routes @a of + Dict -> fromServant $ toLink toA (Proxy @(ToServantApi routes)) l -- AuthProtext instances instance HasLink sub => HasLink (AuthProtect tag :> sub) where @@ -610,3 +645,14 @@ -- $setup -- >>> import Servant.API -- >>> import Data.Text (Text) + +-- Erroring instance for 'HasLink' when a combinator is not fully applied +instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub) + where + type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr) + toLink = error "unreachable" + +-- Erroring instances for 'HasLink' for unknown API combinators +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub) + +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-0.18.3/src/Servant/Types/SourceT.hs new/servant-0.19/src/Servant/Types/SourceT.hs --- old/servant-0.18.3/src/Servant/Types/SourceT.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-0.19/src/Servant/Types/SourceT.hs 2001-09-09 03:46:40.000000000 +0200 @@ -319,7 +319,7 @@ -- | Read file. -- -- >>> foreach fail BS.putStr (readFile "servant.cabal") --- cabal-version: >=1.10 +-- cabal-version: 2.2 -- name: servant -- ... --
