packages feed

genvalidity-containers 0.3.0.0 → 0.4.0.0

raw patch · 8 files changed

+231/−85 lines, 8 filesdep ~genvaliditydep ~hspecdep ~validity

Dependency ranges changed: genvalidity, hspec, validity, validity-containers

Files

genvalidity-containers.cabal view
@@ -1,51 +1,65 @@-name: genvalidity-containers-version: 0.3.0.0-cabal-version: >=1.10-build-type: Simple-license: MIT-license-file: LICENSE-copyright: Copyright: (c) 2016 Tom Sydney Kerckhove-maintainer: syd.kerckhove@gmail.com-homepage: https://github.com/NorfairKing/validity#readme-synopsis: GenValidity support for containers-description:-    Please see README.md-category: Testing-author: Tom Sydney Kerckhove+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 143287ecedc6ddeca013e1cc564f9ed2655bf6504d012fc64033bef8219a778b +name:           genvalidity-containers+version:        0.4.0.0+synopsis:       GenValidity support for containers+description:    Please see README.md+category:       Testing+homepage:       https://github.com/NorfairKing/validity#readme+bug-reports:    https://github.com/NorfairKing/validity/issues+author:         Tom Sydney Kerckhove+maintainer:     syd.kerckhove@gmail.com+copyright:      Copyright: (c) 2016-2018 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+ source-repository head-    type: git-    location: https://github.com/NorfairKing/validity+  type: git+  location: https://github.com/NorfairKing/validity  library-    exposed-modules:-        Data.GenValidity.Containers-        Data.GenValidity.Map-        Data.GenValidity.Tree-        Data.GenValidity.Sequence-        Data.GenValidity.Set-    build-depends:-        base <5,-        QuickCheck -any,-        containers -any,-        genvalidity >=0.4 && <0.5,-        validity >=0.4 && <0.5,-        validity-containers >=0.2 && <0.3-    default-language: Haskell2010-    hs-source-dirs: src+  hs-source-dirs:+      src+  build-depends:+      QuickCheck+    , base <5+    , containers+    , genvalidity >=0.5 && <0.6+    , validity >=0.5 && <0.6+    , validity-containers >=0.3 && <0.4+  exposed-modules:+      Data.GenValidity.Containers+      Data.GenValidity.Map+      Data.GenValidity.Sequence+      Data.GenValidity.Set+      Data.GenValidity.Tree+  other-modules:+      Paths_genvalidity_containers+  default-language: Haskell2010  test-suite genvalidity-containers-test-    type: exitcode-stdio-1.0-    main-is: Spec.hs-    build-depends:-        base >=4.9 && <=5,-        containers -any,-        genvalidity -any,-        genvalidity-containers -any,-        genvalidity-hspec -any,-        hspec >=2.2 && <2.5-    default-language: Haskell2010-    hs-source-dirs: test/-    other-modules:-        Test.Validity.ContainersSpec-    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      base >=4.9 && <=5+    , containers+    , genvalidity+    , genvalidity-containers+    , genvalidity-hspec+    , hspec+  other-modules:+      Test.Validity.Containers.MapSpec+      Test.Validity.Containers.SeqSpec+      Test.Validity.Containers.SetSpec+      Test.Validity.Containers.TreeSpec+      Paths_genvalidity_containers+  default-language: Haskell2010
src/Data/GenValidity/Map.hs view
@@ -1,7 +1,10 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module Data.GenValidity.Map where+module Data.GenValidity.Map+    ( genStructurallyValidMapOf+    , genStructurallyValidMapOfInvalidValues+    ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative (pure) import Data.Functor ((<$>))@@ -12,23 +15,68 @@  import Data.Map (Map) import qualified Data.Map as M+import qualified Data.Map.Internal as Internal  instance (Ord k, GenUnchecked k, GenUnchecked v) => GenUnchecked (Map k v) where-    genUnchecked = M.fromList <$> genUnchecked-    shrinkUnchecked = fmap M.fromList . shrinkUnchecked . M.toList+    genUnchecked =+        sized $ \n ->+            case n of+                0 -> pure Internal.Tip+                _ -> do+                    (a, b, c, d, e) <- genSplit5 n+                    Internal.Bin <$> resize a genUnchecked <*>+                        resize b genUnchecked <*>+                        resize c genUnchecked <*>+                        resize d genUnchecked <*>+                        resize e genUnchecked+    shrinkUnchecked Internal.Tip = []+    shrinkUnchecked (Internal.Bin s k a m1 m2) =+        Internal.Tip :+        [m1, m2] +++        [ Internal.Bin s' k' a' m1' m2'+        | (s', k', a', m1', m2') <- shrinkUnchecked (s, k, a, m1, m2)+        ]  instance (Ord k, GenValid k, GenValid v) => GenValid (Map k v) where     genValid = M.fromList <$> genValid  instance (Ord k, GenInvalid k, GenInvalid v) => GenInvalid (Map k v) where     genInvalid =-        sized $ \n -> do-            (k, v, m) <- genSplit3 n-            let go g1 g2 = do-                    key <- resize k g1-                    val <- resize v g2-                    rest <- resize m genUnchecked-                    pure $ M.insert key val rest-            oneof [go genInvalid genUnchecked, go genUnchecked genInvalid]-    -- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Map documentation:-    -- ' If the list contains more than one value for the same key, the last value for the key is retained.'+        oneof+            [genStructurallyValidMapOfInvalidValues, genStructurallyInvalidMap]++genStructurallyValidMapOf :: Ord k => Gen (k, v) -> Gen (Map k v)+genStructurallyValidMapOf g =+    sized $ \n ->+        case n of+            0 -> pure M.empty+            _ -> do+                (kv, m) <- genSplit n+                (key, val) <- resize kv g+                rest <- resize m $ genStructurallyValidMapOf g+                pure $ M.insert key val rest++-- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Map documentation:+-- ' If the list contains more than one value for the same key, the last value for the key is retained.'+genStructurallyValidMapOfInvalidValues ::+       (Ord k, GenInvalid k, GenInvalid v) => Gen (Map k v)+genStructurallyValidMapOfInvalidValues =+    sized $ \n -> do+        (k, v, m) <- genSplit3 n+        let go g1 g2 = do+                key <- resize k g1+                val <- resize v g2+                rest <-+                    resize m $+                    genStructurallyValidMapOf $+                    (,) <$> genUnchecked <*> genUnchecked+                pure $ M.insert key val rest+        oneof [go genInvalid genUnchecked, go genUnchecked genInvalid]++genStructurallyInvalidMap ::+       (Ord k, GenUnchecked k, GenUnchecked v) => Gen (Map k v)+genStructurallyInvalidMap = do+    v <- genUnchecked+    if M.valid v+        then scale (+ 1) genUnchecked+        else pure v
src/Data/GenValidity/Set.hs view
@@ -1,22 +1,73 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module Data.GenValidity.Set where+module Data.GenValidity.Set+    ( genStructurallyValidSetOf+    , genStructurallyValidSetOfInvalidValues+    , genStructurallyInvalidSet+    ) where #if !MIN_VERSION_base(4,8,0) import Data.Functor ((<$>)) #endif import Data.GenValidity import Data.Validity.Set ()+import Test.QuickCheck  import Data.Set (Set) import qualified Data.Set as S+import qualified Data.Set.Internal as Internal  instance (Ord v, GenUnchecked v) => GenUnchecked (Set v) where-    genUnchecked = S.fromList <$> genUnchecked-    shrinkUnchecked = fmap S.fromList . shrinkUnchecked . S.toList+    genUnchecked =+        sized $ \n ->+            case n of+                0 -> pure Internal.Tip+                _ -> do+                    (a, b, c, d) <- genSplit4 n+                    Internal.Bin <$> resize a genUnchecked <*>+                        resize b genUnchecked <*>+                        resize c genUnchecked <*>+                        resize d genUnchecked+    shrinkUnchecked Internal.Tip = []+    shrinkUnchecked (Internal.Bin s a s1 s2) =+        Internal.Tip :+        [s1, s2] +++        [ Internal.Bin s' a' s1' s2'+        | (s', a', s1', s2') <- shrinkUnchecked (s, a, s1, s2)+        ]  instance (Ord v, GenValid v) => GenValid (Set v) where     genValid = S.fromList <$> genValid  instance (Ord v, GenInvalid v) => GenInvalid (Set v) where-    genInvalid = S.fromList <$> genInvalid+    genInvalid =+        oneof+            [genStructurallyValidSetOfInvalidValues, genStructurallyInvalidSet]++genStructurallyValidSetOf :: Ord v => Gen v -> Gen (Set v)+genStructurallyValidSetOf g =+    sized $ \n ->+        case n of+            0 -> pure S.empty+            _ -> do+                (v, m) <- genSplit n+                val <- resize v g+                rest <- resize m $ genStructurallyValidSetOf g+                pure $ S.insert val rest++-- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Set documentation:+-- ' If the list contains more than one value for the same key, the last value for the key is retained.'+genStructurallyValidSetOfInvalidValues :: (Ord v, GenInvalid v) => Gen (Set v)+genStructurallyValidSetOfInvalidValues =+    sized $ \n -> do+        (v, m) <- genSplit n+        val <- resize v genInvalid+        rest <- resize m $ genStructurallyValidSetOf genUnchecked+        pure $ S.insert val rest++genStructurallyInvalidSet :: (Ord v, GenUnchecked v) => Gen (Set v)+genStructurallyInvalidSet = do+    v <- genUnchecked+    if S.valid v+        then scale (+ 1) genUnchecked+        else pure v
+ test/Test/Validity/Containers/MapSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.Containers.MapSpec where++import Test.Hspec++import Data.GenValidity.Map ()+import Data.Map (Map)+import Test.Validity.GenValidity++spec :: Spec+spec = do+    genValidSpec @(Map Int Double)+    genValiditySpec @(Map Double Double)
+ test/Test/Validity/Containers/SeqSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.Containers.SeqSpec where++import Test.Hspec++import Data.GenValidity.Sequence ()+import Data.Sequence (Seq)+import Test.Validity.GenValidity++spec :: Spec+spec = do+    genValidSpec @(Seq Int)+    genValiditySpec @(Seq Double)
+ test/Test/Validity/Containers/SetSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.Containers.SetSpec where++import Test.Hspec++import Data.GenValidity.Set ()+import Data.Set (Set)+import Test.Validity.GenValidity++spec :: Spec+spec = do+    genValidSpec @(Set Int)+    genValiditySpec @(Set Double)
+ test/Test/Validity/Containers/TreeSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.Containers.TreeSpec where++import Test.Hspec++import Data.GenValidity.Tree ()+import Data.Tree (Tree)+import Test.Validity.GenValidity++spec :: Spec+spec = do+    genValidSpec @(Tree Int)+    genValiditySpec @(Tree Double)
− test/Test/Validity/ContainersSpec.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE TypeApplications #-}--module Test.Validity.ContainersSpec where--import Test.Hspec--import Data.GenValidity.Containers ()-import Data.Map (Map)-import Data.Sequence (Seq)-import Data.Set (Set)-import Data.Tree (Tree)-import Test.Validity.GenValidity--spec :: Spec-spec = do-    genValidSpec @(Set Int)-    genValiditySpec @(Set Double)-    genValidSpec @(Map Int Double)-    genValiditySpec @(Map Double Double)-    genValidSpec @(Tree Int)-    genValiditySpec @(Tree Double)-    genValidSpec @(Seq Int)-    genValiditySpec @(Seq Double)