Add property based tests and refactor

Author: eahlberg

package.yaml

@@ -63,7 +63,6 @@ tests:
     dependencies:
       - QuickCheck
       - hspec
-      - hspec-expectations-lifted
       - quickcheck-classes
       - yesod-core
       - yesod-paginator

src/Yesod/Paginator/Widgets.hs

@@ -9,7 +9,7 @@ module Yesod.Paginator.Widgets
     , ellipsedWith
 
     -- * Exported for testing
-    , buildParams
+    , setPageParameters
     ) where
 
 import Yesod.Paginator.Prelude
@@ -180,15 +180,15 @@ getUpdateGetParams
     :: PageParamName -> WidgetFor site (PageNumber -> [(Text, Text)])
 getUpdateGetParams pageParamName = do
     params <- handlerToWidget $ reqGetParams <$> getRequest
-    pure
-        $ \number -> buildParams pageParamName number params
+    pure $ \number -> setPageParameters pageParamName number params
 
 renderGetParams :: [(Text, Text)] -> Text
 renderGetParams [] = ""
 renderGetParams ps = "?" <> T.intercalate "&" (map renderGetParam ps)
     where renderGetParam (k, v) = encodeText k <> "=" <> encodeText v
 
-buildParams :: Show a => PageParamName -> a -> [(Text, Text)] -> [(Text, Text)]
-buildParams pageParamName number params =
-  let name = unPageParamName pageParamName
-  in [(name, tshow number)] <> filter ((/=) name . fst) params
+setPageParameters
+    :: Show a => PageParamName -> a -> [(Text, Text)] -> [(Text, Text)]
+setPageParameters pageParamName number params =
+    let name = unPageParamName pageParamName
+    in [(name, tshow number)] <> filter ((/=) name . fst) params

test/SpecHelper.hs

@@ -10,8 +10,8 @@ module SpecHelper
     , module X
     ) where
 
-import Test.Hspec as X hiding (shouldBe)
-import Test.Hspec.Expectations.Lifted as HspecLifted
+import qualified Data.List as List
+import Test.Hspec as X
 import Yesod.Core
 import Yesod.Paginator as X
 import Yesod.Paginator.Prelude as X
@@ -64,5 +64,20 @@ getEllipsedParamNameR total per elements pageParamName = do
 withApp :: SpecWith (TestApp App) -> Spec
 withApp = before $ pure (App, id)
 
-shouldBe :: (HasCallStack, Eq a, Show a) => a -> a -> YesodExample site ()
-shouldBe a b = a `HspecLifted.shouldBe` b
+shouldIncludeAll
+    :: (Foldable t, Eq a, Show a, Show (t a)) => t a -> [a] -> Expectation
+shouldIncludeAll actual subset = expectTrue msg (all isIncluded subset)
+  where
+    isIncluded = (`elem` actual)
+    msg =
+        show actual
+            <> " did not include all of "
+            <> show subset
+            <> " - missing: "
+            <> List.intercalate
+                   ", "
+                   (fmap show (filter (not . isIncluded) subset))
+
+-- Cloned from 'Test.Hspec.Expectations'
+expectTrue :: HasCallStack => String -> Bool -> Expectation
+expectTrue msg b = unless b (expectationFailure msg)

test/Yesod/Paginator/WidgetsSpec.hs

@@ -1,12 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module Yesod.Paginator.WidgetsSpec
     ( spec
     ) where
 
+import Data.Functor ((<&>))
 import SpecHelper
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
 
 spec :: Spec
-spec = withApp $ do
+spec = integrationSpecs >> setPageParametersSpecs
+
+integrationSpecs :: Spec
+integrationSpecs = withApp $ do
     describe "simple" $ it "works" $ do
         get $ SimpleR 10 3 3
 
@@ -189,22 +196,47 @@ spec = withApp $ do
             , "</ul>"
             ]
 
-    describe "buildParams" $ it "works" $ do
-        let pageParamName = PageParamName "p"
-            pageNumber :: Int
-            pageNumber = 3
-            params :: [(Text, Text)]
-            params =
-                [ ("p", "2")
-                , ("p", "3")
-                , ("foo", "bar")
-                , ("ids[]", "1")
-                , ("ids[]", "2")
-                ]
-
-        buildParams pageParamName pageNumber params
-            `shouldBe` [ ("p", "3")
-                       , ("foo", "bar")
-                       , ("ids[]", "1")
-                       , ("ids[]", "2")
-                       ]
+data Params = Params
+    { paramsPageParamName :: PageParamName
+    , paramsPageNumber :: Int
+    , paramsParams :: [(Text, Text)]
+    }
+    deriving Show
+
+instance Arbitrary Params where
+    arbitrary = do
+        params <- listOf $ liftArbitrary2 genText genText
+        pageNumber <- getPositive <$> arbitrary
+        pageParamName <- PageParamName <$> genText
+        pure $ Params pageParamName pageNumber params
+      where
+        genText :: Gen Text
+        genText = listOf (choose ('a', 'z')) <&> pack
+
+
+setPageParametersSpecs :: Spec
+setPageParametersSpecs = describe "setPageParameters" $ do
+    it "inserts" $ do
+        let paramName = PageParamName "p"
+            pageNumber = 1 :: Int
+        setPageParameters paramName pageNumber [] `shouldBe` [("p", "1")]
+
+    it "updates" $ do
+        let paramName = PageParamName "p"
+            pageNumber = 1 :: Int
+        setPageParameters paramName pageNumber [("p", "foo")]
+            `shouldBe` [("p", "1")]
+
+    prop "doesn't remove not-ours elements" $ do
+        Params paramName pageNumber params <- arbitrary
+        let outputKeys = fst <$> setPageParameters paramName pageNumber params
+            inputKeys = fst <$> params
+        pure $ outputKeys `shouldIncludeAll` inputKeys
+
+    prop "doesn't add not-ours elements" $ do
+        Params paramName pageNumber params <- arbitrary
+        let outputKeys = fst <$> setPageParameters paramName pageNumber params
+            inputKeys = fst <$> params
+        pure
+            $ (unPageParamName paramName : inputKeys)
+            `shouldIncludeAll` outputKeys

yesod-paginator.cabal

@@ -116,7 +116,6 @@ test-suite test
       QuickCheck
     , base <5
     , hspec
-    , hspec-expectations-lifted
     , quickcheck-classes
     , yesod-core
     , yesod-paginator