genvalidity-text 0.1.0.1 → 1.0.0.1
raw patch · 7 files changed
Files
- CHANGELOG.md +51/−0
- LICENSE +1/−1
- Setup.hs +0/−2
- bench/Main.hs +31/−0
- genvalidity-text.cabal +69/−44
- src/Data/GenValidity/Text.hs +74/−46
- test/Data/GenValidity/TextSpec.hs +95/−45
+ CHANGELOG.md view
@@ -0,0 +1,51 @@+# Changelog++## [1.0.0.0] - 2021-11-20++### Changed++* Compatibility with `genvalidity >= 1.0.0.0`++## [0.7.0.2] - 2020-02-10++## Changed++* Improved the cabal file++## [0.7.0.1] - 2019-12-05++## Changed++* Optimised the 'GenValid Text' instance to be 5x faster.++## Added++* `genText` with the new approach.+* `genTextBy` with the new approach where you can supply your own `Gen Char`.+++## [0.7.0.0] - 2019-06-26++## Changed++* Updated the 'GenValid Text' instance to use 'genValid :: Gen Char' instead of 'arbitrary :: Gen Char'.++## [0.6.0.0] - 2019-03-06++### Changed++* Removed the 'GenUnchecked' and 'GenInvalid' instance for Text.+* Poisoned those two instances as well.+* Removed an 'upTo' from the implementation of 'GenValid Text'.+ It should generate better sized Text now.++## [0.5.1.0] - 2018-08-25++### Added++* A `GenUnchecked`, `GenValid` and `GenInvalid` instance for lazy text++## Older versions++No history before version 0.5.1.0+
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Criterion.Main as Criterion+import Data.GenValidity+import Data.GenValidity.Criterion+import Data.GenValidity.Text+import Data.Text as Strict+import Data.Text.Lazy as Lazy+import Test.QuickCheck++main :: IO ()+main =+ Criterion.defaultMain+ [ bgroup+ "Instances"+ [ genBenchSizes "Strict.Text" (genValid @Strict.Text),+ genBenchSizes "Lazy.Text" (genValid @Lazy.Text)+ ],+ bgroup+ "Approaches"+ [ genBenchSizes "via list (old version)" $ Strict.pack <$> genValid,+ genBenchSizes "genText" genText,+ genBenchSizes "genTextBy genValid" $ genTextBy genValid,+ genBenchSizes "genTextBy (choose (minBound, maxBound)) (currently in use)" $+ genTextBy (choose (minBound, maxBound))+ ]+ ]
genvalidity-text.cabal view
@@ -1,55 +1,80 @@-name: genvalidity-text-version: 0.1.0.1-synopsis: GenValidity support for Text-description: Please see README.md-homepage: https://github.com/NorfairKing/validity#readme-license: MIT-license-file: LICENSE-author: Tom Sydney Kerckhove-maintainer: syd.kerckhove@gmail.com-copyright: Copyright: (c) 2016 Tom Sydney Kerckhove-category: Testing-build-type: Simple-cabal-version: >=1.10+cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.34.6.+--+-- see: https://github.com/sol/hpack++name: genvalidity-text+version: 1.0.0.1+synopsis: GenValidity support for Text+category: Testing+homepage: https://github.com/NorfairKing/validity#readme+bug-reports: https://github.com/NorfairKing/validity/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright: (c) 2016-2022 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ LICENSE+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/NorfairKing/validity+ library- hs-source-dirs: src- exposed-modules: Data.GenValidity.Text- build-depends: base < 5- , validity- , validity-text- , genvalidity- , text- , array- , QuickCheck- default-language: Haskell2010+ exposed-modules:+ Data.GenValidity.Text+ other-modules:+ Paths_genvalidity_text+ hs-source-dirs:+ src+ build-depends:+ QuickCheck+ , array+ , base >=4.7 && <5+ , genvalidity >=1.0+ , random+ , text+ , validity >=0.5+ , validity-text >=0.3+ default-language: Haskell2010 test-suite genvalidity-text-test- type:- exitcode-stdio-1.0- default-language:- Haskell2010- hs-source-dirs:- test- main-is:- Spec.hs+ type: exitcode-stdio-1.0+ main-is: Spec.hs other-modules:- Data.GenValidity.TextSpec- ghc-options:- -threaded -rtsopts -with-rtsopts=-N- -Wall- -fno-warn-name-shadowing+ Data.GenValidity.TextSpec+ Paths_genvalidity_text+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends:- base-+ QuickCheck+ , base >=4.7 && <5+ , genvalidity+ , genvalidity-hspec+ , genvalidity-text , hspec- , QuickCheck >= 2.8 && < 2.9+ , text+ default-language: Haskell2010 +benchmark genvalidity-text-bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_genvalidity_text+ hs-source-dirs:+ bench/+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , criterion , genvalidity+ , genvalidity-criterion , genvalidity-text , text---source-repository head- type: git- location: https://github.com/NorfairKing/validity+ default-language: Haskell2010
src/Data/GenValidity/Text.hs view
@@ -1,63 +1,91 @@-module Data.GenValidity.Text where--import Data.GenValidity-import Data.Validity.Text ()+{-# OPTIONS_GHC -fno-warn-orphans #-} -import Test.QuickCheck+module Data.GenValidity.Text where -import Control.Monad+import Data.GenValidity+import qualified Data.Text as ST+import qualified Data.Text.Internal.Lazy as LT+import qualified Data.Text.Lazy as LT+import Data.Validity.Text ()+import System.Random as Random+import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Random -import qualified Data.Text.Array as A-import Data.Text.Internal (Text(..))-import qualified Data.Text as T+instance GenValid ST.Text where+ genValid = genText+ shrinkValid = fmap ST.pack . shrinkValid . ST.unpack +genText :: Gen ST.Text+genText = do+ len <- genListLength+ MkGen $ \qcgen _ -> ST.unfoldrN len (pure . random) qcgen -instance GenValidity Text where- genUnchecked = Text <$> uncheckedArray <*> arbitrary <*> arbitrary- where- uncheckedArray = sized $ \n -> do- size <- upTo n- ins <- replicateM size arbitrary- return $ A.run $ do- arr <- A.new size- forM_ (zip [0..] ins) $ uncurry $ A.unsafeWrite arr- return arr+genTextBy :: Gen Char -> Gen ST.Text+genTextBy (MkGen charFunc) = do+ len <- genListLength+ MkGen $ \qcgen size ->+ let go :: QCGen -> Maybe (Char, QCGen)+ go qcg =+ let (qc1, qc2) = Random.split qcg+ in Just (charFunc qc1 size, qc2)+ in ST.unfoldrN len go qcgen - genValid = sized $ \n -> do- size <- upTo n- chars <- resize size $ genListOf arbitrary- return $ T.pack chars+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+ shrinkValid = fmap LT.fromChunks . shrinkValid . LT.toChunks -textStartingWith :: Char -> Gen Text-textStartingWith c = sized $ \n ->+-- | 'textStartingWith c' generates a 'Text' value that starts with 'c'.+textStartingWith :: Char -> Gen ST.Text+textStartingWith c =+ sized $ \n -> case n of- 0 -> pure $ T.singleton c- 1 -> pure $ T.singleton c- _ -> do- rest <- resize (n - 1) genValid- return $ T.cons c rest+ 0 -> pure $ ST.singleton c+ 1 -> pure $ ST.singleton c+ _ -> ST.cons c <$> resize (n - 1) genValid -textWith :: Gen Text -> Gen Text-textWith gen = sized $ \n -> do+-- | 'textStartingWith g' generates a 'Text' value that contains a substring generated by 'g'.+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]--textWithA :: Char -> Gen Text-textWithA c = textWith $ T.singleton <$> pure c--textWithoutAny :: Char -> Gen Text-textWithoutAny c = textWithoutAnyOf [c]--textWithoutAnyOf :: String -> Gen Text-textWithoutAnyOf cs = T.pack <$> genListOf (arbitrary `suchThat` (`notElem` cs))--textAllCaps :: Gen Text-textAllCaps = T.toUpper <$> genValid+ after <- resize a genValid+ return $ ST.concat [before, middle, after] +-- | 'textStartingWith c' generates a 'Text' value that contains a '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 ST.Text+textWithoutAny c = doubleCheck $ genTextBy $ genValid `suchThat` predicate+ where+ doubleCheck = (`suchThat` (ST.all predicate))+ predicate = (/= c) +-- | 'textWithoutAnyOf c' generates a 'Text' value that does not contain any character in 'ls'.+textWithoutAnyOf :: String -> Gen ST.Text+textWithoutAnyOf cs = doubleCheck $ genTextBy (genValid `suchThat` predicate)+ where+ doubleCheck = (`suchThat` (ST.all predicate))+ predicate = (`notElem` cs) +-- | 'textAllCaps' generates a 'Text' value with only upper-case characters.+textAllCaps :: Gen ST.Text+textAllCaps = ST.toUpper <$> genValid +-- | 'genSingleLineText' generates a single-line text, that is without any line separators.+--+-- See 'Data.GenValidity.genNonLineSeparator' and 'Data.Validity.isLineSeparator'+genSingleLineText :: Gen ST.Text+genSingleLineText = genTextBy genNonLineSeparator
test/Data/GenValidity/TextSpec.hs view
@@ -1,55 +1,105 @@-module Data.GenValidity.TextSpec (spec) where+{-# LANGUAGE TypeApplications #-} -import Test.Hspec-import Test.QuickCheck+module Data.GenValidity.TextSpec+ ( spec,+ )+where -import Data.GenValidity-import Data.GenValidity.Text+import Control.Monad+import Data.GenValidity.Text+import Data.List+import qualified Data.Text as ST+import qualified Data.Text.Array as A+import qualified Data.Text.Internal as ST+import qualified Data.Text.Internal.Lazy as LT+import qualified Data.Text.Lazy as LT+import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Text.Printf -import qualified Data.Text as T+showTextDebug :: ST.Text -> String+showTextDebug (ST.Text arr off len) =+ unlines+ [ unwords+ [ "arr: ",+ intercalate "," $+ map (printf "%4d") $ A.toList arr off len+ ],+ unwords+ [ "hexarr:",+ intercalate "," $+ map (printf "%4x") $ A.toList arr off len+ ],+ unwords ["off: ", show off],+ 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 "Strict Text" $ do+ genValidSpec @ST.Text describe "genValid" $ do- it "is always empty when resized to 0" $ do- forAll (resize 0 genValid) (`shouldSatisfy` T.null)-+ 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 "textStartingWith" $ do- it "is never empty" $ do- forAll arbitrary $ \c ->- forAll (textStartingWith c) $ \t ->- t `shouldNotSatisfy` T.null-- it "contains exactly the first character if resized to 0" $ do- forAll arbitrary $ \c ->- forAll (resize 0 $ textStartingWith c) $ \t ->- t `shouldBe` T.pack [c]-- it "contains exactly the first character if resized to 1" $ do- forAll arbitrary $ \c ->- forAll (resize 0 $ textStartingWith c) $ \t ->- t `shouldBe` T.pack [c]-- it "always starts with the given char" $ do- forAll arbitrary $ \c ->- forAll (textStartingWith c) $ \t ->- T.head t `shouldBe` c-- describe "textWithA" $ do- it "contains the given character" $ do- forAll arbitrary $ \c ->- forAll (textWithA c) $ \t ->- T.unpack t `shouldSatisfy` (elem c)-+ 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 (textWithA c) $ \t -> ST.unpack t `shouldSatisfy` elem c describe "textWithoutAny" $ do- it "never contains the given char" $ do- forAll arbitrary $ \c ->- forAll (textWithoutAny c) $ \t ->- T.unpack t `shouldNotSatisfy` (elem c)-+ it "works with \65533" $+ let c = '\65533'+ in forAll (textWithoutAny c) $ \t ->+ ST.unpack t `shouldNotSatisfy` elem c+ it "never contains the given char" $+ forAllShrink arbitrary shrink $ \c ->+ forAll (textWithoutAny c) $ \t ->+ ST.unpack t `shouldNotSatisfy` elem c describe "textWithoutAnyOf" $ do- it "never contains any of the given chars" $ do- forAll arbitrary $ \cs ->- forAll (textWithoutAnyOf cs) $ \t ->- T.unpack t `shouldNotSatisfy` (\t -> any (`elem` t) cs)-+ it "works with \65533" $+ let cs = "\65533"+ in forAll (textWithoutAnyOf cs) $ \text ->+ ST.unpack text `shouldNotSatisfy` (\t -> any (`elem` t) cs)+ it "never contains any of the given chars" $+ forAllShrink arbitrary shrink $ \cs ->+ forAll (textWithoutAnyOf cs) $ \text ->+ ST.unpack text `shouldNotSatisfy` (\t -> any (`elem` t) cs)+ describe "Lazy Text" $ do+ genValidSpec @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