git.iko.soy/typeable/servant
on master help sign in
Type-level errors for HasLink for invalid combinators
commit42b7d0eb9bc36e02fc4aa2656bcbde9aa540aaee authorAndrea Condoluci <andrea.condoluci@tweag.io> dateFri 10 Apr 2020, 17:07 (7 years ago) parent48bc247
3 files changed+55−1
compare with master
unifiedsplit
servant/servant.cabal+1 servant/src/Servant/API/TypeErrors.hs+40 servant/src/Servant/Links.hs+14−1
servant/servant.cabal+1
@@ -54,6 +54,7 @@ library
5454 Servant.API.Status
5555 Servant.API.Stream
5656 Servant.API.Sub
57+ Servant.API.TypeErrors
5758 Servant.API.TypeLevel
5859 Servant.API.UVerb
5960 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+14−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
12{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -134,7 +135,7 @@ import qualified Data.Text.Encoding as TE
134135import Data.Type.Bool
135136 (If)
136137import GHC.TypeLits
137− (KnownSymbol, symbolVal)
138+ (KnownSymbol, TypeError, symbolVal)
138139import Network.URI
139140 (URI (..), escapeURIString, isUnreserved)
140141import Prelude ()
@@ -175,6 +176,7 @@ import Servant.API.Stream
175176 (Stream, StreamBody')
176177import Servant.API.Sub
177178 (type (:>))
179+import Servant.API.TypeErrors
178180import Servant.API.TypeLevel
179181import Servant.API.UVerb
180182import Servant.API.Vault
@@ -608,3 +610,14 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
608610-- $setup
609611-- >>> import Servant.API
610612-- >>> import Data.Text (Text)
613+
614+-- Erroring instance for 'HasLink' when a combinator is not fully applied
615+instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)
616+ where
617+ type MkLink (arr :> _) _ = TypeError (PartialApplication HasLink arr)
618+ toLink = error "unreachable"
619+
620+-- Erroring instances for 'HasLink' for unknown API combinators
621+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub)
622+
623+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api