From 4a048250443729a8bb3510d65b27abc631e4edc4 Mon Sep 17 00:00:00 2001 From: Nicolas BACQUEY Date: Thu, 17 Mar 2022 16:44:24 +0100 Subject: [PATCH] Move erroring instances of HasClient to separate file --- servant-client-core/servant-client-core.cabal | 2 + .../src/Servant/Client/Core/HasClient.hs | 8 ++++ .../Servant/Client/Core/HasClient/Internal.hs | 21 +--------- .../Client/Core/HasClient/TypeErrors.hs | 41 +++++++++++++++++++ 4 files changed, 53 insertions(+), 19 deletions(-) create mode 100644 servant-client-core/src/Servant/Client/Core/HasClient.hs create mode 100644 servant-client-core/src/Servant/Client/Core/HasClient/TypeErrors.hs diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal index 1d15594f..1dd23c1a 100644 --- 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 new file mode 100644 index 00000000..7c30115b --- /dev/null +++ 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 index 80f85802..e4db171e 100644 --- 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 new file mode 100644 index 00000000..bddb6a4f --- /dev/null +++ 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