genvalidity-text 0.6.0.0 → 0.7.0.1
raw patch · 3 files changed
+101/−36 lines, 3 filesdep +criteriondep +genvalidity-criteriondep +randomdep ~basedep ~genvalidity
Dependencies added: criterion, genvalidity-criterion, random
Dependency ranges changed: base, genvalidity
Files
- bench/Main.hs +32/−0
- genvalidity-text.cabal +23/−4
- src/Data/GenValidity/Text.hs +46/−32
+ bench/Main.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Data.Text as Strict+import Data.Text.Lazy as Lazy++import Criterion.Main as Criterion++import Data.GenValidity+import Test.QuickCheck++import Data.GenValidity.Criterion+import Data.GenValidity.Text++main :: IO ()+main =+ Criterion.defaultMain+ [ bgroup+ "Instances"+ [genBench "Strict.Text" (genValid @Strict.Text), genBench "Lazy.Text" (genValid @Lazy.Text)]+ , bgroup+ "Approaches"+ [ genBench "via list (old version)" $ Strict.pack <$> genValid+ , genBench "genText" genText+ , genBench "genTextBy genValid" $ genTextBy genValid+ , genBench "genTextBy (choose (minBound, maxBound)) (currently in use)" $+ genTextBy (choose (minBound, maxBound))+ ]+ ]
genvalidity-text.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: ea9d370a4d6e4e02b556f3e585c751532a53c5c09c0268d232ac5a3e7d861fea+-- hash: 32a882c052ae73ea830afd8162e2fc352a39013cfb19ee2b7f69bc554026063a name: genvalidity-text-version: 0.6.0.0+version: 0.7.0.1 synopsis: GenValidity support for Text description: Please see README.md category: Testing@@ -37,6 +37,7 @@ , array , base >=4.7 && <5 , genvalidity >=0.5+ , random , text , validity >=0.5 , validity-text >=0.3@@ -53,10 +54,28 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing build-depends: QuickCheck- , base+ , base >=4.7 && <5 , genvalidity , genvalidity-hspec , genvalidity-text , hspec+ , 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 default-language: Haskell2010
src/Data/GenValidity/Text.hs view
@@ -10,7 +10,10 @@ import Data.GenValidity import Data.Validity.Text () +import System.Random as Random import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Random #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<*>), pure) import Data.Functor ((<$>))@@ -22,54 +25,66 @@ import GHC.TypeLits #endif instance GenValid ST.Text where- genValid =- sized $ \n -> do- chars <- resize n $ genListOf arbitrary- return $ ST.pack chars- shrinkValid = fmap ST.pack . shrinkValid . ST.unpack+ genValid = genText+ shrinkValid = fmap ST.pack . shrinkValid . ST.unpack #if MIN_VERSION_base(4,9,0) -- If you see this error and want to learn more, have a look at docs/BYTESTRING.md instance GHC.TypeLits.TypeError ('GHC.TypeLits.Text "The GenUnchecked Data.Text.Text is disabled:" 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "Do not instantiate GenUnchecked, instantiate GenValid instead") => GenUnchecked ST.Text where- genUnchecked = error "unreachable"- shrinkUnchecked = error "unreachable"+ genUnchecked = error "unreachable"+ shrinkUnchecked = error "unreachable" #endif+genText :: Gen ST.Text+genText = do+ len <- genListLength+ MkGen $ \qcgen _ -> ST.unfoldrN len (pure . random) qcgen++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+ 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+ 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 #if MIN_VERSION_base(4,9,0) -- If you see this error and want to learn more, have a look at docs/BYTESTRING.md instance GHC.TypeLits.TypeError ('GHC.TypeLits.Text "The GenUnchecked Data.Text.Lazy.Text is disabled:" 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "Do not instantiate GenUnchecked, instantiate GenValid instead") => GenUnchecked LT.Text where- genUnchecked = error "unreachable"- shrinkUnchecked = error "unreachable"+ genUnchecked = error "unreachable"+ shrinkUnchecked = error "unreachable" #endif -- | 'textStartingWith c' generates a 'Text' value that starts with 'c'. textStartingWith :: Char -> Gen ST.Text textStartingWith c =- sized $ \n ->- case n of- 0 -> pure $ ST.singleton c- 1 -> pure $ ST.singleton c- _ -> ST.cons c <$> resize (n - 1) genValid+ sized $ \n ->+ case n of+ 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 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 $ ST.concat [before, middle, after]+ sized $ \n -> do+ (b, m, a) <- genSplit3 n+ before <- resize b genValid+ middle <- resize m gen+ 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@@ -81,8 +96,7 @@ -- | 'textWithoutAnyOf c' generates a 'Text' value that does not contain any character in 'ls'. textWithoutAnyOf :: String -> Gen ST.Text-textWithoutAnyOf cs =- ST.pack <$> genListOf (arbitrary `suchThat` (`notElem` cs))+textWithoutAnyOf cs = ST.pack <$> genListOf (genValid `suchThat` (`notElem` cs)) -- | 'textAllCaps' generates a 'Text' value with only upper-case characters. textAllCaps :: Gen ST.Text