aab7e0d · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Custom errors for HasClient, HasServer

aab7e0dGaël Deest5 years ago

servant-client-core/src/Servant/Client/Core/HasClient.hs+18−1

compare with master

unifiedsplit

@@ -65,7 +65,7 @@ import Data.Text

65import Data.Proxy

66 (Proxy (Proxy))

67import GHC.TypeLits

68− (KnownNat, KnownSymbol, symbolVal)

68+ (KnownNat, KnownSymbol, TypeError, symbolVal)

69import Network.HTTP.Types

70 (Status)

71import qualified Network.HTTP.Types as H

@@ -91,6 +91,7 @@ import Servant.API.Status

91import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)

92import Servant.API.Modifiers

93 (FoldRequired, RequiredArgument, foldRequiredArgument)

94+import Servant.API.TypeErrors

94import Servant.API.UVerb

95import Servant.API.UVerb

95 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

96 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

@@ -979,3 +980,19 @@ decodedAs response ct = do

979 Right val -> return val

980 Right val -> return val

980 where

981 where

981 accept = toList $ contentTypes ct

982 accept = toList $ contentTypes ct

983+

984+-------------------------------------------------------------------------------

985+-- Custom type errors

986+-------------------------------------------------------------------------------

987+

988+-- Erroring instance for HasClient' when a combinator is not fully applied

989+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)

990+ where

991+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)

992+ clientWithRoute _ _ _ = error "unreachable"

993+ hoistClientMonad _ _ _ _ = error "unreachable"

994+

995+-- Erroring instances for 'HasClient' for unknown API combinators

996+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)

997+

998+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api

servant-server/src/Servant/Server/Internal.hs+13−30

@@ -56,7 +56,7 @@ import qualified Data.Text as T

56import Data.Typeable

57import GHC.Generics

58import GHC.TypeLits

59− (KnownNat, KnownSymbol, symbolVal)

59+ (KnownNat, KnownSymbol, TypeError, symbolVal)

60import qualified Network.HTTP.Media as NHM

61import Network.HTTP.Types hiding

62 (Header, ResponseHeaders)

@@ -90,6 +90,7 @@ import Servant.API.ResponseHeaders

90import Servant.API.Status

91 (statusFromNat)

92import qualified Servant.Types.SourceT as S

93+import Servant.API.TypeErrors

93import Web.HttpApiData

94import Web.HttpApiData

94 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,

95 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,

95 parseUrlPieces)

96 parseUrlPieces)

@@ -814,38 +815,15 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

814 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

815 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

815

816

816-------------------------------------------------------------------------------

817-------------------------------------------------------------------------------

817−-- TypeError helpers

818+-- Custom type errors

818-------------------------------------------------------------------------------

819-------------------------------------------------------------------------------

819

820

820−-- | This instance catches mistakes when there are non-saturated

821+-- Erroring instance for 'HasServer' when a combinator is not fully applied

821−-- type applications on LHS of ':>'.

822−--

823−-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")

824−-- ...

825−-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.

826−-- ...Maybe you haven't applied enough arguments to

827−-- ...Capture' '[] "foo"

828−-- ...

829−--

830−-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)

831−-- ...

832−-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.

833−-- ...Maybe you haven't applied enough arguments to

834−-- ...Capture' '[] "foo"

835−-- ...

836−--

837−instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context

822+instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context

838 where

823 where

839− type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)

824+ type ServerT (arr :> sub) _ = TypeError (PartialApplication HasServer arr)

840− -- it doesn't really matter what sub route we peak

825+ route = error "unreachable"

841− route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"

842− hoistServerWithContext _ _ _ = id

826+ hoistServerWithContext _ _ _ _ = error "unreachable"

843−

844−-- Cannot have TypeError here, otherwise use of this symbol will error :)

845−type HasServerArrowKindError arr =

846− 'Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."

847− ':$$: 'Text "Maybe you haven't applied enough arguments to"

848− ':$$: 'ShowType arr

849

827

850-- | This instance prevents from accidentally using '->' instead of ':>'

828-- | This instance prevents from accidentally using '->' instead of ':>'

851--

829--

@@ -880,6 +858,11 @@ type HasServerArrowTypeError a b =

880 ':$$: 'Text "and"

858 ':$$: 'Text "and"

881 ':$$: 'ShowType b

859 ':$$: 'ShowType b

882

860

861+-- Erroring instances for 'HasServer' for unknown API combinators

862+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context

863+

864+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context

865+

883-- | Ignore @'Fragment'@ in server handlers.

866-- | Ignore @'Fragment'@ in server handlers.

884-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

867-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

885--

868--