prelude-compat

.gitignore

@@ -1 +1,2 @@
 doc/_build/
+scripts/

servant-quickcheck.cabal

@@ -1,5 +1,5 @@
 name:                servant-quickcheck
-version:             0.1.0.0
+version:             0.0.0.0
 synopsis:            QuickCheck entire APIs
 description:
  This packages provides QuickCheck properties that are tested across an entire
@@ -20,12 +20,12 @@ flag long-tests
 library
   exposed-modules:     Servant.QuickCheck
                      , Servant.QuickCheck.Internal
-                     -- , Servant.QuickCheck.Internal.Benchmarking
                      , Servant.QuickCheck.Internal.Predicates
                      , Servant.QuickCheck.Internal.HasGenRequest
                      , Servant.QuickCheck.Internal.QuickCheck
                      , Servant.QuickCheck.Internal.Equality
   build-depends:       base >=4.7 && <4.9
+                     , base-compat == 0.9.*
                      , QuickCheck == 2.8.*
                      , bytestring == 0.10.*
                      , aeson > 0.10 && < 0.12
@@ -63,6 +63,7 @@ library
                      , ScopedTypeVariables
                      , OverloadedStrings
                      , FunctionalDependencies
+                     , NoImplicitPrelude
   default-language:    Haskell2010
 
 test-suite spec
@@ -89,16 +90,3 @@ test-suite spec
                      , DataKinds
   if flag(long-tests)
       cpp-options: -DLONG_TESTS
-
--- test-suite doctests
---   default-language:    Haskell2010
---   type:                exitcode-stdio-1.0
---   ghc-options:         -threaded
---   main-is:             Doctest.hs
---   hs-source-dirs:      test
---   build-depends:       base >4 && <5
---                      , doctest
---                      , filemanip
---                      , directory
---                      , filepath
---   HS-Source-Dirs:      test

src/Servant/QuickCheck/Internal.hs

@@ -4,4 +4,3 @@ import Servant.QuickCheck.Internal.HasGenRequest as X
 import Servant.QuickCheck.Internal.Predicates as X
 import Servant.QuickCheck.Internal.QuickCheck as X
 import Servant.QuickCheck.Internal.Equality as X
-import Servant.QuickCheck.Internal.Benchmarking as X

src/Servant/QuickCheck/Internal/Benchmarking.hs

@@ -1,83 +0,0 @@
--- This is a WIP module that shouldn't be used.
-module Servant.QuickCheck.Internal.Benchmarking where
-
-import Data.ByteString (ByteString)
-import Data.ByteString.Lazy (toStrict)
-import Network.HTTP.Client
-import Network.HTTP.Types
-import Servant.Client
-
-data BenchOptions = BenchOptions
-  { duration    :: Int
-  , threads     :: Int
-  , connections :: Int
-  , noOfTests   :: Int
-  } deriving (Eq, Show, Read)
-
-defaultBenchOptions :: BenchOptions
-defaultBenchOptions = BenchOptions
-  { duration    = 10
-  , threads     = 1
-  , connections = 10
-  , noOfTests   = 10
-  }
-
-data WrkScript = WrkScript
-  { wrkScheme  :: Scheme
-  , wrkHost    :: ByteString
-  , wrkPort    :: Int
-  , wrkMethod  :: Method
-  , wrkPath    :: ByteString
-  , wrkHeaders :: [Header]
-  , wrkBody    :: ByteString
-  } deriving (Eq, Show)
-
-mkScript :: WrkScript -> String
-mkScript w
-  =  "wrk.scheme = \"" ++ sscheme (wrkScheme w) ++ "\""
-  ++ "\nwrk.host = " ++ show (wrkHost w)
-  ++ "\nwrk.port = " ++ show (wrkPort w)
-  ++ "\nwrk.method = " ++ show (wrkMethod w)
-  ++ "\nwrk.path = " ++ show (wrkPath w)
-  ++ foldr (\(h,v) old -> old ++ "\nwrk.headers[" ++ show h ++ "] = " ++ show v)
-           ""
-           (wrkHeaders w)
-  ++ "\nwrk.body = " ++ show (wrkBody w)
-  ++ "\n" ++ reportFmt
-  where
-    sscheme Http  = "http"
-    sscheme Https = "https"
-
-reqToWrk :: Request -> WrkScript
-reqToWrk r = WrkScript
-  { wrkScheme  = Http
-  , wrkHost    = host r
-  , wrkPort    = port r
-  , wrkMethod  = method r
-  , wrkPath    = path r
-  , wrkHeaders = requestHeaders r
-  , wrkBody    = case requestBody r of
-     RequestBodyLBS r' -> toStrict r'
-     _ -> error "expecting RequestBodyLBS"
-  }
-
-reportFmt :: String
-reportFmt
-  =  "done = function(summary, latency, requests)\n"
-  ++ "  for _, p in pairs({ 50, 75, 99, 99.999 }) do\n"
-  ++ "     n  = latency:percentile(p)\n"
-  ++ "     io.write(string.format(\"%g%%, %d\\n\", p, n))\n"
-  ++ "  end\n"
-  ++ "end\n"
-
-{-data BenchResult = BenchResult-}
-  {-{ benchReq :: Request-}
-  {-, benchLatencyDist :: [(Percentile, Microsecs)]-}
-  {-, benchLatencyAvg :: Microsecs-}
-  {-} deriving (Eq, Show, Read, Generic)-}
-
-{-newtype Microsecs = Microsecs { unMicroSecs :: Int }-}
-  {-deriving (Eq, Show, Read, Generic)-}
-
-{-newtype Percentile = Percentile { unPercentile :: Int }-}
-  {-deriving (Eq, Show, Read, Generic)-}

