genvalidity-text 0.5.0.2 → 0.5.1.0

raw patch · 3 files changed

+133/−81 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• genvalidity-text.cabal +12/−11
• src/Data/GenValidity/Text.hs +51/−22
• test/Data/GenValidity/TextSpec.hs +70/−48

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: >= 1.10++-- This file has been generated from package.yaml by hpack version 0.29.6. -- -- see: https://github.com/sol/hpack ----- hash: b2736c8f08d545f919f3113a9d909d562daf368e62f0a7fb3a3d0332e596adc2+-- hash: 0b74a2109a1d1a01ef347a56e9eb34ceafe87cdd703a165cc25c976325210d43  name:           genvalidity-text-version:        0.5.0.2+version:        0.5.1.0 synopsis:       GenValidity support for Text description:    Please see README.md category:       Testing@@ -18,13 +20,16 @@ license:        MIT license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10  source-repository head   type: git   location: https://github.com/NorfairKing/validity  library+  exposed-modules:+      Data.GenValidity.Text+  other-modules:+      Paths_genvalidity_text   hs-source-dirs:       src   build-depends:@@ -35,15 +40,14 @@     , text     , validity >=0.5     , validity-text >=0.3-  exposed-modules:-      Data.GenValidity.Text-  other-modules:-      Paths_genvalidity_text   default-language: Haskell2010  test-suite genvalidity-text-test   type: exitcode-stdio-1.0   main-is: Spec.hs+  other-modules:+      Data.GenValidity.TextSpec+      Paths_genvalidity_text   hs-source-dirs:       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing@@ -55,7 +59,4 @@     , genvalidity-text     , hspec     , text-  other-modules:-      Data.GenValidity.TextSpec-      Paths_genvalidity_text   default-language: Haskell2010

@@ -10,14 +10,15 @@  import Control.Monad #if !MIN_VERSION_base(4,8,0)-import Control.Applicative (pure)+import Control.Applicative ((<*>), pure) import Data.Functor ((<$>)) #endif-import qualified Data.Text as T+import qualified Data.Text as ST import qualified Data.Text.Array as A-import Data.Text.Internal (Text(..))+import qualified Data.Text.Internal as ST+import qualified Data.Text.Internal.Lazy as LT -instance GenUnchecked Text where+instance GenUnchecked ST.Text where     genUnchecked =         sized $ \n -> do             size <- upTo n@@ -30,50 +31,78 @@                            return arr             off <- upTo $ max 0 (size - 1)             let len = size - off-            pure $ Text arr off len+            pure $ ST.Text arr off len     shrinkUnchecked _ = [] -instance GenValid Text where+instance GenValid ST.Text where     genValid =         sized $ \n -> do             size <- upTo n             chars <- resize size $ genListOf arbitrary-            return $ T.pack chars-    shrinkValid = fmap T.pack . shrinkValid . T.unpack+            return $ ST.pack chars+    shrinkValid = fmap ST.pack . shrinkValid . ST.unpack -instance GenInvalid Text+instance GenInvalid ST.Text +instance GenUnchecked LT.Text where+    genUnchecked =+        sized $ \n ->+            case n of+                0 -> pure LT.Empty+                _ -> do+                    (a, b) <- genSplit n+                    st <- resize a genUnchecked+                    lt <- resize b genUnchecked+                    pure $ LT.Chunk st lt+    shrinkUnchecked LT.Empty = []+    shrinkUnchecked (LT.Chunk st lt) =+        [LT.Chunk st' lt' | (st', lt') <- shrinkUnchecked (st, lt)]++instance GenValid LT.Text where+    genValid =+        sized $ \n ->+            case n of+                0 -> pure LT.Empty+                _ -> do+                    (a, b) <- genSplit n+                    st <- ST.cons <$> genValid <*> resize a genValid+                    lt <- resize b genValid+                    pure $ LT.Chunk st lt++instance GenInvalid LT.Text+ -- | 'textStartingWith c' generates a 'Text' value that starts with 'c'.-textStartingWith :: Char -> Gen Text+textStartingWith :: Char -> Gen ST.Text textStartingWith c =     sized $ \n ->         case n of-            0 -> pure $ T.singleton c-            1 -> pure $ T.singleton c-            _ -> T.cons c <$> resize (n - 1) genValid+            0 -> pure $ ST.singleton c+            1 -> pure $ ST.singleton c+            _ -> ST.cons c <$> resize (n - 1) genValid  -- | 'textStartingWith g' generates a 'Text' value that contains a substring generated by 'g'.-textWith :: Gen Text -> Gen Text+textWith :: Gen ST.Text -> Gen ST.Text textWith gen =     sized $ \n -> do         (b, m, a) <- genSplit3 n         before <- resize b genValid         middle <- resize m gen         after <- resize a genValid-        return $ T.concat [before, middle, after]+        return $ ST.concat [before, middle, after]  -- | 'textStartingWith c' generates a 'Text' value that contains a 'c'.-textWithA :: Char -> Gen Text-textWithA c = textWith $ T.singleton <$> pure c+textWithA :: Char -> Gen ST.Text+textWithA c = textWith $ ST.singleton <$> pure c  -- | 'textWithoutAny c' generates a 'Text' value that does not contain any 'c'.-textWithoutAny :: Char -> Gen Text+textWithoutAny :: Char -> Gen ST.Text textWithoutAny c = textWithoutAnyOf [c]  -- | 'textWithoutAnyOf c' generates a 'Text' value that does not contain any character in 'ls'.-textWithoutAnyOf :: String -> Gen Text-textWithoutAnyOf cs = T.pack <$> genListOf (arbitrary `suchThat` (`notElem` cs))+textWithoutAnyOf :: String -> Gen ST.Text+textWithoutAnyOf cs =+    ST.pack <$> genListOf (arbitrary `suchThat` (`notElem` cs))  -- | 'textAllCaps' generates a 'Text' value with only upper-case characters.-textAllCaps :: Gen Text-textAllCaps = T.toUpper <$> genValid+textAllCaps :: Gen ST.Text+textAllCaps = ST.toUpper <$> genValid

