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

Fix TypeError for GHC-9.4

Browse source 
In GHC-9.4 the typechecker changed requiring more annotations in positions like this. See https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.4#ambiguous-types-containing-a-typeerror and https://gitlab.haskell.org/ghc/ghc/-/issues/21149
This commit is contained in:
Teo Camarasu 2022-08-09 11:05:00 +01:00
parent e4650de303
commit 4627683a64
2 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
servant-server/src/Servant/Server/Internal.hs
View file

@ -94,6 +94,8 @@ import Servant.API.TypeErrors
import Web.HttpApiData import Web.HttpApiData
(FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece, (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
parseUrlPieces) parseUrlPieces)
import Data.Kind
(Type)
import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.BasicAuth
import Servant.Server.Internal.Context 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 -- 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 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"
@ -865,7 +867,7 @@ 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 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 instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context

6
servant/src/Servant/Links.hs
View file

@ -193,6 +193,8 @@ import Servant.API.Verbs
import Servant.API.WithNamedContext import Servant.API.WithNamedContext
(WithNamedContext) (WithNamedContext)
import Web.HttpApiData import Web.HttpApiData
import Data.Kind
(Type)
-- | A safe link datatype. -- | A safe link datatype.
-- The only way of constructing a 'Link' is using 'safeLink', which means any -- 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) -- >>> 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 HasLink arr) => HasLink ((arr :: a -> b) :> sub) instance TypeError (PartialApplication @(Type -> Constraint) 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 HasLink ty) => HasLink (ty :> sub) instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub @(Type -> Constraint) HasLink ty) => HasLink (ty :> sub)
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api