content: {-# LANGUAGE CPP, OverloadedStrings #-}
  
  module QC.Combinator where
  
  import qualified Control.Monad as M (replicateM)
  import Data.Maybe (fromJust, isJust)
  import Data.Word (Word8)
  import QC.Common (Repack, parseBS, repackBS, toLazyBS)
  import Test.Tasty (TestTree)
  import Test.Tasty.QuickCheck (testProperty)
  import Test.QuickCheck
  import qualified Data.Binary.Parser as P
  import qualified Data.ByteString as B
  import qualified Data.Foldable as Foldable (asum)
  
  asum :: NonEmptyList (NonEmptyList Word8) -> Gen Property
  asum (NonEmpty xs) = do
    let ys = map (B.pack . getNonEmpty) xs
    return . forAll (repackBS <$> arbitrary <*> elements ys) $
      maybe False (`elem` ys) . parseBS (Foldable.asum (map (\s -> P.string s *> pure s) ys))
  
  replicateM :: Positive (Small Int) -> Repack -> B.ByteString -> Bool
  replicateM (Positive (Small n)) rs s =
      (length <$> parseBS (M.replicateM n (P.string s)) input) == Just n
    where input = repackBS rs (B.concat (replicate (n+1) s))
  
  lookAhead :: NonEmptyList Word8 -> Bool
  lookAhead (NonEmpty xs) =
    let ys = B.pack xs
        withLookAheadThenConsume = (\x y -> (x, y)) <$> P.lookAhead (P.string ys) <*> P.string ys
        mr = parseBS withLookAheadThenConsume $ toLazyBS ys
    in isJust mr && fst (fromJust mr) == snd (fromJust mr)
  
  tests :: [TestTree]
  tests = [
      testProperty "asum" asum
    , testProperty "replicateM" replicateM
    , testProperty "lookAhead" lookAhead
    ]
  