{-|
Following the convention from "Data.Text.Lazy", this module is intended to be
imported @qualified@. For example:

> import qualified Test.SmallCheck.Series.Text.Lazy as L.Series
-}
module Test.SmallCheck.Series.Text.Lazy
  (
  -- * Replication
    replicateA
  , replicateNull
  , replicateChar
  -- * Enumeration
  , enumAlphabet
  , enumChars
  , enumString
  -- * Printing
  , jack
  -- * Extra Unicode planes
  , enumNonBmp
  ) where

import Data.List (inits)
import Data.Text.Lazy (Text, pack)
import Test.SmallCheck.Series

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by replicating the @a@ 'Char'.
--
-- >>> list 4 replicateA
-- ["","a","aa","aaa","aaaa"]
--
-- Use this when you don't care about the 'Char's inside 'Data.Text.Lazy.Text'.
replicateA :: Series m Text
replicateA :: Series m Text
replicateA = Char -> Series m Text
forall (m :: * -> *). Char -> Series m Text
replicateChar Char
'a'

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by replicating the @NUL@ 'Char'.
--
-- >>> list 4 replicateNull
-- ["","\NUL","\NUL\NUL","\NUL\NUL\NUL","\NUL\NUL\NUL\NUL"]
replicateNull :: Series m Text
replicateNull :: Series m Text
replicateNull = Char -> Series m Text
forall (m :: * -> *). Char -> Series m Text
replicateChar Char
'\0'

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by replicating the given 'Char'.
--
-- >>> list 4 $ replicateChar '☃'
-- ["","\9731","\9731\9731","\9731\9731\9731","\9731\9731\9731\9731"]
replicateChar :: Char -> Series m Text
replicateChar :: Char -> Series m Text
replicateChar Char
c = (Depth -> [Text]) -> Series m Text
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [Text]) -> Series m Text)
-> (Depth -> [Text]) -> Series m Text
forall a b. (a -> b) -> a -> b
$ \Depth
d -> (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack ([String] -> [Text]) -> (String -> [String]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. [a] -> [[a]]
inits (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$ Depth -> Char -> String
forall a. Depth -> a -> [a]
replicate Depth
d Char
c

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by enumerating the latin alphabet.
--
-- >>> list 4 enumAlphabet
-- ["","a","ab","abc","abcd"]
enumAlphabet :: Series m Text
enumAlphabet :: Series m Text
enumAlphabet = String -> Series m Text
forall (m :: * -> *). String -> Series m Text
enumString [Char
'a'..Char
'z']

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by enumerating every 'Char'.
--
-- >>> list 4 enumChars
-- ["","\NUL","\NUL\SOH","\NUL\SOH\STX","\NUL\SOH\STX\ETX"]
enumChars :: Series m Text
enumChars :: Series m Text
enumChars = String -> Series m Text
forall (m :: * -> *). String -> Series m Text
enumString [Char
'\0'..]

-- | A 'Data.Text.Lazy.Text' 'Series' that grows by enumerating every
--   'Char' in the given 'String'. Notice that the 'String' can be infinite.
--
-- >>> list 5 $ enumString "xyz"
-- ["","x","xy","xyz"]
enumString :: String -> Series m Text
enumString :: String -> Series m Text
enumString String
cs = (Depth -> [Text]) -> Series m Text
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [Text]) -> Series m Text)
-> (Depth -> [Text]) -> Series m Text
forall a b. (a -> b) -> a -> b
$ \Depth
d -> (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack ([String] -> [Text]) -> (String -> [String]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. [a] -> [[a]]
inits (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$ Depth -> String -> String
forall a. Depth -> [a] -> [a]
take Depth
d String
cs

-- | A 'Data.Text.Lazy.Text' 'Series' that grows with English words.
--
--   This is useful when you want to print 'Series'.
--
-- >>> let s = list 20 jack
-- >>> take 3 s
-- ["","All","All work"]
-- >>> last s
-- "All work and no play makes Jack a dull boy. All work and no play makes Jack a dull boy."
jack :: Series m Text
jack :: Series m Text
jack = (Depth -> [Text]) -> Series m Text
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [Text]) -> Series m Text)
-> (Depth -> [Text]) -> Series m Text
forall a b. (a -> b) -> a -> b
$ \Depth
d ->
    ([String] -> Text) -> [[String]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords) ([[String]] -> [Text])
-> (String -> [[String]]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. [a] -> [[a]]
inits ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depth -> [String] -> [String]
forall a. Depth -> [a] -> [a]
take Depth
d ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
cycle ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$
        String
"All work and no play makes Jack a dull boy."

-- | A 'Data.Text.Lazy.Text' 'Series' that grows with the first character of each
--   <https://en.wikipedia.org/wiki/Plane_(Unicode) Unicode plane>.
--
-- >>> list 3 enumNonBmp
-- ["","\NUL","\NUL\65536","\NUL\65536\131072"]
--
-- Notice that this covers the 16 unicode planes.
--
-- >>> last (list 16 enumNonBmp) == last (list 17 enumNonBmp)
-- True
enumNonBmp :: Series m Text
enumNonBmp :: Series m Text
enumNonBmp = String -> Series m Text
forall (m :: * -> *). String -> Series m Text
enumString [Char
'\0',Char
'\x10000'..Char
'\xF0000']