Move erroring instances of HasClient to separate file

haskell-servant · Nov 22, 2022 · afa8778 · afa8778
1 parent 9a4c874
commit afa8778
Show file tree

Hide file tree

Showing 4 changed files with 53 additions and 19 deletions.
diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal
@@ -44,6 +44,8 @@ library
 
   other-modules:
       Servant.Client.Core.Internal
+      Servant.Client.Core.HasClient.Internal
+      Servant.Client.Core.HasClient.TypeErrors
 
   -- Bundled with GHC: Lower bound to not force re-installs
   -- text and mtl are bundled starting with GHC-8.4

diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs
@@ -0,0 +1,8 @@
+-- | Wrapper for Servant.Client.Core.HasClient.Internal, which brings in scope the
+-- instance declarations in Servant.Client.Core.HasClient.TypeErrors
+module Servant.Client.Core.HasClient
+  ( module Servant.Client.Core.HasClient.Internal
+  ) where
+
+import           Servant.Client.Core.HasClient.Internal
+import           Servant.Client.Core.HasClient.TypeErrors ()
diff --git a/servant-client-core/src/Servant/Client/Core/HasClient/Internal.hs b/servant-client-core/src/Servant/Client/Core/HasClient/Internal.hs
@@ -14,7 +14,7 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
-module Servant.Client.Core.HasClient (
+module Servant.Client.Core.HasClient.Internal (
     clientIn,
     HasClient (..),
     EmptyClient (..),
@@ -62,7 +62,7 @@ import           Data.Text
 import           Data.Proxy
                  (Proxy (Proxy))
 import           GHC.TypeLits
-                 (KnownNat, KnownSymbol, TypeError, symbolVal)
+                 (KnownNat, KnownSymbol, symbolVal)
 import           Network.HTTP.Types
                  (Status)
 import qualified Network.HTTP.Types                       as H
@@ -88,7 +88,6 @@ import           Servant.API.Status
 import           Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
 import           Servant.API.Modifiers
                  (FoldRequired, RequiredArgument, foldRequiredArgument)
-import           Servant.API.TypeErrors
 import           Servant.API.UVerb
                  (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
 
@@ -974,19 +973,3 @@ decodedAs response ct = do
     Right val -> return val
   where
     accept = toList $ contentTypes ct
-
--------------------------------------------------------------------------------
--- Custom type errors
--------------------------------------------------------------------------------
-
--- Erroring instance for HasClient' when a combinator is not fully applied
-instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
-  where
-    type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
-    clientWithRoute _ _ _ = error "unreachable"
-    hoistClientMonad _ _ _ _ = error "unreachable"
-
--- Erroring instances for 'HasClient' for unknown API combinators
-instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
-
-instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api
diff --git a/servant-client-core/src/Servant/Client/Core/HasClient/TypeErrors.hs b/servant-client-core/src/Servant/Client/Core/HasClient/TypeErrors.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans         #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+
+-- | This module contains erroring instances for @Servant.Client.Core.HasClient.Internal@.
+-- They are separated from the bulk of the code, because they raise "missing methods"
+-- warnings. These warnings are expected, but ignoring them would lead to missing
+-- relevant warnings in @Servant.Client.Core.HasClient.Internal@. Therefore, we put them
+-- in a separate file, and ignore the warnings here.
+module Servant.Client.Core.HasClient.TypeErrors ()
+  where
+
+import           Prelude ()
+import           Prelude.Compat
+
+import           GHC.TypeLits
+                 (TypeError)
+import           Servant.API
+                 ((:>))
+import           Servant.API.TypeErrors
+
+import           Servant.Client.Core.HasClient.Internal
+import           Servant.Client.Core.RunClient
+
+-- Erroring instance for HasClient' when a combinator is not fully applied
+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
+  where
+    type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
+    clientWithRoute _ _ _ = error "unreachable"
+    hoistClientMonad _ _ _ _ = error "unreachable"
+
+-- Erroring instances for 'HasClient' for unknown API combinators
+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
+
+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api