Simple.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module QC.Simple (
      tests
    ) where

import Control.Applicative ((<$>), (<|>))
import Data.ByteString (ByteString)
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid)
import Data.String (IsString)
import QC.Rechunked (rechunkBS)
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck (Property, counterexample, forAll)
import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(..))
import qualified Data.Picoparsec as P

t_issue75 = expect issue75 "ab" (P.Done "" "b")

issue75 :: P.Parser ByteStringUTF8 ByteStringUTF8
issue75 = "a" >> ("b" <|> "")

expect :: (Show r, Eq r) => P.Parser ByteStringUTF8 r -> ByteString -> P.Result ByteStringUTF8 r -> Property
expect p input wanted =
  forAll (rechunkBS input) $ \in' ->
    let result = parse p (ByteStringUTF8 <$> in')
    in counterexample (show result ++ " /= " ++ show wanted) $
       fromMaybe False (P.compareResults result wanted)

parse :: (Monoid i, IsString i) => P.Parser i r -> [i] -> P.Result i r
parse p (x:xs) = foldl' P.feed (P.parse p x) xs
parse p []     = P.parse p ""

tests :: [TestTree]
tests = [
      testProperty "issue75" t_issue75
  ]