Move erroring instances of HasClient to separate file
This commit is contained in:
parent
5eced67f6c
commit
4a04825044
4 changed files with 53 additions and 19 deletions
|
@ -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
|
||||||
|
|
8
servant-client-core/src/Servant/Client/Core/HasClient.hs
Normal file
8
servant-client-core/src/Servant/Client/Core/HasClient.hs
Normal 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 ()
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
Loading…
Reference in a new issue