Documentation improvements

This commit is contained in:
Julian K. Arni 2016-05-09 18:20:54 +02:00
parent c5172a1dc5
commit 26a6171265
4 changed files with 34 additions and 10 deletions

View File

@ -59,9 +59,12 @@ module Servant.QuickCheck
, defaultArgs
-- ** Re-exports
-- | Types and constructors from other packages that are generally needed for
-- using @servant-quickcheck@.
, BaseUrl(..)
, Scheme(..)
, Args(..)
, Proxy(..)
) where
@ -69,6 +72,10 @@ module Servant.QuickCheck
import Servant.QuickCheck.Internal
import Servant.Client (BaseUrl(..), Scheme(..))
import Test.QuickCheck (Args(..), stdArgs)
import Data.Proxy (Proxy(..))
-- | QuickCheck @Args@ with 1000 rather than 100 test cases.
--
-- /Since 0.0.0.0/
defaultArgs :: Args
defaultArgs = stdArgs { maxSuccess = 1000 }

View File

@ -14,12 +14,12 @@ instance Monoid (ResponseEquality b) where
-- | Use `Eq` instance for `Response`
--
-- #SINCE#
-- /Since 0.0.0.0/
allEquality :: Eq b => ResponseEquality b
allEquality = ResponseEquality (==)
-- | ByteString `Eq` instance over the response body.
--
-- #SINCE#
-- /Since 0.0.0.0/
bodyEquality :: Eq b => ResponseEquality b
bodyEquality = ResponseEquality ((==) `on` responseBody)

View File

@ -31,6 +31,8 @@ import Network.HTTP.Types (methodGet, methodHead, parseMethod,
-- indication of how to proceed or what went wrong.
--
-- This function checks that the response code is not 500.
--
-- /Since 0.0.0.0/
not500 :: ResponsePredicate Text Bool
not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == status500)
@ -53,6 +55,8 @@ not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == statu
--
-- * JSON Grammar: <https://tools.ietf.org/html/rfc7159#section-2 RFC 7159 Section 2>
-- * JSON Grammar: <https://tools.ietf.org/html/rfc4627#section-2 RFC 4627 Section 2>
--
-- /Since 0.0.0.0/
onlyJsonObjects :: ResponsePredicate Text Bool
onlyJsonObjects
= ResponsePredicate "onlyJsonObjects" (\resp -> case decode (responseBody resp) of
@ -76,6 +80,8 @@ onlyJsonObjects
--
-- * 201 Created: <https://tools.ietf.org/html/rfc7231#section-6.3.2 RFC 7231 Section 6.3.2>
-- * Location header: <https://tools.ietf.org/html/rfc7231#section-7.1.2 RFC 7231 Section 7.1.2>
--
-- /Since 0.0.0.0/
createContainsValidLocation :: RequestPredicate Text Bool
createContainsValidLocation
= RequestPredicate
@ -114,6 +120,8 @@ getsHaveLastModifiedHeader
--
-- * @Allow@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.7>
-- * Status 405: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html RFC 2616 Section 10.4.6>
--
-- /Since 0.0.0.0/
notAllowedContainsAllowHeader :: RequestPredicate Text Bool
notAllowedContainsAllowHeader
= RequestPredicate
@ -144,6 +152,8 @@ notAllowedContainsAllowHeader
-- __References__:
--
-- * @Accept@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.1>
--
-- /Since 0.0.0.0/
honoursAcceptHeader :: RequestPredicate Text Bool
honoursAcceptHeader
= RequestPredicate
@ -171,7 +181,7 @@ honoursAcceptHeader
--
-- * @Cache-Control@ header: <https://tools.ietf.org/html/rfc7234#section-5.2 RFC 7234 Section 5.2>
--
-- #SINCE#
-- /Since 0.0.0.0/
getsHaveCacheControlHeader :: RequestPredicate Text Bool
getsHaveCacheControlHeader
= RequestPredicate
@ -188,7 +198,7 @@ getsHaveCacheControlHeader
--
-- Like 'getsHaveCacheControlHeader', but for @HEAD@ requests.
--
-- #SINCE#
-- /Since 0.0.0.0/
headsHaveCacheControlHeader :: RequestPredicate Text Bool
headsHaveCacheControlHeader
= RequestPredicate
@ -260,7 +270,7 @@ linkHeadersAreValid
--
-- * @WWW-Authenticate@ header: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
--
-- #SINCE#
-- /Since 0.0.0.0/
unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool
unauthorizedContainsWWWAuthenticate
= ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp ->
@ -276,6 +286,9 @@ unauthorizedContainsWWWAuthenticate
--
-- Still, this is all kind of ugly.
-- | A predicate that depends only on the response.
--
-- /Since 0.0.0.0/
data ResponsePredicate n r = ResponsePredicate
{ respPredName :: n
, respPred :: Response LBS.ByteString -> r
@ -292,6 +305,9 @@ instance (Monoid n, Monoid r) => Monoid (ResponsePredicate n r) where
, respPred = respPred a <> respPred b
}
-- | A predicate that depends on both the request and the response.
--
-- /Since 0.0.0.0/
data RequestPredicate n r = RequestPredicate
{ reqPredName :: n
, reqResps :: Request -> Manager -> IO (r, [Response LBS.ByteString])
@ -309,6 +325,7 @@ instance (Monoid n, Monoid r) => Monoid (RequestPredicate n r) where
, reqResps = \x m -> liftM2 (<>) (reqResps a x m) (reqResps b x m)
}
-- | A set of predicates. Construct one with 'mempty' and '<%>'.
data Predicates n r = Predicates
{ reqPreds :: RequestPredicate n r
, respPreds :: ResponsePredicate n r
@ -339,7 +356,7 @@ instance JoinPreds (ResponsePredicate Text Bool) where
--
-- > not500 <%> onlyJsonObjects <%> empty
--
-- #SINCE#
-- /Since 0.0.0.0/
(<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
(<%>) = joinPreds
infixr 6 <%>

View File

@ -25,7 +25,7 @@ import Servant.QuickCheck.Internal.Equality
-- | Start a servant application on an open port, run the provided function,
-- then stop the application.
--
-- #SINCE#
-- /Since 0.0.0.0/
withServantServer :: HasServer a '[] => Proxy a -> IO (Server a)
-> (BaseUrl -> IO r) -> IO r
withServantServer api = withServantServerAndContext api EmptyContext
@ -33,7 +33,7 @@ withServantServer api = withServantServerAndContext api EmptyContext
-- | Like 'withServantServer', but allows passing in a 'Context' to the
-- application.
--
-- #SINCE#
-- /Since 0.0.0.0/
withServantServerAndContext :: HasServer a ctx
=> Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
withServantServerAndContext api ctx server t
@ -52,7 +52,7 @@ withServantServerAndContext api ctx server t
-- Evidently, if the behaviour of the server is expected to be
-- non-deterministic, this function may produce spurious failures
--
-- #SINCE#
-- /Since 0.0.0.0/
serversEqual :: HasGenRequest a =>
Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality LBS.ByteString -> Expectation
serversEqual api burl1 burl2 args req = do
@ -86,7 +86,7 @@ serversEqual api burl1 burl2 args req = do
-- > <%> notAllowedContainsAllowHeader
-- > <%> mempty)
--
-- #SINCE#
-- /Since 0.0.0.0/
serverSatisfies :: (HasGenRequest a) =>
Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
serverSatisfies api burl args preds = do