Better type errors for NamedRoutes
without Generic
This commit is contained in:
parent
c382a1f34e
commit
420d633a90
5 changed files with 27 additions and 1 deletions
|
@ -850,6 +850,7 @@ instance
|
|||
( forall n. GClient api n
|
||||
, HasClient m (ToServantApi api)
|
||||
, RunClient m
|
||||
, ErrorIfNoGeneric api
|
||||
)
|
||||
=> HasClient m (NamedRoutes api) where
|
||||
type Client m (NamedRoutes api) = api (AsClientT m)
|
||||
|
|
|
@ -61,6 +61,7 @@ import qualified GHC.Generics as G
|
|||
import GHC.TypeLits
|
||||
import Servant.API
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.API.TypeErrors
|
||||
import Servant.API.TypeLevel
|
||||
import Servant.API.Generic
|
||||
|
||||
|
@ -1154,7 +1155,10 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
|
|||
authProxy = Proxy :: Proxy (BasicAuth realm usr)
|
||||
action' = over authInfo (|> toAuthInfo authProxy) action
|
||||
|
||||
instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
|
||||
instance
|
||||
( HasDocs (ToServantApi api)
|
||||
, ErrorIfNoGeneric api
|
||||
) => HasDocs (NamedRoutes api) where
|
||||
docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
|
||||
|
||||
-- ToSample instances for simple types
|
||||
|
|
|
@ -983,6 +983,7 @@ instance
|
|||
( HasServer (ToServantApi api) context
|
||||
, forall m. Generic (api (AsServerT m))
|
||||
, forall m. GServer api m
|
||||
, ErrorIfNoGeneric api
|
||||
) => HasServer (NamedRoutes api) context where
|
||||
|
||||
type ServerT (NamedRoutes api) m = api (AsServerT m)
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
@ -12,9 +13,11 @@ module Servant.API.TypeErrors (
|
|||
PartialApplication,
|
||||
NoInstanceFor,
|
||||
NoInstanceForSub,
|
||||
ErrorIfNoGeneric,
|
||||
) where
|
||||
|
||||
import Data.Kind
|
||||
import GHC.Generics (Generic(..))
|
||||
import GHC.TypeLits
|
||||
|
||||
-- | No instance exists for @tycls (expr :> ...)@ because
|
||||
|
@ -38,3 +41,19 @@ type Arity (ty :: k) = Arity' k
|
|||
type family Arity' (ty :: k) :: Nat where
|
||||
Arity' (_ -> ty) = 1 + Arity' ty
|
||||
Arity' _ = 0
|
||||
|
||||
-- see https://blog.csongor.co.uk/report-stuck-families/
|
||||
type ErrorIfNoGeneric routes = Break (NoGeneric routes :: Type) (Rep (routes ()))
|
||||
|
||||
data T1 a
|
||||
|
||||
type family Break err a :: Constraint where
|
||||
Break _ T1 = ((), ())
|
||||
Break _ a = ()
|
||||
|
||||
type family NoGeneric (routes :: Type -> Type) where
|
||||
NoGeneric routes = TypeError
|
||||
( 'Text "Named routes require a "
|
||||
':<>: 'ShowType Generic ':<>: 'Text " instance for "
|
||||
':<>: 'ShowType routes
|
||||
)
|
||||
|
|
|
@ -613,6 +613,7 @@ instance GLinkConstraints routes a => GLink routes a where
|
|||
instance
|
||||
( HasLink (ToServantApi routes)
|
||||
, forall a. GLink routes a
|
||||
, ErrorIfNoGeneric routes
|
||||
) => HasLink (NamedRoutes routes) where
|
||||
|
||||
type MkLink (NamedRoutes routes) a = routes (AsLink a)
|
||||
|
|
Loading…
Reference in a new issue