Combinator.hs

module QC.Combinator where

import Control.Applicative ((<$>), (<*>))
import Data.Monoid (mempty)
import Data.Word (Word8)
import QC.Common (Repack, parse, repackBS, toStrictBS)
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Picoparsec as P
import qualified Data.Picoparsec.Combinator as C
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as B8

choice :: NonEmptyList (NonEmptyList Word8) -> Gen Property
choice (NonEmpty xs) = do
  let ys = map (BL.pack . getNonEmpty) xs
  return . forAll (repackBS <$> arbitrary <*> (toStrictBS <$> elements ys)) $
    maybe False (`elem` ys) . P.maybeResult . flip P.feed mempty . P.parse (C.choice (map P.string ys))

count :: Positive (Small Int) -> Repack -> B8.ByteString -> Bool
count (Positive (Small n)) rs s =
    (length <$> parse (C.count n (P.string s)) (BL.toStrict input)) == Just n
  where input = repackBS rs (B8.concat (replicate (n+1) s))

{-
match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool
match n (NonNegative x) (NonNegative y) rs =
    parse (P.match parser) (repackBS rs input) == Just (input, n)
  where parser = P.skipWhile (=='x') *> P.signed P.decimal <*
                 P.skipWhile (=='y')
        input = B8.concat [
            B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'
          ]
-}

tests :: [TestTree]
tests = [
    testProperty "choice" choice
  , testProperty "count" count
--  , testProperty "match" match
  ]