Move erroring instances of HasClient to separate file

This commit is contained in:
Nicolas BACQUEY 2022-03-17 16:44:24 +01:00
parent 5eced67f6c
commit 4a04825044
No known key found for this signature in database
GPG key ID: 518D364D061C12AC
4 changed files with 53 additions and 19 deletions

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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