module Data.GenValidity.Text where

import Data.GenValidity
import Data.Validity.Text ()

import Test.QuickCheck

import Control.Monad

import qualified Data.Text as T
import qualified Data.Text.Array as A
import Data.Text.Internal (Text(..))

instance GenUnchecked 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

instance GenValid Text where
    genValid =
        sized $ \n -> do
            size <- upTo n
            chars <- resize size $ genListOf arbitrary
            return $ T.pack chars

instance GenInvalid Text

-- | 'textStartingWith c' generates a 'Text' value that starts with 'c'.
textStartingWith :: Char -> Gen 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

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

-- | 'textStartingWith c' generates a 'Text' value that contains a 'c'.
textWithA :: Char -> Gen Text
textWithA c = textWith $ T.singleton <$> pure c

-- | 'textWithoutAny c' generates a 'Text' value that does not contain any 'c'.
textWithoutAny :: Char -> Gen Text
textWithoutAny c = textWithoutAnyOf [c]

-- | 'textWithoutAnyOf c' generates a 'Text' value that does not contain any character in 'ls'.
textWithoutAnyOf :: [Char] -> Gen Text
textWithoutAnyOf cs = T.pack <$> genListOf (arbitrary `suchThat` (`notElem` cs))

-- | 'textAllCaps' generates a 'Text' value with only upper-case characters.
textAllCaps :: Gen Text
textAllCaps = T.toUpper <$> genValid