@@ -5,26 +5,26 @@     ) where  import Control.Monad-import Data.Either import Data.List import Data.Word import Text.Printf  import Test.Hspec import Test.QuickCheck+import Test.Validity -import Data.GenValidity import Data.GenValidity.Text -import qualified Data.Text as T+import qualified Data.Text as ST import qualified Data.Text.Array as A-import Data.Text.Internal (Text(Text))+import qualified Data.Text.Internal as ST+import qualified Data.Text.Internal.Lazy as LT+import qualified Data.Text.Lazy as LT -showTextDebug :: Text -> String-showTextDebug t@(Text arr off len) =+showTextDebug :: ST.Text -> String+showTextDebug (ST.Text arr off len) =     unlines-        [ unwords [show t, "is invalid"]-        , unwords+        [ unwords               [ "arr:   "               , intercalate "," $                 map (printf "%4d" :: Word16 -> String) $ A.toList arr off len@@ -38,48 +38,70 @@         , unwords ["len:      ", show len]         ] +showLazyTextDebug :: LT.Text -> String+showLazyTextDebug LT.Empty = "empty"+showLazyTextDebug (LT.Chunk st lt) =+    unlines+        [ "A chuck with this strict text:"+        , showTextDebug st+        , "and this rest of the lazy text:"+        , showLazyTextDebug lt, ""+        ]+ spec :: Spec spec = do-    describe "genValid" $ do-        it "is always empty when resized to 0" $-            forAll (resize 0 genValid) (`shouldSatisfy` T.null)-        it "generates valid text" $-            forAll (genValid :: Gen Text) $ \t ->+    describe "Strict Text" $ do+        genValiditySpec @ST.Text+        describe "genValid" $ do+            it "is always empty when resized to 0" $+                forAll (resize 0 genValid) (`shouldSatisfy` ST.null)+            it "generates valid text" $+                forAll (genValid) $ \t ->+                    unless (isValid t) $ expectationFailure $ showTextDebug t+        describe "genUnchecked `suchThat` isValid" $+            it "generates valid text" $+            forAll ((genUnchecked :: Gen ST.Text) `suchThat` isValid) $ \t ->                 unless (isValid t) $ expectationFailure $ showTextDebug t-    describe "genUnchecked `suchThat` isValid" $-        it "generates valid text" $-        forAll ((genUnchecked :: Gen Text) `suchThat` isValid) $ \t ->-            unless (isValid t) $ expectationFailure $ showTextDebug t-    describe "textStartingWith" $ do-        it "is never empty" $-            forAll arbitrary $ \c ->-                forAll (textStartingWith c) $ \t -> t `shouldNotSatisfy` T.null-        it "contains exactly the first character if resized to 0" $-            forAll arbitrary $ \c ->-                forAll (resize 0 $ textStartingWith c) $ \t ->-                    t `shouldBe` T.pack [c]-        it "contains exactly the first character if resized to 1" $+        describe "textStartingWith" $ do+            it "is never empty" $+                forAll arbitrary $ \c ->+                    forAll (textStartingWith c) $ \t ->+                        t `shouldNotSatisfy` ST.null+            it "contains exactly the first character if resized to 0" $+                forAll arbitrary $ \c ->+                    forAll (resize 0 $ textStartingWith c) $ \t ->+                        t `shouldBe` ST.pack [c]+            it "contains exactly the first character if resized to 1" $+                forAll arbitrary $ \c ->+                    forAll (resize 0 $ textStartingWith c) $ \t ->+                        t `shouldBe` ST.pack [c]+            it "always starts with the given char" $+                forAll arbitrary $ \c ->+                    forAll (textStartingWith c) $ \t -> ST.head t `shouldBe` c+        describe "textWithA" $+            it "contains the given character" $             forAll arbitrary $ \c ->-                forAll (resize 0 $ textStartingWith c) $ \t ->-                    t `shouldBe` T.pack [c]-        it "always starts with the given char" $+                forAll (textWithA c) $ \t -> ST.unpack t `shouldSatisfy` elem c+        describe "textWithoutAny" $+            it "never contains the given char" $             forAll arbitrary $ \c ->-                forAll (textStartingWith c) $ \t -> T.head t `shouldBe` c-    describe "textWithA" $-        it "contains the given character" $-        forAll arbitrary $ \c ->-            forAll (textWithA c) $ \t -> T.unpack t `shouldSatisfy` elem c-    describe "textWithoutAny" $-        it "never contains the given char" $-        forAll arbitrary $ \c ->-            forAll (textWithoutAny c) $ \t ->-                T.unpack t `shouldNotSatisfy` elem c-    describe "textWithoutAnyOf" $-        it "never contains any of the given chars" $-        forAll arbitrary $ \cs ->-            forAll (textWithoutAnyOf cs) $ \text ->-                T.unpack text `shouldNotSatisfy` (\t -> any (`elem` t) cs)-    describe "isValid" $-        it "equals isRight . checkValidity" $-        forAll (genUnchecked @Text) $ \t ->-            isValid t `shouldBe` isRight (checkValidity t)+                forAll (textWithoutAny c) $ \t ->+                    ST.unpack t `shouldNotSatisfy` elem c+        describe "textWithoutAnyOf" $+            it "never contains any of the given chars" $+            forAll arbitrary $ \cs ->+                forAll (textWithoutAnyOf cs) $ \text ->+                    ST.unpack text `shouldNotSatisfy` (\t -> any (`elem` t) cs)+    describe "Lazy Text" $ do+        genValiditySpec @LT.Text+        describe "genValid" $ do+            it "is always empty when resized to 0" $+                forAll (resize 0 genValid) (`shouldSatisfy` LT.null)+            it "generates valid text" $+                forAll (genValid) $ \t ->+                    unless (isValid t) $+                    expectationFailure $ showLazyTextDebug t+        describe "genUnchecked `suchThat` isValid" $+            it "generates valid text" $+            forAll ((genUnchecked :: Gen LT.Text) `suchThat` isValid) $ \t ->+                unless (isValid t) $ expectationFailure $ showLazyTextDebug t