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: other-modules:
Servant.Client.Core.Internal Servant.Client.Core.Internal
Servant.Client.Core.HasClient.Internal
Servant.Client.Core.HasClient.TypeErrors
-- Bundled with GHC: Lower bound to not force re-installs -- Bundled with GHC: Lower bound to not force re-installs
-- text and mtl are bundled starting with GHC-8.4 -- 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 TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Servant.Client.Core.HasClient ( module Servant.Client.Core.HasClient.Internal (
clientIn, clientIn,
HasClient (..), HasClient (..),
EmptyClient (..), EmptyClient (..),
@ -62,7 +62,7 @@ import Data.Text
import Data.Proxy import Data.Proxy
(Proxy (Proxy)) (Proxy (Proxy))
import GHC.TypeLits import GHC.TypeLits
(KnownNat, KnownSymbol, TypeError, symbolVal) (KnownNat, KnownSymbol, symbolVal)
import Network.HTTP.Types import Network.HTTP.Types
(Status) (Status)
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
@ -88,7 +88,6 @@ import Servant.API.Status
import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment) import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
import Servant.API.Modifiers import Servant.API.Modifiers
(FoldRequired, RequiredArgument, foldRequiredArgument) (FoldRequired, RequiredArgument, foldRequiredArgument)
import Servant.API.TypeErrors
import Servant.API.UVerb import Servant.API.UVerb
(HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion) (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
@ -974,19 +973,3 @@ decodedAs response ct = do
Right val -> return val Right val -> return val
where where
accept = toList $ contentTypes ct 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