Documentation improvements

src/Servant/QuickCheck.hs

@@ -6,16 +6,6 @@
 -- tested itself need not be implemented with @servant-server@ (or indeed,
 -- written in Haskell).
 --
--- /N.B./ The examples given here assume the following setup:
---
--- > import Servant
--- > import Servant.QuickCheck
--- > import Test.Hspec
--- >
--- > type API = ReqBody '[JSON] Int :> Post '[JSON] String
--- >
--- > api :: Proxy API
--- > api = Proxy
 module Servant.QuickCheck
   (
 
@@ -24,19 +14,32 @@ module Servant.QuickCheck
   -- | Helpers to setup and teardown @servant@ servers during tests.
     withServantServer
 
-  , serversEqual
-  , serverSatisfies
 
-  -- * Response equality
+  -- * Equality testing
+  , serversEqual
+  -- ** Response equality
+  -- | Often the normal equality of responses is not what we want. For example,
+  -- if responses contain a @Date@ header with the time of the response,
+  -- responses will fail to be equal even though they morally are. This datatype
+  -- represents other means of checking equality
+  -- *** Useful @ResponseEquality@s
   , bodyEquality
   , allEquality
-  , ResponseEquality(getResponseEquality)
+  -- ** Response equality type
+  , ResponseEquality(..)
 
-  -- * Predicates
+  -- * Property testing
-  , (<%>)
+  , serverSatisfies
-  , Predicates
+  -- ** Predicates
+  -- *** Useful predicates
   , not500
   , onlyJsonObjects
+  , notAllowedContainsAllowHeader
+  -- *** Predicate utilities and types
+  , (<%>)
+  , Predicates
+  , ResponsePredicate(..)
+  , RequestPredicate(..)
 
   -- ** Re-exports
   , BaseUrl(..)

src/Servant/QuickCheck/Internal/Equality.hs

@@ -3,10 +3,6 @@ module Servant.QuickCheck.Internal.Equality where
 import Network.HTTP.Client
 import Data.Function (on)
 
--- | Often the normal equality of responses is not what we want. For example,
--- if responses contain a @Date@ header with the time of the response,
--- responses will fail to be equal even though they morally are. This datatype
--- represents other means of checking equality
 newtype ResponseEquality b
   = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
 
@@ -15,8 +11,10 @@ instance Monoid (ResponseEquality b) where
   ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
     a x y && b x y
 
+-- | Use `Eq` instance for `Response`
 allEquality :: Eq b => ResponseEquality b
 allEquality = ResponseEquality (==)
 
+-- | ByteString `Eq` instance over the response body.
 bodyEquality :: Eq b => ResponseEquality b
 bodyEquality = ResponseEquality ((==) `on` responseBody)

src/Servant/QuickCheck/Internal/Predicates.hs

@@ -229,9 +229,14 @@ instance JoinPreds (ResponsePredicate Text Bool) where
     where go = let p' = first return p
                in fmap (\z -> if z then [] else respPredName p') p'
 
-infixr 6 <%>
+
+-- | Adds a new predicate (either `ResponsePredicate` or `RequestPredicate`) to
+-- the existing predicates.
+--
+-- > not500 <%> onlyJsonObjects <%> empty
 (<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
 (<%>) = joinPreds
+infixr 6 <%>
 
 finishPredicates :: Predicates [Text] [Text] -> Request -> Manager -> IO [Text]
 finishPredicates p req mgr = do

src/Servant/QuickCheck/Internal/QuickCheck.hs

@@ -1,19 +1,20 @@
 -- | This module contains wrappers around lower-level functionality.
 module Servant.QuickCheck.Internal.QuickCheck where
 
+import qualified Data.ByteString.Lazy     as LBS
 import           Data.Proxy               (Proxy)
-import           Network.HTTP.Client      (Manager, defaultManagerSettings,
+import           Data.Text                (Text)
-                                           newManager, httpLbs, checkStatus, Request)
+import           Network.HTTP.Client      (Manager, Request, checkStatus,
+                                           defaultManagerSettings, httpLbs,
+                                           newManager)
 import           Network.Wai.Handler.Warp (withApplication)
 import           Servant                  (HasServer, Server, serve)
-import           Servant.Client           (BaseUrl (..), Scheme (..) )
+import           Servant.Client           (BaseUrl (..), Scheme (..))
+import           System.IO.Unsafe         (unsafePerformIO)
 import           Test.Hspec               (Expectation, expectationFailure)
 import           Test.QuickCheck          (Args (..), Result (..),
                                            quickCheckWithResult)
-import System.IO.Unsafe (unsafePerformIO)
+import           Test.QuickCheck.Monadic
-import Test.QuickCheck.Monadic
-import qualified Data.ByteString.Lazy as LBS
-import Data.Text (Text)
 
 import Servant.QuickCheck.Internal.HasGenRequest
 import Servant.QuickCheck.Internal.Predicates
@@ -54,13 +55,29 @@ serversEqual api burl1 burl2 args req = do
     NoExpectedFailure {} -> expectationFailure $ "No expected failure"
     InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
 
+-- | Check that a server satisfies the set of properties specified.
+--
+-- Note that, rather than having separate tests for each property you'd like to
+-- test, you should generally prefer to combine all properties into a single
+-- test. This enables a more parsimonious generation of requests and responses
+-- with the same testing depth.
+--
+-- Example usage:
+--
+-- > goodAPISpec = describe "my server" $ do
+-- >
+-- >   it "follows best practices" $ do
+-- >     withServantServer api server $ \burl ->
+-- >       serverSatisfies api burl stdArgs (not500
+-- >                                     <%> onlyJsonObjects
+-- >                                     <%> notAllowedContainsAllowHeader
+-- >                                     <%> mempty)
 serverSatisfies :: (HasGenRequest a) =>
   Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
 serverSatisfies api burl args preds = do
   let reqs = ($ burl) <$> genRequest api
   r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
      v <- run $ finishPredicates preds (noCheckStatus req) defManager
-     {-run $ print v-}
      assert $ null v
   case r of
     Success {} -> return ()