master...d8e4b62 · servant

git.iko.soy/servant

on d8e4b62 help sign in

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

since splitsnapshots

unifiedsplit

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

65import Data.Proxy

66 (Proxy (Proxy))

67import GHC.TypeLits

68− (KnownSymbol, symbolVal)

68+ (KnownSymbol, TypeError, symbolVal)

69import Network.HTTP.Types

70 (Status)

71import qualified Network.HTTP.Types as H

@@ -89,6 +89,7 @@ import Servant.API.ContentTypes

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

90import Servant.API.Modifiers

91 (FoldRequired, RequiredArgument, foldRequiredArgument)

92+import Servant.API.TypeErrors

92import Servant.API.UVerb

93import Servant.API.UVerb

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

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

@@ -970,3 +971,19 @@ decodedAs response ct = do

970 Right val -> return val

971 Right val -> return val

971 where

972 where

972 accept = toList $ contentTypes ct

973 accept = toList $ contentTypes ct

974+

975+-------------------------------------------------------------------------------

976+-- Custom type errors

977+-------------------------------------------------------------------------------

978+

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

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

981+ where

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

983+ clientWithRoute _ _ _ = error "unreachable"

984+ hoistClientMonad _ _ _ _ = error "unreachable"

985+

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

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

988+

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

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

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

56import Data.Typeable

57import GHC.Generics

58import GHC.TypeLits

59− (KnownNat, KnownSymbol, natVal, symbolVal)

59+ (KnownNat, KnownSymbol, TypeError, natVal, symbolVal)

60import qualified Network.HTTP.Media as NHM

61import Network.HTTP.Types hiding

62 (Header, ResponseHeaders)

@@ -88,6 +88,7 @@ import Servant.API.Modifiers

88import Servant.API.ResponseHeaders

89 (GetHeaders, Headers, getHeaders, getResponse)

90import qualified Servant.Types.SourceT as S

91+import Servant.API.TypeErrors

91import Web.HttpApiData

92import Web.HttpApiData

92 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,

93 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,

93 parseUrlPieces)

94 parseUrlPieces)

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

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

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

813

814

814-------------------------------------------------------------------------------

815-------------------------------------------------------------------------------

815−-- TypeError helpers

816+-- Custom type errors

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

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

817

818

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

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

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

820−--

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

822−-- ...

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

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

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

826−-- ...

827−--

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

829−-- ...

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

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

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

833−-- ...

834−--

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

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

836 where

821 where

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

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

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

823+ route = error "unreachable"

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

840− hoistServerWithContext _ _ _ = id

824+ hoistServerWithContext _ _ _ _ = error "unreachable"

841−

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

843−type HasServerArrowKindError arr =

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

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

846− ':$$: 'ShowType arr

847

825

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

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

849--

827--

@@ -878,6 +856,15 @@ type HasServerArrowTypeError a b =

878 ':$$: 'Text "and"

856 ':$$: 'Text "and"

879 ':$$: 'ShowType b

857 ':$$: 'ShowType b

880

858

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

860+

861+-- XXX: This omits the @context@ parameter, e.g.:

862+--

863+-- "There is no instance for HasServer (Bool :> …)". Do we care ?

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

865+

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

867+

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

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

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

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

883--

870--