eeva
/
servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Use CPP to avoid errors with old GHC from TypeApplications in class instance

This commit is contained in:
Teo Camarasu 2022-10-18 11:06:34 +01:00
parent 52f76ea722
commit a445fbafd6
2 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
servant-server/src/Servant/Server/Internal.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -823,7 +824,11 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Erroring instance for 'HasServer' when a combinator is not fully applied -- Erroring instance for 'HasServer' when a combinator is not fully applied
instance TypeError (PartialApplication @(Type -> [Type] -> Constraint) HasServer arr) => HasServer ((arr :: a -> b) :> sub) context instance TypeError (PartialApplication
#if __GLASGOW_HASKELL__ >= 904
@(Type -> [Type] -> Constraint)
#endif
HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
where where
type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr) type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
route = error "unreachable" route = error "unreachable"
@ -867,7 +872,11 @@ type HasServerArrowTypeError a b =
-- XXX: This omits the @context@ parameter, e.g.: -- XXX: This omits the @context@ parameter, e.g.:
-- --
-- "There is no instance for HasServer (Bool :> …)". Do we care ? -- "There is no instance for HasServer (Bool :> …)". Do we care ?
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub @(Type -> [Type] -> Constraint) HasServer ty) => HasServer (ty :> sub) context instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
#if __GLASGOW_HASKELL__ >= 904
@(Type -> [Type] -> Constraint)
#endif
HasServer ty) => HasServer (ty :> sub) context
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context

13
servant/src/Servant/Links.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
@ -649,12 +650,20 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
-- >>> import Data.Text (Text) -- >>> import Data.Text (Text)
-- Erroring instance for 'HasLink' when a combinator is not fully applied -- Erroring instance for 'HasLink' when a combinator is not fully applied
instance TypeError (PartialApplication @(Type -> Constraint) HasLink arr) => HasLink ((arr :: a -> b) :> sub) instance TypeError (PartialApplication
#if __GLASGOW_HASKELL__ >= 904
@(Type -> Constraint)
#endif
HasLink arr) => HasLink ((arr :: a -> b) :> sub)
where where
type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr) type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
toLink = error "unreachable" toLink = error "unreachable"
-- Erroring instances for 'HasLink' for unknown API combinators -- Erroring instances for 'HasLink' for unknown API combinators
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub @(Type -> Constraint) HasLink ty) => HasLink (ty :> sub) instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
#if __GLASGOW_HASKELL__ >= 904
@(Type -> Constraint)
#endif
HasLink ty) => HasLink (ty :> sub)
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api