From a445fbafd6b02eaae589e2e18879070c79131d7b Mon Sep 17 00:00:00 2001
From: Teo Camarasu <teofilcamarasu@gmail.com>
Date: Tue, 18 Oct 2022 11:06:34 +0100
Subject: [PATCH] Use CPP to avoid errors with old GHC from TypeApplications in
 class instance

---
 servant-server/src/Servant/Server/Internal.hs | 13 +++++++++++--
 servant/src/Servant/Links.hs                  | 13 +++++++++++--
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index 77978d64..a4d74564 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveDataTypeable    #-}
 {-# 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
-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
     type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
     route = error "unreachable"
@@ -867,7 +872,11 @@ 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 @(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
 
diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs
index 9074429b..44e9987f 100644
--- a/servant/src/Servant/Links.hs
+++ b/servant/src/Servant/Links.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes    #-}
 {-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE CPP                    #-}
 {-# LANGUAGE DataKinds              #-}
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FlexibleInstances      #-}
@@ -649,12 +650,20 @@ 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 @(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
     type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
     toLink = error "unreachable"
 
 -- 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