git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1289 from acondolu/master

Better errors for partially applied combinators

commit3ed24fdd900c30bc625f82e7faa8e548f473c1bc authorGaël Deest <gael.deest@tweag.io> dateThu 18 Nov 2021, 10:51 (5 years ago) parent0e41e3767a37dc
3 files changed+54−1
compare with master
unifiedsplit
servant/servant.cabal+1 servant/src/Servant/API/TypeErrors.hs+40 servant/src/Servant/Links.hs+13−1
servant/servant.cabal+1
@@ -55,6 +55,7 @@ library
5555 Servant.API.Status
5656 Servant.API.Stream
5757 Servant.API.Sub
58+ Servant.API.TypeErrors
5859 Servant.API.TypeLevel
5960 Servant.API.UVerb
6061 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
140140import Data.Type.Bool
141141 (If)
142142import GHC.TypeLits
143− (KnownSymbol, symbolVal)
143+ (KnownSymbol, TypeError, symbolVal)
144144import Network.URI
145145 (URI (..), escapeURIString, isUnreserved)
146146import Prelude ()
@@ -183,6 +183,7 @@ import Servant.API.Stream
183183 (Stream, StreamBody')
184184import Servant.API.Sub
185185 (type (:>))
186+import Servant.API.TypeErrors
186187import Servant.API.TypeLevel
187188import Servant.API.UVerb
188189import Servant.API.Vault
@@ -644,3 +645,14 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
644645-- $setup
645646-- >>> import Servant.API
646647-- >>> 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