git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1486 from haskell-servant/type-errors

Custom errors for HasClient, HasServer

commit75db4a5327d6d04ae2460bd5ffd008fe16197ba8 authorGaël Deest <gael.deest@tweag.io> dateTue 18 Jan 2022, 17:16 (5 years ago) parent3493d1375cb9ac
2 files changed+35−31
compare with master
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− (KnownNat, KnownSymbol, symbolVal)
68+ (KnownNat, KnownSymbol, TypeError, symbolVal)
6969import Network.HTTP.Types
7070 (Status)
7171import qualified Network.HTTP.Types as H
@@ -91,6 +91,7 @@ import Servant.API.Status
9191import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
9292import Servant.API.Modifiers
9393 (FoldRequired, RequiredArgument, foldRequiredArgument)
94+import Servant.API.TypeErrors
9495import Servant.API.UVerb
9596 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
9697
@@ -979,3 +980,19 @@ decodedAs response ct = do
979980 Right val -> return val
980981 where
981982 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+17−30
@@ -56,7 +56,7 @@ import qualified Data.Text as T
5656import Data.Typeable
5757import GHC.Generics
5858import GHC.TypeLits
59− (KnownNat, KnownSymbol, symbolVal)
59+ (KnownNat, KnownSymbol, TypeError, symbolVal)
6060import qualified Network.HTTP.Media as NHM
6161import Network.HTTP.Types hiding
6262 (Header, ResponseHeaders)
@@ -90,6 +90,7 @@ import Servant.API.ResponseHeaders
9090import Servant.API.Status
9191 (statusFromNat)
9292import qualified Servant.Types.SourceT as S
93+import Servant.API.TypeErrors
9394import Web.HttpApiData
9495 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
9596 parseUrlPieces)
@@ -814,38 +815,15 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
814815 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
815816
816817-------------------------------------------------------------------------------
817−-- TypeError helpers
818+-- Custom type errors
818819-------------------------------------------------------------------------------
819820
820−-- | This instance catches mistakes when there are non-saturated
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
821+-- Erroring instance for 'HasServer' when a combinator is not fully applied
822+instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
838823 where
839− type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
840− -- it doesn't really matter what sub route we peak
841− route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
842− hoistServerWithContext _ _ _ = id
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
824+ type ServerT (arr :> sub) _ = TypeError (PartialApplication HasServer arr)
825+ route = error "unreachable"
826+ hoistServerWithContext _ _ _ _ = error "unreachable"
849827
850828-- | This instance prevents from accidentally using '->' instead of ':>'
851829--
@@ -880,6 +858,15 @@ type HasServerArrowTypeError a b =
880858 ':$$: 'Text "and"
881859 ':$$: 'ShowType b
882860
861+-- Erroring instances for 'HasServer' for unknown API combinators
862+
863+-- XXX: This omits the @context@ parameter, e.g.:
864+--
865+-- "There is no instance for HasServer (Bool :> …)". Do we care ?
866+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context
867+
868+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context
869+
883870-- | Ignore @'Fragment'@ in server handlers.
884871-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
885872--