3ed24fd · typeable/servant

servant/servant.cabal+1

compare with master

unifiedsplit

@@ -55,6 +55,7 @@ library

55 Servant.API.Status

56 Servant.API.Stream

57 Servant.API.Sub

58+ Servant.API.TypeErrors

58 Servant.API.TypeLevel

59 Servant.API.TypeLevel

59 Servant.API.UVerb

60 Servant.API.UVerb

60 Servant.API.UVerb.Union

61 Servant.API.UVerb.Union

servant/src/Servant/API/TypeErrors.hsnew file+40

@@ -0,0 +1,40 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE PolyKinds #-}

3+{-# LANGUAGE TypeFamilies #-}

4+{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE UndecidableInstances #-}

6+

7+-- | This module defines the error messages used in type-level errors.

8+-- Type-level errors can signal non-existing instances, for instance when

9+-- a combinator is not applied to the correct number of arguments.

10+

11+module Servant.API.TypeErrors (

12+ PartialApplication,

13+ NoInstanceFor,

14+ NoInstanceForSub,

15+) where

16+

17+import Data.Kind

18+import GHC.TypeLits

19+

20+-- | No instance exists for @tycls (expr :> ...)@ because

21+-- @expr@ is not recognised.

22+type NoInstanceForSub (tycls :: k) (expr :: k') =

23+ Text "There is no instance for " :<>: ShowType tycls

24+ :<>: Text " (" :<>: ShowType expr :<>: Text " :> ...)"

25+

26+-- | No instance exists for @expr@.

27+type NoInstanceFor (expr :: k) =

28+ Text "There is no instance for " :<>: ShowType expr

29+

30+-- | No instance exists for @tycls (expr :> ...)@ because @expr@ is not fully saturated.

31+type PartialApplication (tycls :: k) (expr :: k') =

32+ NoInstanceForSub tycls expr

33+ :$$: ShowType expr :<>: Text " expects " :<>: ShowType (Arity expr) :<>: Text " more arguments"

34+

35+-- The arity of a combinator, i.e. the number of required arguments.

36+type Arity (ty :: k) = Arity' k

37+

38+type family Arity' (ty :: k) :: Nat where

39+ Arity' (_ -> ty) = 1 + Arity' ty

40+ Arity' _ = 0

servant/src/Servant/Links.hs+13−1

@@ -140,7 +140,7 @@ import qualified Data.Text.Encoding as TE

140import Data.Type.Bool

141 (If)

142import GHC.TypeLits

143− (KnownSymbol, symbolVal)

143+ (KnownSymbol, TypeError, symbolVal)

144import Network.URI

145 (URI (..), escapeURIString, isUnreserved)

146import Prelude ()

@@ -183,6 +183,7 @@ import Servant.API.Stream

183 (Stream, StreamBody')

184import Servant.API.Sub

185 (type (:>))

186+import Servant.API.TypeErrors

186import Servant.API.TypeLevel

187import Servant.API.TypeLevel

187import Servant.API.UVerb

188import Servant.API.UVerb

188import Servant.API.Vault

189import Servant.API.Vault

@@ -644,3 +645,14 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)

644-- $setup

645-- $setup

645-- >>> import Servant.API

646-- >>> import Servant.API

646-- >>> import Data.Text (Text)

647-- >>> import Data.Text (Text)

648+

649+-- Erroring instance for 'HasLink' when a combinator is not fully applied

650+instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)

651+ where

652+ type MkLink (arr :> sub) _ = TypeError (PartialApplication HasLink arr)

653+ toLink = error "unreachable"

654+

655+-- Erroring instances for 'HasLink' for unknown API combinators

656+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub)

657+

658+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api