{-# 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 c' generates a 'Text' value that starts with 'c'.
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

-- | 'textStartingWith g' generates a 'Text' value that contains a substring generated by 'g'.
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]

-- | 'textStartingWith c' generates a 'Text' value that contains a 'c'.
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 c' generates a 'Text' value that does not contain any '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 c' generates a 'Text' value that does not contain any character in 'ls'.
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' generates a 'Text' value with only upper-case characters.
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' generates a single-line text, that is without any line separators.
--
-- See 'Data.GenValidity.genNonLineSeparator' and 'Data.Validity.isLineSeparator'
genSingleLineText :: Gen ST.Text
genSingleLineText :: Gen Text
genSingleLineText = Gen Char -> Gen Text
genTextBy Gen Char
genNonLineSeparator