master...d8e4b62 · servant

git.iko.soy/servant

on d8e4b62 help sign in

2 files changed+35−31

since splitsnapshots

unifiedsplit

servant-client-core/src/Servant/Client/Core/HasClient.hs+18−1 servant-server/src/Servant/Server/Internal.hs+17−30

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

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

6565import Data.Proxy

6666 (Proxy (Proxy))

6767import GHC.TypeLits

68− (KnownSymbol, symbolVal)

68+ (KnownSymbol, TypeError, symbolVal)

6969import Network.HTTP.Types

7070 (Status)

7171import qualified Network.HTTP.Types as H

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

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

9090import Servant.API.Modifiers

9191 (FoldRequired, RequiredArgument, foldRequiredArgument)

92+import Servant.API.TypeErrors

9293import Servant.API.UVerb

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

9495

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

970971 Right val -> return val

971972 where

972973 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

5656import Data.Typeable

5757import GHC.Generics

5858import GHC.TypeLits

59− (KnownNat, KnownSymbol, natVal, symbolVal)

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

6060import qualified Network.HTTP.Media as NHM

6161import Network.HTTP.Types hiding

6262 (Header, ResponseHeaders)

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

8888import Servant.API.ResponseHeaders

8989 (GetHeaders, Headers, getHeaders, getResponse)

9090import qualified Servant.Types.SourceT as S

91+import Servant.API.TypeErrors

9192import Web.HttpApiData

9293 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,

9394 parseUrlPieces)

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

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

813814

814815-------------------------------------------------------------------------------

815−-- TypeError helpers

816+-- Custom type errors

816817-------------------------------------------------------------------------------

817818

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

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

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

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

836821 where

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

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

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

840− hoistServerWithContext _ _ _ = id

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

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

823+ route = error "unreachable"

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

847825

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

849827--

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

878856 ':$$: 'Text "and"

879857 ':$$: 'ShowType b

880858

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+

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

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

883870--