@@ -41,7 +41,7 @@ import qualified Data.ByteString as B
41import qualified Data.ByteString.Builder as BB
41import qualified Data.ByteString.Builder as BB
42import qualified Data.ByteString.Char8 as BC8
42import qualified Data.ByteString.Char8 as BC8
43import qualified Data.ByteString.Lazy as BL
43import qualified Data.ByteString.Lazy as BL
44−import Data.Constraint (Dict(..))
44+import Data.Constraint (Constraint, Dict(..))
45import Data.Either
45import Data.Either
46 (partitionEithers)
46 (partitionEithers)
47import Data.Maybe
47import Data.Maybe
@@ -56,7 +56,7 @@ import qualified Data.Text as T
56import Data.Typeable
56import Data.Typeable
57import GHC.Generics
57import GHC.Generics
58import GHC.TypeLits
58import GHC.TypeLits
59− (KnownNat, KnownSymbol, symbolVal)
59+ (KnownNat, KnownSymbol, TypeError, symbolVal)
60import qualified Network.HTTP.Media as NHM
60import qualified Network.HTTP.Media as NHM
61import Network.HTTP.Types hiding
61import Network.HTTP.Types hiding
62 (Header, ResponseHeaders)
62 (Header, ResponseHeaders)
@@ -90,6 +90,7 @@ import Servant.API.ResponseHeaders
90import Servant.API.Status
90import Servant.API.Status
91 (statusFromNat)
91 (statusFromNat)
92import qualified Servant.Types.SourceT as S
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)
@@ -172,7 +173,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
172-- > server = getBook
173-- > server = getBook
173-- > where getBook :: Text -> Handler Book
174-- > where getBook :: Text -> Handler Book
174-- > getBook isbn = ...
175-- > getBook isbn = ...
175−instance (KnownSymbol capture, FromHttpApiData a
176+instance (KnownSymbol capture, FromHttpApiData a, Typeable a
176 , HasServer api context, SBoolI (FoldLenient mods)
177 , HasServer api context, SBoolI (FoldLenient mods)
177 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
178 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
@@ -184,7 +185,7 @@ instance (KnownSymbol capture, FromHttpApiData a
184 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
185 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
186 route Proxy context d =
187 route Proxy context d =
187− CaptureRouter $
188+ CaptureRouter [hint] $
188 route (Proxy :: Proxy api)
189 route (Proxy :: Proxy api)
190 (addCapture d $ \ txt -> withRequest $ \ request ->
191 (addCapture d $ \ txt -> withRequest $ \ request ->
@@ -196,6 +197,7 @@ instance (KnownSymbol capture, FromHttpApiData a
197 rep = typeRep (Proxy :: Proxy Capture')
198 rep = typeRep (Proxy :: Proxy Capture')
198 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
199 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
200+ hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))
200-- | If you use 'CaptureAll' in one of the endpoints for your API,
202-- | If you use 'CaptureAll' in one of the endpoints for your API,
201-- this automatically requires your server-side handler to be a
203-- this automatically requires your server-side handler to be a
@@ -214,7 +216,7 @@ instance (KnownSymbol capture, FromHttpApiData a
214-- > server = getSourceFile
216-- > server = getSourceFile
215-- > where getSourceFile :: [Text] -> Handler Book
217-- > where getSourceFile :: [Text] -> Handler Book
216-- > getSourceFile pathSegments = ...
218-- > getSourceFile pathSegments = ...
217−instance (KnownSymbol capture, FromHttpApiData a
219+instance (KnownSymbol capture, FromHttpApiData a, Typeable a
218 , HasServer api context
220 , HasServer api context
219 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
221 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
@@ -226,7 +228,7 @@ instance (KnownSymbol capture, FromHttpApiData a
226 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
228 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
228 route Proxy context d =
230 route Proxy context d =
229− CaptureAllRouter $
231+ CaptureAllRouter [hint] $
230 route (Proxy :: Proxy api)
232 route (Proxy :: Proxy api)
232 (addCapture d $ \ txts -> withRequest $ \ request ->
234 (addCapture d $ \ txts -> withRequest $ \ request ->
@@ -237,6 +239,7 @@ instance (KnownSymbol capture, FromHttpApiData a
238 rep = typeRep (Proxy :: Proxy CaptureAll)
240 rep = typeRep (Proxy :: Proxy CaptureAll)
239 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
241 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
242+ hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
241allowedMethodHead :: Method -> Request -> Bool
244allowedMethodHead :: Method -> Request -> Bool
242allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
245allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
@@ -814,38 +817,15 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
814 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
817 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
816-------------------------------------------------------------------------------
819-------------------------------------------------------------------------------
817−-- TypeError helpers
820+-- Custom type errors
818-------------------------------------------------------------------------------
821-------------------------------------------------------------------------------
820−-- | This instance catches mistakes when there are non-saturated
823+-- Erroring instance for 'HasServer' when a combinator is not fully applied
821−-- type applications on LHS of ':>'.
823−-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")
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"
830−-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
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"
837−instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
824+instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
839− type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
826+ type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
840− -- it doesn't really matter what sub route we peak
827+ route = error "unreachable"
841− route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
842− hoistServerWithContext _ _ _ = id
828+ hoistServerWithContext _ _ _ _ = error "unreachable"
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"
850-- | This instance prevents from accidentally using '->' instead of ':>'
830-- | This instance prevents from accidentally using '->' instead of ':>'
@@ -880,6 +860,15 @@ type HasServerArrowTypeError a b =
880 ':$$: 'Text "and"
860 ':$$: 'Text "and"
881 ':$$: 'ShowType b
861 ':$$: 'ShowType b
863+-- Erroring instances for 'HasServer' for unknown API combinators
865+-- XXX: This omits the @context@ parameter, e.g.:
867+-- "There is no instance for HasServer (Bool :> …)". Do we care ?
868+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context
870+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context
883-- | Ignore @'Fragment'@ in server handlers.
872-- | Ignore @'Fragment'@ in server handlers.
884-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
873-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.