{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}

module Data.GenValidity.Text where

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

import Test.QuickCheck

import Control.Monad
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*>), pure)
import Data.Functor ((<$>))
#endif
import qualified Data.Text as ST
import qualified Data.Text.Array as A
import qualified Data.Text.Internal as ST
import qualified Data.Text.Internal.Lazy as LT

instance GenUnchecked ST.Text where
    genUnchecked =
        sized $ \n -> do
            size <- upTo n
            arr <-
                do ins <- replicateM size arbitrary
                   return $
                       A.run $ do
                           arr <- A.new size
                           forM_ (zip [0 ..] ins) $ uncurry $ A.unsafeWrite arr
                           return arr
            off <- upTo $ max 0 (size - 1)
            let len = size - off
            pure $ ST.Text arr off len
    shrinkUnchecked _ = []

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

instance GenInvalid ST.Text

instance GenUnchecked LT.Text where
    genUnchecked =
        sized $ \n ->
            case n of
                0 -> pure LT.Empty
                _ -> do
                    (a, b) <- genSplit n
                    st <- resize a genUnchecked
                    lt <- resize b genUnchecked
                    pure $ LT.Chunk st lt
    shrinkUnchecked LT.Empty = []
    shrinkUnchecked (LT.Chunk st lt) =
        [LT.Chunk st' lt' | (st', lt') <- shrinkUnchecked (st, lt)]

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

instance GenInvalid LT.Text

-- | '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

-- | '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]

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

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

-- | '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))

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