snap-extras 0.12.1.0 → 0.12.1.1

raw patch · 4 files changed

+112/−2 lines, 4 filesdep ~blaze-htmlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: blaze-html

API changes (from Hackage documentation)

Files

• changelog.md +3/−0
• snap-extras.cabal +5/−2
• test/src/Snap/Extras/Tests/Arbitrary.hs +29/−0
• test/src/Snap/Extras/Tests/MethodOverride.hs +75/−0

@@ -1,3 +1,6 @@+0.12.1.1+* Add missing test suite files to package.+ 0.12.1.0 * Backwards compatibility fixes for versions of base < 4.8. 

@@ -1,5 +1,5 @@ Name:                snap-extras-Version:             0.12.1.0+Version:             0.12.1.1 Synopsis:            A collection of useful helpers and utilities for Snap web applications. Description:         This package contains a collection of helper functions                      that come in handy in most practical, real-world@@ -51,7 +51,7 @@       aeson                    >= 0.6   && < 1.2     , base                     >= 4     && < 5     , blaze-builder            >= 0.3   && < 0.5-    , blaze-html               >= 0.6   && < 0.9+    , blaze-html               >= 0.6   && < 0.10     , bytestring               >= 0.9.1 && < 0.11     , case-insensitive         >= 1.0   && < 1.3     , configurator             >= 0.2   && < 0.4@@ -114,6 +114,9 @@   Main-Is: Main.hs   Ghc-Options: -threaded -rtsopts -O0   Default-Language: Haskell2010+  Other-Modules:+    Snap.Extras.Tests.Arbitrary+    Snap.Extras.Tests.MethodOverride   Hs-Source-Dirs:     test/src   Build-Depends:

@@ -0,0 +1,29 @@+module Snap.Extras.Tests.Arbitrary where++-------------------------------------------------------------------------------+import           Control.Applicative+import           Data.Char+import           Data.ByteString.Char8                  (ByteString, pack)+import           Snap.Core+-------------------------------------------------------------------------------+import           Test.QuickCheck+-------------------------------------------------------------------------------+++instance Arbitrary Method where+  arbitrary = oneof [ pure HEAD+                    , pure POST+                    , pure PUT+                    , pure DELETE+                    , pure TRACE+                    , pure OPTIONS+                    , pure CONNECT+                    , pure PATCH+                    , Method <$> (pack <$> cleanString)+                    ]+    where+      cleanString = do+        NonEmpty s <- arbitrary+        return s++

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+module Snap.Extras.Tests.MethodOverride+    ( methodOverrideTests+    ) where++-------------------------------------------------------------------------------+import           Control.Applicative+import           Data.ByteString             (ByteString)+import qualified Data.ByteString.Char8       as B+import           Data.Char+import qualified Data.Map                    as M+import           Test.QuickCheck+import           Test.QuickCheck.Monadic+import           Test.Tasty+import           Test.Tasty.QuickCheck+-------------------------------------------------------------------------------+import           Snap.Core+import           Snap.Extras.MethodOverride+import           Snap.Extras.Tests.Arbitrary ()+import           Snap.Extras.TextUtils+import           Snap.Test+-------------------------------------------------------------------------------++methodOverrideTests = testGroup "Snap.Extras.MethodOverride"+    [ testProperty "leaves method alone with no override" $ \meth ->+       monadicIO $ assertOverride meth meth Nothing+    , testProperty "leaves non-POST alone even with override" $ \(NonPost meth) override ->+        monadicIO $ assertOverride  meth meth (Just $ showMethod override)+    , testProperty "leaves non-POST alone even with override and lowercased param" $ \(NonPost meth) override ->+        monadicIO $ assertOverride  meth meth (Just $ showDCMethod override)+    , testProperty "overrides POST" $ \meth ->+        monadicIO $ assertOverride meth POST (Just $ showMethod meth)+    , testProperty "overrides POST with lowercased method" $ \meth ->+         monadicIO $ assertOverride (lowerMeth meth) POST (Just $ showDCMethod meth)+    ]+++-------------------------------------------------------------------------------+newtype NonPost = NonPost Method deriving (Show)++instance Arbitrary NonPost where+  arbitrary = NonPost <$> (arbitrary `suchThat` notPost)+    where+      notPost (POST) = False+      notPost _ = True++-------------------------------------------------------------------------------+showDCMethod = B.map toLower . showMethod++-------------------------------------------------------------------------------+showMethod :: Method -> ByteString+showMethod (Method m) = m+showMethod m          = showBS m+++-------------------------------------------------------------------------------+lowerMeth (Method m) = Method (B.map toLower m)+lowerMeth m          = m+++-------------------------------------------------------------------------------+assertOverride expectedMeth givenMeth override = do+    actualMeth <- run $ evalHandler builder app+    assert $ expectedMeth == actualMeth+  where+    builder = do+      setRequestType $ RequestWithRawBody givenMeth ""+      case override of+        Just m -> setQueryString $ M.singleton "_method" [m]+        _      -> return ()+++-------------------------------------------------------------------------------+app = handleMethodOverride (getsRequest rqMethod)+