{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.GenValidity.Text where
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
instance GenValid ST.Text where
genValid :: Gen Text
genValid = Gen Text
genText
shrinkValid :: Text -> [Text]
shrinkValid = (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
ST.pack ([String] -> [Text]) -> (Text -> [String]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. GenValid a => a -> [a]
shrinkValid (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
ST.unpack
genText :: Gen ST.Text
genText :: Gen Text
genText = do
Int
len <- Gen Int
genListLength
(QCGen -> Int -> Text) -> Gen Text
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Text) -> Gen Text)
-> (QCGen -> Int -> Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \QCGen
qcgen Int
_ -> Int -> (QCGen -> Maybe (Char, QCGen)) -> QCGen -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
ST.unfoldrN Int
len ((Char, QCGen) -> Maybe (Char, QCGen)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Char, QCGen) -> Maybe (Char, QCGen))
-> (QCGen -> (Char, QCGen)) -> QCGen -> Maybe (Char, QCGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QCGen -> (Char, QCGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random) QCGen
qcgen
genTextBy :: Gen Char -> Gen ST.Text
genTextBy :: Gen Char -> Gen Text
genTextBy (MkGen QCGen -> Int -> Char
charFunc) = do
Int
len <- Gen Int
genListLength
(QCGen -> Int -> Text) -> Gen Text
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Text) -> Gen Text)
-> (QCGen -> Int -> Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \QCGen
qcgen Int
size ->
let go :: QCGen -> Maybe (Char, QCGen)
go :: QCGen -> Maybe (Char, QCGen)
go QCGen
qcg =
let (QCGen
qc1, QCGen
qc2) = QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
Random.split QCGen
qcg
in (Char, QCGen) -> Maybe (Char, QCGen)
forall a. a -> Maybe a
Just (QCGen -> Int -> Char
charFunc QCGen
qc1 Int
size, QCGen
qc2)
in Int -> (QCGen -> Maybe (Char, QCGen)) -> QCGen -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
ST.unfoldrN Int
len QCGen -> Maybe (Char, QCGen)
go QCGen
qcgen
instance GenValid LT.Text where
genValid :: Gen Text
genValid =
(Int -> Gen Text) -> Gen Text
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Text) -> Gen Text) -> (Int -> Gen Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \Int
n ->
case Int
n of
Int
0 -> Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
LT.Empty
Int
_ -> do
(Int
a, Int
b) <- Int -> Gen (Int, Int)
genSplit Int
n
Text
st <- Char -> Text -> Text
ST.cons (Char -> Text -> Text) -> Gen Char -> Gen (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char
forall a. GenValid a => Gen a
genValid Gen (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize Int
a Gen Text
forall a. GenValid a => Gen a
genValid
Text
lt <- Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize Int
b Gen Text
forall a. GenValid a => Gen a
genValid
Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
LT.Chunk Text
st Text
lt
shrinkValid :: Text -> [Text]
shrinkValid = ([Text] -> Text) -> [[Text]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
LT.fromChunks ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]]
forall a. GenValid a => a -> [a]
shrinkValid ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
textStartingWith :: Char -> Gen ST.Text
textStartingWith :: Char -> Gen Text
textStartingWith Char
c =
(Int -> Gen Text) -> Gen Text
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Text) -> Gen Text) -> (Int -> Gen Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \Int
n ->
case Int
n of
Int
0 -> Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
ST.singleton Char
c
Int
1 -> Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
ST.singleton Char
c
Int
_ -> Char -> Text -> Text
ST.cons Char
c (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Gen Text
forall a. GenValid a => Gen a
genValid
textWith :: Gen ST.Text -> Gen ST.Text
textWith :: Gen Text -> Gen Text
textWith Gen Text
gen =
(Int -> Gen Text) -> Gen Text
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Text) -> Gen Text) -> (Int -> Gen Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
(Int
b, Int
m, Int
a) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
n
Text
before <- Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize Int
b Gen Text
forall a. GenValid a => Gen a
genValid
Text
middle <- Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize Int
m Gen Text
gen
Text
after <- Int -> Gen Text -> Gen Text
forall a. Int -> Gen a -> Gen a
resize Int
a Gen Text
forall a. GenValid a => Gen a
genValid
Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
ST.concat [Text
before, Text
middle, Text
after]
textWithA :: Char -> Gen ST.Text
textWithA :: Char -> Gen Text
textWithA Char
c = Gen Text -> Gen Text
textWith (Gen Text -> Gen Text) -> Gen Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
ST.singleton (Char -> Text) -> Gen Char -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Gen Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
textWithoutAny :: Char -> Gen ST.Text
textWithoutAny :: Char -> Gen Text
textWithoutAny Char
c = Gen Text -> Gen Text
doubleCheck (Gen Text -> Gen Text) -> Gen Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Gen Char -> Gen Text
genTextBy (Gen Char -> Gen Text) -> Gen Char -> Gen Text
forall a b. (a -> b) -> a -> b
$ Gen Char
forall a. GenValid a => Gen a
genValid Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
predicate
where
doubleCheck :: Gen Text -> Gen Text
doubleCheck = (Gen Text -> (Text -> Bool) -> Gen Text
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Char -> Bool) -> Text -> Bool
ST.all Char -> Bool
predicate))
predicate :: Char -> Bool
predicate = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c)
textWithoutAnyOf :: String -> Gen ST.Text
textWithoutAnyOf :: String -> Gen Text
textWithoutAnyOf String
cs = Gen Text -> Gen Text
doubleCheck (Gen Text -> Gen Text) -> Gen Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Gen Char -> Gen Text
genTextBy (Gen Char
forall a. GenValid a => Gen a
genValid Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
predicate)
where
doubleCheck :: Gen Text -> Gen Text
doubleCheck = (Gen Text -> (Text -> Bool) -> Gen Text
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Char -> Bool) -> Text -> Bool
ST.all Char -> Bool
predicate))
predicate :: Char -> Bool
predicate = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
cs)
textAllCaps :: Gen ST.Text
textAllCaps :: Gen Text
textAllCaps = Text -> Text
ST.toUpper (Text -> Text) -> Gen Text -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. GenValid a => Gen a
genValid
genSingleLineText :: Gen ST.Text
genSingleLineText :: Gen Text
genSingleLineText = Gen Char -> Gen Text
genTextBy Gen Char
genNonLineSeparator