{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
#if MIN_VERSION_base(4,9,0)
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
#endif
module Data.GenValidity.Text where

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

import System.Random as Random
import Test.QuickCheck
import Test.QuickCheck.Gen
import Test.QuickCheck.Random
#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.Internal.Lazy as LT
import qualified Data.Text.Lazy as LT
#if MIN_VERSION_base(4,9,0)
import GHC.TypeLits
#endif
instance GenValid ST.Text where
  genValid = genText
  shrinkValid = fmap ST.pack . shrinkValid . ST.unpack
#if MIN_VERSION_base(4,9,0)
-- If you see this error and want to learn more, have a look at docs/BYTESTRING.md
instance GHC.TypeLits.TypeError ('GHC.TypeLits.Text "The GenUnchecked Data.Text.Text is disabled:" 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "Do not instantiate GenUnchecked, instantiate GenValid instead") =>
         GenUnchecked ST.Text where
  genUnchecked = error "unreachable"
  shrinkUnchecked = error "unreachable"
#endif
genText :: Gen ST.Text
genText = do
  len <- genListLength
  MkGen $ \qcgen _ -> ST.unfoldrN len (pure . random) qcgen

genTextBy :: Gen Char -> Gen ST.Text
genTextBy (MkGen charFunc) = do
  len <- genListLength
  MkGen $ \qcgen size ->
    let go :: QCGen -> Maybe (Char, QCGen)
        go qcg =
          let (qc1, qc2) = Random.split qcg
           in Just (charFunc qc1 size, qc2)
     in ST.unfoldrN len go qcgen

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
  shrinkValid = fmap LT.fromChunks . shrinkValid . LT.toChunks
#if MIN_VERSION_base(4,9,0)
-- If you see this error and want to learn more, have a look at docs/BYTESTRING.md
instance GHC.TypeLits.TypeError ('GHC.TypeLits.Text "The GenUnchecked Data.Text.Lazy.Text is disabled:" 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "Do not instantiate GenUnchecked, instantiate GenValid instead") =>
         GenUnchecked LT.Text where
  genUnchecked = error "unreachable"
  shrinkUnchecked = error "unreachable"
#endif
-- | '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 (genValid `suchThat` (`notElem` cs))

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