attoparsec / tests / QC.hs

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Control.Monad (forM_)
import Data.Maybe (isJust)
import Data.Word (Word8)
import Prelude hiding (takeWhile)
import QCSupport
import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck hiding (NonEmpty)
import qualified Data.Attoparsec as P
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

-- Make sure that structures whose types claim they are non-empty
-- really are.

nonEmptyList l = length (nonEmpty l) > 0
    where types = l :: NonEmpty [Int]
nonEmptyBS l = B.length (nonEmpty l) > 0

-- Naming.

label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of
                            (_, Left err) -> s `isInfixOf` err
                            _             -> False

-- Basic byte-level combinators.

maybeP p s = case P.parse p s `P.feed` B.empty of
               P.Done _ i -> Just i
               _          -> Nothing

defP p s = P.parse p s `P.feed` B.empty

satisfy w s = maybeP (P.satisfy (<=w)) (B.cons w s) == Just w

word8 w s = maybeP (P.word8 w) (B.cons w s) == Just w

anyWord8 s = maybeP P.anyWord8 s == if B.null s
                                    then Nothing
                                    else Just (B.head s)

notWord8 w (NonEmpty s) = maybeP (P.notWord8 w) s == if v == w
                                                      then Nothing
                                                      else Just v
    where v = B.head s

string s = maybeP (P.string s) s == Just s

skipWhile w s =
    let t = B.dropWhile (<=w) s
    in case defP (P.skipWhile (<=w)) s of
         P.Done t' () -> t == t'
         _            -> False

takeCount (Positive k) s =
    case maybeP (P.take k) s of
      Nothing -> k > B.length s
      Just s' -> k <= B.length s

takeWhile w s =
    let (h,t) = B.span (==w) s
    in case defP (P.takeWhile (==w)) s of
         P.Done t' h' -> t == t' && h == h'
         _            -> False

takeWhile1 w s =
    let s'    = B.cons w s
        (h,t) = B.span (<=w) s'
    in case defP (P.takeWhile1 (<=w)) s' of
         P.Done t' h' -> t == t' && h == h'
         _            -> False

takeTill w s =
    let (h,t) = B.break (==w) s
    in case defP (P.takeTill (==w)) s of
         P.Done t' h' -> t == t' && h == h'
         _            -> False

ensure n s = case defP (P.ensure m) s of
               P.Done _ () -> B.length s >= m
               _           -> B.length s < m
    where m = (n `mod` 220) - 20

takeWhile1_empty = maybeP (P.takeWhile1 undefined) B.empty == Nothing

endOfInput s = maybeP P.endOfInput s == if B.null s
                                        then Just ()
                                        else Nothing

main = defaultMain tests

tests = [
  testGroup "fnord" [
    testProperty "nonEmptyList" nonEmptyList,
    testProperty "nonEmptyBS" nonEmptyBS,
    testProperty "satisfy" satisfy,
    testProperty "word8" word8,
    testProperty "notWord8" notWord8,
    testProperty "anyWord8" anyWord8,
    testProperty "string" string,
    testProperty "skipWhile" skipWhile,
    testProperty "takeCount" takeCount,
    testProperty "takeWhile" takeWhile,
    testProperty "takeWhile1" takeWhile1,
    testProperty "takeWhile1_empty" takeWhile1_empty,
    testProperty "takeTill" takeTill,
    testProperty "endOfInput" endOfInput,
    testProperty "ensure" ensure

Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.