src/Servant/QuickCheck/Internal/Equality.hs

@@ -1,7 +1,8 @@
 module Servant.QuickCheck.Internal.Equality where
 
-import Network.HTTP.Client
+import           Data.Function       (on)
-import Data.Function (on)
+import           Network.HTTP.Client (Response, responseBody)
+import           Prelude.Compat
 
 newtype ResponseEquality b
   = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
@@ -12,9 +13,13 @@ instance Monoid (ResponseEquality b) where
     a x y && b x y
 
 -- | Use `Eq` instance for `Response`
+--
+-- #SINCE#
 allEquality :: Eq b => ResponseEquality b
 allEquality = ResponseEquality (==)
 
 -- | ByteString `Eq` instance over the response body.
+--
+-- #SINCE#
 bodyEquality :: Eq b => ResponseEquality b
 bodyEquality = ResponseEquality ((==) `on` responseBody)

src/Servant/QuickCheck/Internal/HasGenRequest.hs

@@ -5,15 +5,16 @@ import           Data.Default.Class       (def)
 import           Data.Monoid              ((<>))
 import           Data.String              (fromString)
 import           Data.String.Conversions  (cs)
-import           GHC.TypeLits
+import           GHC.TypeLits             (KnownSymbol, Nat, symbolVal)
 import           Network.HTTP.Client      (Request, RequestBody (..), host,
-                                           method, path, port, requestBody,
+                                           method, path, port, queryString,
-                                           requestHeaders, secure, queryString)
+                                           requestBody, requestHeaders, secure)
 import           Network.HTTP.Media       (renderHeader)
+import           Prelude.Compat
 import           Servant
-import           Servant.API.ContentTypes
+import           Servant.API.ContentTypes (AllMimeRender (..))
 import           Servant.Client           (BaseUrl (..), Scheme (..))
-import           Test.QuickCheck
+import           Test.QuickCheck          (Arbitrary (..), Gen, elements, oneof)
 
 
 class HasGenRequest a where

src/Servant/QuickCheck/Internal/Predicates.hs

@@ -3,6 +3,7 @@ module Servant.QuickCheck.Internal.Predicates where
 import           Control.Monad         (liftM2)
 import           Data.Aeson            (Object, decode)
 import           Data.Bifunctor        (Bifunctor (..))
+import           Prelude.Compat
 import qualified Data.ByteString       as SBS
 import qualified Data.ByteString.Char8 as SBSC
 import qualified Data.ByteString.Lazy  as LBS
@@ -169,6 +170,8 @@ honoursAcceptHeader
 -- __References__:
 --
 --   * @Cache-Control@ header: <https://tools.ietf.org/html/rfc7234#section-5.2 RFC 7234 Section 5.2>
+--
+-- #SINCE#
 getsHaveCacheControlHeader :: RequestPredicate Text Bool
 getsHaveCacheControlHeader
   = RequestPredicate
@@ -184,6 +187,8 @@ getsHaveCacheControlHeader
 -- | [__Best Practice__]
 --
 -- Like 'getsHaveCacheControlHeader', but for @HEAD@ requests.
+--
+-- #SINCE#
 headsHaveCacheControlHeader :: RequestPredicate Text Bool
 headsHaveCacheControlHeader
   = RequestPredicate
@@ -254,6 +259,8 @@ linkHeadersAreValid
 -- __References__:
 --
 --   * @WWW-Authenticate@ header: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
+--
+-- #SINCE#
 unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool
 unauthorizedContainsWWWAuthenticate
   = ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp ->
@@ -331,6 +338,8 @@ instance JoinPreds (ResponsePredicate Text Bool) where
 -- the existing predicates.
 --
 -- > not500 <%> onlyJsonObjects <%> empty
+--
+-- #SINCE#
 (<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
 (<%>) = joinPreds
 infixr 6 <%>

src/Servant/QuickCheck/Internal/QuickCheck.hs

@@ -7,6 +7,7 @@ import           Network.HTTP.Client      (Manager, Request, checkStatus,
                                            defaultManagerSettings, httpLbs,
                                            newManager)
 import           Network.Wai.Handler.Warp (withApplication)
+import           Prelude.Compat
 import           Servant                  (Context (EmptyContext), HasServer,
                                            Server, serveWithContext)
 import           Servant.Client           (BaseUrl (..), Scheme (..))
@@ -23,12 +24,16 @@ import Servant.QuickCheck.Internal.Equality
 
 -- | Start a servant application on an open port, run the provided function,
 -- then stop the application.
+--
+-- #SINCE#
 withServantServer :: HasServer a '[] => Proxy a -> IO (Server a)
   -> (BaseUrl -> IO r) -> IO r
 withServantServer api = withServantServerAndContext api EmptyContext
 
 -- | Like 'withServantServer', but allows passing in a 'Context' to the
 -- application.
+--
+-- #SINCE#
 withServantServerAndContext :: HasServer a ctx
   => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
 withServantServerAndContext api ctx server t
@@ -46,6 +51,8 @@ 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#
 serversEqual :: HasGenRequest a =>
   Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality LBS.ByteString -> Expectation
 serversEqual api burl1 burl2 args req = do
@@ -78,6 +85,8 @@ serversEqual api burl1 burl2 args req = do
 -- >                                     <%> onlyJsonObjects
 -- >                                     <%> notAllowedContainsAllowHeader
 -- >                                     <%> mempty)
+--
+-- #SINCE#
 serverSatisfies :: (HasGenRequest a) =>
   Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
 serverSatisfies api burl args preds = do