diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index a2b4f033..77978d64 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -94,6 +94,8 @@ import Servant.API.TypeErrors import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece, parseUrlPieces) +import Data.Kind + (Type) import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context @@ -821,7 +823,7 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA ------------------------------------------------------------------------------- -- Erroring instance for 'HasServer' when a combinator is not fully applied -instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context +instance TypeError (PartialApplication @(Type -> [Type] -> Constraint) HasServer arr) => HasServer ((arr :: a -> b) :> sub) context where type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr) route = error "unreachable" @@ -865,7 +867,7 @@ type HasServerArrowTypeError a b = -- XXX: This omits the @context@ parameter, e.g.: -- -- "There is no instance for HasServer (Bool :> …)". Do we care ? -instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub @(Type -> [Type] -> Constraint) HasServer ty) => HasServer (ty :> sub) context instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index ce07e22d..9074429b 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -193,6 +193,8 @@ import Servant.API.Verbs import Servant.API.WithNamedContext (WithNamedContext) import Web.HttpApiData +import Data.Kind + (Type) -- | A safe link datatype. -- The only way of constructing a 'Link' is using 'safeLink', which means any @@ -647,12 +649,12 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub) -- >>> 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) +instance TypeError (PartialApplication @(Type -> Constraint) 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 (NoInstanceForSub @(Type -> Constraint) HasLink ty) => HasLink (ty :> sub) instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api