mirror of
https://github.com/ilyakooo0/streamly.git
synced 2024-10-26 09:59:48 +03:00
1380 lines
49 KiB
Haskell
1380 lines
49 KiB
Haskell
-- XXX We are using head/tail at one place
|
|
#if __GLASGOW_HASKELL__ >= 908
|
|
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
#endif
|
|
module Main (main) where
|
|
|
|
import Control.Applicative ((<|>))
|
|
import Control.Exception (displayException)
|
|
import Data.Foldable (for_)
|
|
import Data.Word (Word8, Word32, Word64)
|
|
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
|
|
import Test.Hspec (Spec, hspec, describe)
|
|
import Test.Hspec.QuickCheck
|
|
import Test.QuickCheck
|
|
(arbitrary, forAll, elements, Property, property, listOf,
|
|
vectorOf, Gen, (.&&.))
|
|
import Test.QuickCheck.Monadic (monadicIO, assert, run)
|
|
|
|
import Prelude hiding (sequence)
|
|
|
|
import qualified Control.Monad.Fail as Fail
|
|
import qualified Data.List as List
|
|
import qualified Prelude
|
|
import qualified Streamly.Data.Stream as S
|
|
import qualified Streamly.Internal.Data.Array as A
|
|
import qualified Streamly.Internal.Data.Fold as FL
|
|
import qualified Streamly.Internal.Data.Parser as P
|
|
import qualified Streamly.Internal.Data.Producer as Producer
|
|
import qualified Streamly.Internal.Data.Unfold as Unfold
|
|
import qualified Test.Hspec as H
|
|
|
|
#if MIN_VERSION_QuickCheck(2,14,0)
|
|
|
|
import Test.QuickCheck (chooseAny)
|
|
import Control.Monad.Identity (Identity(runIdentity, Identity))
|
|
import Streamly.Internal.Data.Parser (ParseError(..))
|
|
|
|
#else
|
|
|
|
import System.Random (Random(random))
|
|
import Test.QuickCheck.Gen (Gen(MkGen))
|
|
|
|
-- | Generates a random element over the natural range of `a`.
|
|
chooseAny :: Random a => Gen a
|
|
chooseAny = MkGen (\r _ -> let (x,_) = random r in x)
|
|
|
|
#endif
|
|
|
|
maxTestCount :: Int
|
|
maxTestCount = 100
|
|
|
|
min_value :: Int
|
|
min_value = 0
|
|
|
|
mid_value :: Int
|
|
mid_value = 5000
|
|
|
|
max_value :: Int
|
|
max_value = 10000
|
|
|
|
max_length :: Int
|
|
max_length = 1000
|
|
|
|
-- Accumulator Tests
|
|
|
|
fromFold :: Property
|
|
fromFold =
|
|
forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
|
|
monadicIO $ do
|
|
s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls)
|
|
o2 <- S.fold FL.sum (S.fromList ls)
|
|
return $
|
|
case s1 of
|
|
Right o1 -> o1 == o2
|
|
Left _ -> False
|
|
|
|
fromPure :: Property
|
|
fromPure =
|
|
forAll (chooseInt (min_value, max_value)) $ \x ->
|
|
case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
|
|
Right r -> r == x
|
|
Left _ -> False
|
|
|
|
fromEffect :: Property
|
|
fromEffect =
|
|
forAll (chooseInt (min_value, max_value)) $ \x ->
|
|
case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
|
|
Right r -> r == x
|
|
Left _ -> False
|
|
|
|
die :: Property
|
|
die =
|
|
property $
|
|
case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True
|
|
|
|
dieM :: Property
|
|
dieM =
|
|
property $
|
|
case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True
|
|
|
|
parserFail :: Property
|
|
parserFail =
|
|
property $
|
|
case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of
|
|
Right _ -> False
|
|
Left (ParseError e) -> err == e
|
|
where
|
|
err = "Testing MonadFail.fail."
|
|
|
|
-- Element Parser Tests
|
|
|
|
peekPass :: Property
|
|
peekPass =
|
|
forAll (chooseInt (1, max_length)) $ \list_length ->
|
|
forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse P.peek (S.fromList ls) of
|
|
Right head_value -> case ls of
|
|
head_ls : _ -> head_value == head_ls
|
|
_ -> False
|
|
Left _ -> False
|
|
|
|
peekFail :: Property
|
|
peekFail =
|
|
property (case runIdentity $ S.parse P.peek (S.fromList []) of
|
|
Right _ -> False
|
|
Left _ -> True)
|
|
|
|
eofPass :: Property
|
|
eofPass =
|
|
property (case runIdentity $ S.parse P.eof (S.fromList []) of
|
|
Right _ -> True
|
|
Left _ -> False)
|
|
|
|
eofFail :: Property
|
|
eofFail =
|
|
forAll (chooseInt (1, max_length)) $ \list_length ->
|
|
forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse P.eof (S.fromList ls) of
|
|
Right _ -> False
|
|
Left _ -> True
|
|
|
|
satisfyPass :: Property
|
|
satisfyPass =
|
|
forAll (chooseInt (mid_value, max_value)) $ \first_element ->
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
|
|
let
|
|
ls = first_element : ls_tail
|
|
predicate = (>= mid_value)
|
|
in
|
|
case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
|
|
Right r -> r == first_element
|
|
Left _ -> False
|
|
|
|
satisfy :: Property
|
|
satisfy =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
|
|
Right r -> case ls of
|
|
[] -> False
|
|
(x : _) -> predicate x && (r == x)
|
|
Left _ -> case ls of
|
|
[] -> True
|
|
(x : _) -> not $ predicate x
|
|
where
|
|
predicate = (>= mid_value)
|
|
|
|
onePass :: Property
|
|
onePass =
|
|
forAll (chooseInt (1, max_value)) $ \int ->
|
|
property (case runIdentity $ S.parse P.one (S.fromList [int]) of
|
|
Right i -> i == int
|
|
Left _ -> False)
|
|
|
|
one :: Property
|
|
one =
|
|
property $
|
|
case runIdentity $ S.parse P.one (S.fromList []) of
|
|
Left _ -> True
|
|
Right _ -> False
|
|
|
|
-- Sequence Parsers Tests
|
|
takeBetweenPass :: Property
|
|
takeBetweenPass =
|
|
forAll (chooseInt (min_value, max_value)) $ \m ->
|
|
forAll (chooseInt (m, max_value)) $ \n ->
|
|
forAll (chooseInt (m, max_value)) $ \list_length ->
|
|
forAll (vectorOf list_length (chooseInt (min_value, max_value)))
|
|
$ \ls ->
|
|
case runIdentity $ S.parse (P.takeBetween m n FL.toList)
|
|
(S.fromList ls) of
|
|
Right parsed_list ->
|
|
let lpl = Prelude.length parsed_list
|
|
in checkListEqual parsed_list
|
|
$ Prelude.take lpl ls
|
|
Left _ -> property False
|
|
|
|
_takeBetween :: Property
|
|
_takeBetween =
|
|
forAll (chooseInt (min_value, max_value)) $ \m ->
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
go m n ls
|
|
|
|
where
|
|
|
|
go m n ls =
|
|
let inputLen = Prelude.length ls
|
|
in do
|
|
let p = P.takeBetween m n FL.toList
|
|
case runIdentity $ S.parse p (S.fromList ls) of
|
|
Right xs ->
|
|
let parsedLen = Prelude.length xs
|
|
in if inputLen >= m && parsedLen >= m && parsedLen <= n
|
|
then checkListEqual xs $ Prelude.take parsedLen ls
|
|
else property False
|
|
Left _ ->
|
|
property ((m >= 0 && n >= 0 && m > n) || inputLen < m)
|
|
|
|
take :: Property
|
|
take =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
|
|
Left _ -> property False
|
|
|
|
takeEQPass :: Property
|
|
takeEQPass =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (chooseInt (n, max_value)) $ \list_length ->
|
|
forAll (vectorOf list_length
|
|
(chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual parsed_list (Prelude.take n ls)
|
|
Left _ -> property False
|
|
|
|
takeEQ :: Property
|
|
takeEQ =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let
|
|
list_length = Prelude.length ls
|
|
in
|
|
case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
if n <= list_length
|
|
then checkListEqual parsed_list (Prelude.take n ls)
|
|
else property False
|
|
Left _ -> property (n > list_length)
|
|
|
|
takeGEPass :: Property
|
|
takeGEPass =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (chooseInt (n, max_value)) $ \list_length ->
|
|
forAll (vectorOf list_length (chooseInt (min_value, max_value)))
|
|
$ \ls ->
|
|
case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list ls
|
|
Left _ -> property False
|
|
|
|
takeGE :: Property
|
|
takeGE =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let
|
|
list_length = Prelude.length ls
|
|
in
|
|
case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
if n <= list_length
|
|
then checkListEqual parsed_list ls
|
|
else property False
|
|
Left _ -> property (n > list_length)
|
|
|
|
nLessThanEqual0 ::
|
|
( Int
|
|
-> FL.Fold Identity Int [Int]
|
|
-> P.Parser Int Identity [Int]
|
|
)
|
|
-> (Int -> [Int] -> [Int])
|
|
-> Property
|
|
nLessThanEqual0 tk ltk =
|
|
forAll (elements [0, (-1)]) $ \n ->
|
|
forAll (listOf arbitrary) $ \ls ->
|
|
case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list (ltk n ls)
|
|
Left _ -> property False
|
|
|
|
takeProperties :: Spec
|
|
takeProperties =
|
|
describe "take combinators when n <= 0/" $ do
|
|
prop "takeEQ n FL.toList = []" $
|
|
nLessThanEqual0 P.takeEQ (\_ -> const [])
|
|
prop "takeGE n FL.toList xs = xs" $
|
|
nLessThanEqual0 P.takeGE (\_ -> id)
|
|
|
|
-- XXX lookAhead can't deal with EOF which in this case means when
|
|
-- n==list_length, this test will fail. So excluding that case for now.
|
|
lookAheadPass :: Property
|
|
lookAheadPass =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
let
|
|
takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
|
|
parseTwice = do
|
|
parsed_list_1 <- takeWithoutConsume
|
|
parsed_list_2 <- takeWithoutConsume
|
|
return (parsed_list_1, parsed_list_2)
|
|
in
|
|
forAll (chooseInt (n+1, max_value)) $ \list_length ->
|
|
forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse parseTwice (S.fromList ls) of
|
|
Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
|
|
Left _ -> property $ False
|
|
|
|
-- lookAheadFail :: Property
|
|
-- lookAheadFail =
|
|
-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
|
|
-- let
|
|
-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
|
|
-- parseTwice = do
|
|
-- parsed_list_1 <- takeWithoutConsume
|
|
-- parsed_list_2 <- takeWithoutConsume
|
|
-- return (parsed_list_1, parsed_list_2)
|
|
-- in
|
|
-- forAll (chooseInt (min_value, n - 1)) $ \list_length ->
|
|
-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
|
|
-- case S.parse parseTwice (S.fromList ls) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True
|
|
|
|
lookAhead :: Property
|
|
lookAhead =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
let
|
|
takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
|
|
parseTwice = do
|
|
parsed_list_1 <- takeWithoutConsume
|
|
parsed_list_2 <- takeWithoutConsume
|
|
return (parsed_list_1, parsed_list_2)
|
|
in
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
case runIdentity $ S.parse parseTwice (S.fromList ls) of
|
|
Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
|
|
Left _ -> property ((list_length < n) || (list_length == n && n == 0))
|
|
where
|
|
list_length = Prelude.length ls
|
|
|
|
takeEndBy_ :: Property
|
|
takeEndBy_ =
|
|
forAll (listOf (chooseInt (min_value, max_value ))) $ \ls ->
|
|
case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual parsed_list (tkwhl ls)
|
|
Left _ -> property False
|
|
where
|
|
predicate = (>= 100)
|
|
prsr = P.many (P.satisfy (const True)) FL.toList
|
|
tkwhl ls = Prelude.takeWhile (not . predicate) ls
|
|
|
|
takeEndByOrMax_ :: Property
|
|
takeEndByOrMax_ =
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
case runIdentity $ S.parse (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
|
|
Left _ -> property False
|
|
where
|
|
predicate = (== 1)
|
|
|
|
takeStartBy :: Property
|
|
takeStartBy =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let ls1 = 1:ls
|
|
in
|
|
case runIdentity $ S.parse parser (S.fromList ls1) of
|
|
Right parsed_list ->
|
|
if not $ Prelude.null ls1
|
|
then
|
|
let tls = Prelude.takeWhile (not . predicate) (tail ls1)
|
|
in checkListEqual parsed_list $
|
|
if predicate (head ls1)
|
|
then head ls1 : tls
|
|
else Prelude.takeWhile (not . predicate) ls1
|
|
else property $ Prelude.null parsed_list
|
|
Left _ -> property False
|
|
where
|
|
predicate = odd
|
|
parser = P.takeStartBy predicate FL.toList
|
|
|
|
takeWhile :: Property
|
|
takeWhile =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ ls ->
|
|
case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual parsed_list (Prelude.takeWhile predicate ls)
|
|
Left _ -> property False
|
|
where
|
|
predicate = (== 0)
|
|
|
|
takeP :: Property
|
|
takeP =
|
|
forAll
|
|
((,) <$> chooseInt (min_value, max_value)
|
|
<*> listOf (chooseInt (0, 1)))
|
|
$ \(takeNum, ls) ->
|
|
case runIdentity $ S.parse
|
|
(P.takeP takeNum (P.fromFold FL.toList))
|
|
(S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual parsed_list (Prelude.take takeNum ls)
|
|
Left _ -> property False
|
|
|
|
takeWhile1 :: Property
|
|
takeWhile1 =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ ls ->
|
|
case runIdentity $ S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
|
|
Right parsed_list -> case ls of
|
|
[] -> property False
|
|
(x : _) ->
|
|
if predicate x
|
|
then
|
|
checkListEqual parsed_list
|
|
$ Prelude.takeWhile predicate ls
|
|
else
|
|
property False
|
|
Left _ -> case ls of
|
|
[] -> property True
|
|
(x : _) -> property (not $ predicate x)
|
|
where
|
|
predicate = (== 0)
|
|
|
|
takeWhileP :: Property
|
|
takeWhileP =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
let
|
|
predicate = (== 1)
|
|
|
|
prsr =
|
|
P.takeWhileP predicate
|
|
$ P.fromFold (FL.take n FL.toList)
|
|
|
|
takeWhileTillLen maxLen prd list =
|
|
Prelude.take maxLen $ Prelude.takeWhile prd list
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual
|
|
parsed_list
|
|
(takeWhileTillLen n predicate ls)
|
|
Left _ -> property False
|
|
|
|
{-
|
|
choice :: Property
|
|
choice =
|
|
forAll
|
|
((,,) <$> chooseInt (min_value, max_value)
|
|
<*> chooseInt (min_value, max_value)
|
|
<*> listOf (chooseInt (0, 1)))
|
|
$ \(i, j, ls) ->
|
|
case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual parsed_list $ take (min i j) ls
|
|
Left _ -> property False
|
|
|
|
where
|
|
|
|
parser i = P.fromFold (FL.take i FL.toList)
|
|
-}
|
|
|
|
groupBy :: Property
|
|
groupBy =
|
|
forAll (listOf (chooseInt (0, 1)))
|
|
$ \ls ->
|
|
case runIdentity $ S.parse parser (S.fromList ls) of
|
|
Right parsed -> checkListEqual parsed (groupByLF ls)
|
|
Left _ -> property False
|
|
|
|
where
|
|
|
|
cmp = (==)
|
|
parser = P.groupBy cmp FL.toList
|
|
groupByLF lst
|
|
| null lst = []
|
|
| otherwise = head $ List.groupBy cmp lst
|
|
|
|
groupByRolling :: Property
|
|
groupByRolling =
|
|
forAll (listOf (chooseInt (0, 1)))
|
|
$ \ls ->
|
|
case runIdentity $ S.parse parser (S.fromList ls) of
|
|
Right parsed -> checkListEqual parsed (groupByLF Nothing ls)
|
|
Left _ -> property False
|
|
|
|
where
|
|
|
|
cmp = (==)
|
|
parser = P.groupBy cmp FL.toList
|
|
groupByLF _ [] = []
|
|
groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs
|
|
groupByLF (Just y) (x:xs) =
|
|
if cmp y x
|
|
then x : groupByLF (Just x) xs
|
|
else []
|
|
|
|
wordBy :: Property
|
|
wordBy =
|
|
forAll (listOf (elements [' ', 's']))
|
|
$ \ls ->
|
|
case runIdentity $ S.parse parser (S.fromList ls) of
|
|
Right parsed -> checkListEqual parsed (words' ls)
|
|
Left _ -> property False
|
|
|
|
where
|
|
|
|
predicate = (== ' ')
|
|
parser = P.many (P.wordBy predicate FL.toList) FL.toList
|
|
words' lst =
|
|
let wrds = words lst
|
|
in if wrds == [] && length lst > 0 then [""] else wrds
|
|
|
|
parseManyWordQuotedBy :: H.SpecWith ()
|
|
parseManyWordQuotedBy =
|
|
describe "parseMany wordQuotedBy"
|
|
$ for_ testCases
|
|
$ \c@(kQ, isQ, input, expected) -> do
|
|
let inpStrm = S.fromList input
|
|
|
|
esc = '\\'
|
|
|
|
spc ' ' = True
|
|
spc _ = False
|
|
|
|
tr _ _ = Nothing
|
|
|
|
parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList
|
|
result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm
|
|
H.it (showCase c) $ result `H.shouldBe` expected
|
|
|
|
where
|
|
|
|
showCase (kQ, _, input, expected) =
|
|
show kQ ++ ", " ++ input ++ " -> " ++ show expected
|
|
|
|
testCases =
|
|
[ ( True
|
|
, \x -> if x == '\'' then Just '\'' else Nothing
|
|
, "The quick brown fox"
|
|
, ["The", "quick", "brown", "fox"])
|
|
, ( True
|
|
, \x -> if x == '\'' then Just '\'' else Nothing
|
|
, "The' quick brown' fox"
|
|
, ["The' quick brown'", "fox"])
|
|
, ( False
|
|
, \x -> if x == '\'' then Just '\'' else Nothing
|
|
, "The' quick brown' fox"
|
|
, ["The quick brown", "fox"])
|
|
, ( True
|
|
, \x -> if x == '[' then Just ']' else Nothing
|
|
, "The[ quick brown] fox"
|
|
, ["The[ quick brown]", "fox"])
|
|
, ( True
|
|
, \x -> if x == '[' then Just ']' else Nothing
|
|
, "The[ qui[ck] brown] \\ f[ ox]"
|
|
, ["The[ qui[ck] brown]", " f[ ox]"])
|
|
, ( False
|
|
, \x -> if x == '[' then Just ']' else Nothing
|
|
, "The[ qui[ck] brown] fox"
|
|
, ["The qui[ck] brown", "fox"])
|
|
]
|
|
|
|
splitWith :: Property
|
|
splitWith =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
case runIdentity $ S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
|
|
Right (result_first, result_second) -> case ls of
|
|
0 : 1 : _ -> (result_first == 0) && (result_second == 1)
|
|
_ -> False
|
|
Left _ -> case ls of
|
|
0 : 1 : _ -> False
|
|
_ -> True
|
|
|
|
splitWithFailLeft :: Property
|
|
splitWithFailLeft =
|
|
property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True)
|
|
|
|
splitWithFailRight :: Property
|
|
splitWithFailRight =
|
|
property (case runIdentity $ S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True)
|
|
|
|
splitWithFailBoth :: Property
|
|
splitWithFailBoth =
|
|
property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True)
|
|
|
|
-- teeWithPass :: Property
|
|
-- teeWithPass =
|
|
-- forAll (chooseInt (min_value, max_value)) $ \n ->
|
|
-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
-- let
|
|
-- prsr = P.fromFold $ FL.take n FL.toList
|
|
-- in
|
|
-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
|
|
-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
|
|
-- Left _ -> property False
|
|
|
|
-- teeWithFailLeft :: Property
|
|
-- teeWithFailLeft =
|
|
-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True)
|
|
|
|
-- teeWithFailRight :: Property
|
|
-- teeWithFailRight =
|
|
-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True)
|
|
|
|
-- teeWithFailBoth :: Property
|
|
-- teeWithFailBoth =
|
|
-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True)
|
|
|
|
{-
|
|
deintercalate :: Property
|
|
deintercalate =
|
|
forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
|
|
case runIdentity $ S.parse p (S.fromList ls) of
|
|
Right evenOdd -> evenOdd == List.partition even ls
|
|
Left _ -> False
|
|
|
|
where
|
|
p1 = P.takeWhile even FL.toList
|
|
p2 = P.takeWhile odd FL.toList
|
|
partition =
|
|
FL.tee (fmap concat $ FL.catLefts FL.toList)
|
|
(fmap concat $ FL.catRights FL.toList)
|
|
p = P.deintercalate p1 p2 partition
|
|
-}
|
|
|
|
-- shortestPass :: Property
|
|
-- shortestPass =
|
|
-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
|
|
-- let
|
|
-- half_mid_value = mid_value `Prelude.div` 2
|
|
-- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
|
|
-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
|
|
-- prsr_shortest = P.shortest prsr_1 prsr_2
|
|
-- in
|
|
-- case S.parse prsr_shortest (S.fromList ls) of
|
|
-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)
|
|
-- Left _ -> property False
|
|
|
|
-- shortestPassLeft :: Property
|
|
-- shortestPassLeft =
|
|
-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
|
|
-- Right r -> r == 1
|
|
-- Left _ -> False)
|
|
--
|
|
-- shortestPassRight :: Property
|
|
-- shortestPassRight =
|
|
-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
|
|
-- Right r -> r == 1
|
|
-- Left _ -> False)
|
|
|
|
-- shortestFailBoth :: Property
|
|
-- shortestFailBoth =
|
|
-- property
|
|
-- (case S.parse
|
|
-- (P.shortest (P.die "die") (P.die "die"))
|
|
-- (S.fromList [1 :: Int]) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True)
|
|
--
|
|
-- longestPass :: Property
|
|
-- longestPass =
|
|
-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
|
|
-- let
|
|
-- half_mid_value = mid_value `Prelude.div` 2
|
|
-- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
|
|
-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
|
|
-- prsr_longest = P.longest prsr_1 prsr_2
|
|
-- in
|
|
-- case S.parse prsr_longest (S.fromList ls) of
|
|
-- Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls
|
|
-- Left _ -> False
|
|
--
|
|
-- longestPassLeft :: Property
|
|
-- longestPassLeft =
|
|
-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
|
|
-- Right r -> r == 1
|
|
-- Left _ -> False)
|
|
--
|
|
-- longestPassRight :: Property
|
|
-- longestPassRight =
|
|
-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
|
|
-- Right r -> r == 1
|
|
-- Left _ -> False)
|
|
--
|
|
-- longestFailBoth :: Property
|
|
-- longestFailBoth =
|
|
-- property
|
|
-- (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
|
|
-- Right _ -> False
|
|
-- Left _ -> True)
|
|
|
|
many :: Property
|
|
many =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
let fldstp conL currL = return $ FL.Partial (conL ++ currL)
|
|
concatFold = FL.Fold fldstp (return (FL.Partial [])) return return
|
|
prsr =
|
|
flip P.many concatFold
|
|
$ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
|
|
in case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right res_list ->
|
|
checkListEqual res_list (Prelude.filter (== 0) ls)
|
|
Left _ -> property False
|
|
|
|
many_empty :: Property
|
|
many_empty =
|
|
property (case runIdentity $ S.parse (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
|
|
Right res_list -> checkListEqual res_list ([] :: [Int])
|
|
Left _ -> property False)
|
|
|
|
some :: Property
|
|
some =
|
|
forAll (listOf (chooseInt (0, 1))) $ \genLs ->
|
|
let
|
|
ls = 0 : genLs
|
|
fldstp conL currL = return $ FL.Partial $ conL ++ currL
|
|
concatFold = FL.Fold fldstp (return (FL.Partial [])) return return
|
|
prsr =
|
|
flip P.some concatFold
|
|
$ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
|
|
in case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right res_list -> res_list == Prelude.filter (== 0) ls
|
|
Left _ -> False
|
|
|
|
someFail :: Property
|
|
someFail =
|
|
property (case runIdentity $ S.parse (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of
|
|
Right _ -> False
|
|
Left _ -> True)
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Instances
|
|
-------------------------------------------------------------------------------
|
|
|
|
applicative :: Property
|
|
applicative =
|
|
forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
|
|
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
|
|
let parser =
|
|
(,)
|
|
<$> P.fromFold (FL.take (length list1) FL.toList)
|
|
<*> P.fromFold (FL.take (length list2) FL.toList)
|
|
in
|
|
case runIdentity $ S.parse parser (S.fromList $ list1 ++ list2) of
|
|
Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
|
|
Left _ -> False
|
|
|
|
sequence :: Property
|
|
sequence =
|
|
forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
|
|
let p xs = P.fromFold (FL.take (length xs) FL.toList)
|
|
in monadicIO $ do
|
|
outs <- run $
|
|
S.parse
|
|
(Prelude.sequence $ fmap p ins)
|
|
(S.fromList $ concat ins)
|
|
return $
|
|
case outs of
|
|
Right ls -> ls == ins
|
|
Left _ -> False
|
|
|
|
altEOF1 :: Property
|
|
altEOF1 =
|
|
monadicIO $ do
|
|
s1 <- S.parse
|
|
(P.satisfy (> 0) <|> return 66)
|
|
(S.fromList ([]::[Int]))
|
|
return $
|
|
case s1 of
|
|
Right x -> x == 66
|
|
Left _ -> False
|
|
|
|
altEOF2 :: Property
|
|
altEOF2 =
|
|
monadicIO $ do
|
|
s1 <- S.parse
|
|
((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))
|
|
(S.fromList ([51]::[Int]))
|
|
return $
|
|
case s1 of
|
|
Right x -> x == [51]
|
|
Left _ -> False
|
|
|
|
monad :: Property
|
|
monad =
|
|
forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
|
|
forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
|
|
let parser = do
|
|
olist1 <- P.fromFold (FL.take (length list1) FL.toList)
|
|
olist2 <- P.fromFold (FL.take (length list2) FL.toList)
|
|
return (olist1, olist2)
|
|
in monadicIO $ do
|
|
s <- S.parse parser (S.fromList $ list1 ++ list2)
|
|
return $
|
|
case s of
|
|
Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
|
|
Left _ -> False
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Stream parsing
|
|
-------------------------------------------------------------------------------
|
|
|
|
parseMany :: Property
|
|
parseMany =
|
|
forAll (chooseInt (1,100)) $ \len ->
|
|
forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
|
|
monadicIO $ do
|
|
outs <- do
|
|
let p = P.fromFold $ FL.take len FL.toList
|
|
run
|
|
$ S.fold FL.toList
|
|
$ S.catRights
|
|
$ S.parseMany p (S.fromList $ concat ins)
|
|
listEquals (==) outs ins
|
|
|
|
-- basic sanity test for parsing from arrays
|
|
parseUnfold :: Property
|
|
parseUnfold = do
|
|
let len = 200
|
|
-- ls = input list (stream)
|
|
-- clen = chunk size
|
|
-- tlen = parser take size
|
|
forAll
|
|
((,,)
|
|
<$> vectorOf len (chooseAny :: Gen Int)
|
|
<*> chooseInt (1, len)
|
|
<*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
|
|
monadicIO $ do
|
|
arrays <- S.toList $ S.chunksOf clen (S.fromList ls)
|
|
let src = Producer.source (Just (Producer.OuterLoop arrays))
|
|
let parser = P.fromFold (FL.take tlen FL.toList)
|
|
let readSrc =
|
|
Producer.producer
|
|
$ Producer.concat Producer.fromList A.producer
|
|
let streamParser =
|
|
Producer.simplify (Producer.parseManyD parser readSrc)
|
|
xs <- run
|
|
$ S.toList
|
|
$ S.unfoldMany Unfold.fromList
|
|
$ S.catRights
|
|
$ S.unfold streamParser src
|
|
|
|
listEquals (==) xs ls
|
|
|
|
parserSequence :: Property
|
|
parserSequence =
|
|
forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->
|
|
monadicIO $ do
|
|
let parsers = S.fromList
|
|
$ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins
|
|
let sequencedParser = P.sequence parsers FL.sum
|
|
outs <-
|
|
S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins)
|
|
return $
|
|
case outs of
|
|
Right x -> x == sum (map sum ins)
|
|
Left _ -> False
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Test for a particular case hit during fs events testing
|
|
-------------------------------------------------------------------------------
|
|
|
|
evId :: [Word8]
|
|
evId = [96,238,17,9,0,0,0,0]
|
|
|
|
evFlags :: [Word8]
|
|
evFlags = [0,4,1,0,0,0,0,0]
|
|
|
|
evPathLen :: [Word8]
|
|
evPathLen = [71,0,0,0,0,0,0,0]
|
|
|
|
evPath :: [Word8]
|
|
evPath =
|
|
[47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
|
|
,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
|
|
,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
|
|
,114,101,97,109,108,121,47,116,109,112,47,122,122
|
|
]
|
|
|
|
event :: [Word8]
|
|
event = evId ++ evFlags ++ evPathLen ++ evPath
|
|
|
|
data Event = Event
|
|
{ eventId :: Word64
|
|
, eventFlags :: Word32
|
|
, eventAbsPath :: A.Array Word8
|
|
} deriving (Show, Ord, Eq)
|
|
|
|
readOneEvent :: P.Parser Word8 IO Event
|
|
readOneEvent = do
|
|
arr <- P.takeEQ 24 (A.writeN 24)
|
|
let arr1 = A.castUnsafe arr :: A.Array Word64
|
|
eid = A.getIndexUnsafe 0 arr1
|
|
eflags = A.getIndexUnsafe 1 arr1
|
|
pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1
|
|
-- XXX handle if pathLen is 0
|
|
path <- P.takeEQ pathLen (A.writeN pathLen)
|
|
return $ Event
|
|
{ eventId = eid
|
|
, eventFlags = fromIntegral eflags
|
|
, eventAbsPath = path
|
|
}
|
|
|
|
parseMany2Events :: Property
|
|
parseMany2Events =
|
|
monadicIO $ do
|
|
xs <-
|
|
( run
|
|
$ S.fold FL.toList
|
|
$ S.catRights
|
|
$ S.parseMany readOneEvent
|
|
$ S.fromList (concat (replicate 2 event))
|
|
)
|
|
assert (length xs == 2)
|
|
-- XXX assuming little endian machine
|
|
let ev = Event
|
|
{ eventId = 152170080
|
|
, eventFlags = 66560
|
|
, eventAbsPath = A.fromList evPath
|
|
}
|
|
in listEquals (==) xs (replicate 2 ev)
|
|
|
|
manyEqParseMany :: Property
|
|
manyEqParseMany =
|
|
forAll (listOf (chooseInt (0, 100))) $ \lst ->
|
|
forAll (chooseInt (1, 100)) $ \i ->
|
|
monadicIO $ do
|
|
let strm = S.fromList lst
|
|
r1 <- run $ S.parse (P.many (split i) FL.toList) strm
|
|
r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm
|
|
return $
|
|
case r1 of
|
|
Right o1 -> o1 == r2
|
|
Left _ -> False
|
|
|
|
where
|
|
|
|
split i = P.fromFold (FL.take i FL.toList)
|
|
|
|
|
|
takeEndBy1 :: Property
|
|
takeEndBy1 =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
|
|
Right parsed_list ->
|
|
checkListEqual
|
|
parsed_list
|
|
(takeWhileAndFirstFail (not . predicate) ls)
|
|
Left _ -> property False
|
|
where
|
|
prsr = P.many (P.satisfy (const True)) FL.toList
|
|
|
|
predicate = (== 1)
|
|
|
|
takeWhileAndFirstFail prd (x : xs) =
|
|
if prd x
|
|
then x : takeWhileAndFirstFail prd xs
|
|
else [x]
|
|
takeWhileAndFirstFail _ [] = []
|
|
|
|
splitWithSuffix
|
|
:: Monad m
|
|
=> (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
|
|
splitWithSuffix predicate f = S.foldMany (FL.takeEndBy predicate f)
|
|
|
|
takeEndBy2 :: Property
|
|
takeEndBy2 =
|
|
forAll (listOf (chooseInt (0, 1))) $ \ls ->
|
|
let
|
|
strm = S.fromList ls
|
|
|
|
predicate = (==0)
|
|
|
|
eitherParsedList =
|
|
S.fold FL.toList
|
|
$ S.catRights
|
|
$ S.parseMany (P.takeEndBy predicate prsr) strm
|
|
|
|
where
|
|
|
|
prsr = P.many (P.satisfy (const True)) FL.toList
|
|
|
|
eitherSplitList =
|
|
case ls of
|
|
[] -> return []
|
|
_ ->
|
|
if last ls == 0
|
|
then S.fold FL.toList $ S.append strm1 (S.fromList [])
|
|
else S.fold FL.toList strm1
|
|
|
|
where
|
|
|
|
strm1 = splitWithSuffix predicate FL.toList strm
|
|
in
|
|
case eitherParsedList of
|
|
Left _ -> property False
|
|
Right parsedList ->
|
|
case eitherSplitList of
|
|
Left _ -> property False
|
|
Right splitList -> checkListEqual parsedList splitList
|
|
|
|
takeEndByEsc :: Property
|
|
takeEndByEsc =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let
|
|
msg = "takeEndByEsc: trailing escape"
|
|
|
|
isSep = even
|
|
|
|
isEsc x = x `mod` 6 == 0
|
|
|
|
prsr = P.takeEndByEsc isEsc isSep prsr0
|
|
|
|
where
|
|
|
|
prsr0 = P.many (P.satisfy (const True)) FL.toList
|
|
|
|
escapeSep maybePrevEsc [] =
|
|
case maybePrevEsc of
|
|
Nothing -> []
|
|
Just prevEsc -> [prevEsc]
|
|
escapeSep maybePrevEsc (x : xs) =
|
|
case maybePrevEsc of
|
|
Nothing ->
|
|
if isEsc x
|
|
then escapeSep (Just x) xs
|
|
else
|
|
if isSep x
|
|
then [x]
|
|
else x : escapeSep Nothing xs
|
|
Just _ ->
|
|
x : escapeSep Nothing xs
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
|
|
Left err -> property (displayException err == msg)
|
|
|
|
takeFramedByEsc_ :: Property
|
|
takeFramedByEsc_ =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let
|
|
isBegin = (== 0)
|
|
|
|
isEnd = (== 1)
|
|
|
|
isEsc = (== 2)
|
|
|
|
prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
|
|
|
|
checkPass (x : xs) maybePrevEsc openMinusClose =
|
|
case maybePrevEsc of
|
|
Nothing ->
|
|
if isEsc x
|
|
then checkPass xs (Just x) openMinusClose
|
|
else
|
|
if isBegin x
|
|
then checkPass xs Nothing (openMinusClose + 1)
|
|
else
|
|
if isEnd x
|
|
then
|
|
case openMinusClose of
|
|
0 -> False
|
|
1 -> True
|
|
_ ->
|
|
checkPass
|
|
xs
|
|
Nothing
|
|
(openMinusClose - 1)
|
|
else
|
|
checkPass xs Nothing openMinusClose
|
|
Just _ -> checkPass xs Nothing openMinusClose
|
|
checkPass [] _ _ = False
|
|
|
|
checkPassBeg [] = False
|
|
checkPassBeg xxs@(x:_)
|
|
| isBegin x = checkPass xxs Nothing (0 :: Int)
|
|
| otherwise = False
|
|
|
|
escapeFrame begin end escape l =
|
|
let
|
|
helper (x : xs) maybePrevEsc openMinusClose =
|
|
case maybePrevEsc of
|
|
Nothing ->
|
|
if escape x
|
|
then helper xs (Just x) openMinusClose
|
|
else
|
|
if begin x
|
|
then helper xs Nothing (openMinusClose + 1)
|
|
else
|
|
if end x
|
|
then
|
|
if openMinusClose - 1 == 0
|
|
then []
|
|
else
|
|
helper
|
|
xs
|
|
Nothing
|
|
(openMinusClose - 1)
|
|
else
|
|
x : helper xs Nothing openMinusClose
|
|
Just prevEsc ->
|
|
if escape x || begin x || end x
|
|
then x : helper xs Nothing openMinusClose
|
|
else
|
|
prevEsc : x : helper xs Nothing openMinusClose
|
|
helper [] _ _ = error "Cannot Reach Here"
|
|
in
|
|
helper l Nothing (0 :: Int)
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right parsed_list ->
|
|
if checkPassBeg ls
|
|
then checkListEqual parsed_list $
|
|
escapeFrame isBegin isEnd isEsc ls
|
|
else property False
|
|
Left _ ->
|
|
if checkPassBeg ls
|
|
then property False
|
|
else property True
|
|
|
|
takeFramedByEsc_Pass :: Property
|
|
takeFramedByEsc_Pass =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
|
|
let
|
|
ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
|
|
|
|
isBegin = (== 0)
|
|
|
|
isEnd = (== 1)
|
|
|
|
isEsc = (== 2)
|
|
|
|
prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
|
|
|
|
escapeFrame begin end escape l =
|
|
let
|
|
helper (x : xs) maybePrevEsc openMinusClose =
|
|
case maybePrevEsc of
|
|
Nothing ->
|
|
if escape x
|
|
then helper xs (Just x) openMinusClose
|
|
else
|
|
if begin x
|
|
then
|
|
if openMinusClose == 0
|
|
then helper xs Nothing (openMinusClose + 1)
|
|
else x : helper xs Nothing (openMinusClose + 1)
|
|
else
|
|
if end x
|
|
then
|
|
if openMinusClose - 1 == 0
|
|
then []
|
|
else
|
|
x :
|
|
helper
|
|
xs
|
|
Nothing
|
|
(openMinusClose - 1)
|
|
else
|
|
x : helper xs Nothing openMinusClose
|
|
Just _ ->
|
|
x : helper xs Nothing openMinusClose
|
|
helper [] _ _ = error "Cannot Reach Here"
|
|
in
|
|
helper l Nothing (0 :: Int)
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
|
|
_ -> property False
|
|
|
|
takeFramedByEsc_Fail1 :: Property
|
|
takeFramedByEsc_Fail1 =
|
|
let
|
|
msg = "takeFramedByEsc_: missing frame end"
|
|
|
|
isBegin = (== 0)
|
|
|
|
isEnd = (== 0)
|
|
|
|
isEsc = (== 2)
|
|
|
|
prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
|
|
|
|
ls = [0 :: Int]
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right _ -> property False
|
|
Left err -> property (displayException err == msg)
|
|
|
|
takeFramedByEsc_Fail2 :: Property
|
|
takeFramedByEsc_Fail2 =
|
|
let
|
|
msg = "takeFramedByEsc_: missing frame start"
|
|
|
|
isBegin = (== 0)
|
|
|
|
isEnd = (== 1)
|
|
|
|
isEsc = (== 1)
|
|
|
|
prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
|
|
|
|
ls = [1 :: Int]
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right _ -> property False
|
|
Left err -> property (displayException err == msg)
|
|
|
|
takeFramedByEsc_Fail3 :: Property
|
|
takeFramedByEsc_Fail3 =
|
|
let
|
|
msg = "takeFramedByEsc_: missing frame end"
|
|
|
|
isBegin = (== 2)
|
|
|
|
isEnd = (== 1)
|
|
|
|
isEsc = (== 2)
|
|
|
|
prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
|
|
|
|
ls = [2 :: Int]
|
|
in
|
|
case runIdentity $ S.parse prsr (S.fromList ls) of
|
|
Right _ -> property False
|
|
Left err -> property $ (displayException err == msg)
|
|
|
|
takeStartBy_ :: Property
|
|
takeStartBy_ =
|
|
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
|
|
let ls1 = 1:ls
|
|
msg = "takeFramedByGeneric: empty token"
|
|
in
|
|
case runIdentity $ S.parse parser (S.fromList ls1) of
|
|
Right parsed_list ->
|
|
if not $ Prelude.null ls1
|
|
then
|
|
let tls = Prelude.takeWhile (not . predicate) (tail ls1)
|
|
in checkListEqual parsed_list $
|
|
if predicate (head ls1)
|
|
then tls
|
|
else Prelude.takeWhile (not . predicate) ls1
|
|
else property $ Prelude.null parsed_list
|
|
Left err -> property (displayException err == msg)
|
|
where
|
|
predicate = odd
|
|
parser = P.takeStartBy_ predicate FL.toList
|
|
-------------------------------------------------------------------------------
|
|
-- Main
|
|
-------------------------------------------------------------------------------
|
|
|
|
moduleName :: String
|
|
moduleName = "Data.Parser"
|
|
|
|
main :: IO ()
|
|
main =
|
|
hspec $
|
|
H.parallel $
|
|
modifyMaxSuccess (const maxTestCount) $ do
|
|
describe moduleName $ do
|
|
|
|
describe "Instances" $ do
|
|
prop "applicative" applicative
|
|
prop "Alternative: end of input 1" altEOF1
|
|
prop "Alternative: end of input 2" altEOF2
|
|
prop "monad" monad
|
|
prop "sequence" sequence
|
|
describe "Stream parsing" $ do
|
|
prop "parseMany" parseMany
|
|
prop "parseMany2Events" parseMany2Events
|
|
prop "parseUnfold" parseUnfold
|
|
prop "parserSequence" parserSequence
|
|
|
|
describe "test for accumulator" $ do
|
|
prop "P.fromFold FL.sum = FL.sum" fromFold
|
|
prop "fromPure value provided" fromPure
|
|
prop "fromPure monadic value provided" fromEffect
|
|
prop "fail err = Left (SomeException (ParseError err))" parserFail
|
|
prop "always fail" die
|
|
prop "always fail but monadic" dieM
|
|
|
|
describe "test for element parser" $ do
|
|
prop "peek = head with list length > 0" peekPass
|
|
prop "peek fail on []" peekFail
|
|
prop "eof pass on []" eofPass
|
|
prop "eof fail on non-empty list" eofFail
|
|
prop "first element exists and >= mid_value" satisfyPass
|
|
prop "one pass on [Int]" onePass
|
|
prop "one fail on []" one
|
|
prop "check first element exists and satisfies predicate" satisfy
|
|
|
|
describe "test for sequence parser" $ do
|
|
prop "P.takeBetween = Prelude.take when len >= m and len <= n"
|
|
takeBetweenPass
|
|
-- XXX This test fails
|
|
-- XXX cabal run test:Data.Parser -- --match "/Data.Parser/test for sequence parser/P.takeBetween = Prelude.take when len >= m and len <= n and failotherwise fail/" --seed 1563586298
|
|
-- prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
|
|
-- ++ "otherwise fail") Main._takeBetween
|
|
prop "P.take = Prelude.take" Main.take
|
|
prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
|
|
prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
|
|
Main.takeEQ
|
|
prop "P.takeGE n ls = ls when len >= n" takeGEPass
|
|
prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
|
|
prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
|
|
-- prop "Fail when stream length exceeded" lookAheadFail
|
|
prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
|
|
prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
|
|
++ " tail") takeStartBy
|
|
prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
|
|
prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
|
|
++ " else check why failed") takeWhile1
|
|
prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
|
|
prop ("P.takeP = Prelude.take") takeP
|
|
prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
|
|
prop "groupByRolling" groupByRolling
|
|
prop "many (P.wordBy ' ') = words'" wordBy
|
|
parseManyWordQuotedBy
|
|
-- prop "choice" choice
|
|
prop "parse 0, then 1, else fail" splitWith
|
|
prop "fail due to die as left parser" splitWithFailLeft
|
|
prop "fail due to die as right parser" splitWithFailRight
|
|
prop "fail due to die as both parsers" splitWithFailBoth
|
|
-- prop "" teeWithPass
|
|
-- prop "" teeWithFailLeft
|
|
-- prop "" teeWithFailRight
|
|
-- prop "" teeWithFailBoth
|
|
-- prop "deintercalate" deintercalate
|
|
-- prop "" shortestPass
|
|
-- prop "" shortestFailLeft
|
|
-- prop "" shortestFailRight
|
|
-- prop "" shortestFailBoth
|
|
prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
|
|
++ "Prelude.filter (== 0)") many
|
|
prop "[] due to parser being die" many_empty
|
|
prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
|
|
++ "Prelude.filter (== 0)") some
|
|
prop "fail due to parser being die" someFail
|
|
prop "P.many == S.parseMany" manyEqParseMany
|
|
|
|
prop "takeEndBy_" takeEndBy_
|
|
prop "takeEndByOrMax_" takeEndByOrMax_
|
|
prop "takeEndBy1" takeEndBy1
|
|
prop "takeEndBy2" takeEndBy2
|
|
prop "takeEndByEsc" takeEndByEsc
|
|
prop "takeFramedByEsc_" takeFramedByEsc_
|
|
prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
|
|
prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
|
|
prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
|
|
prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
|
|
prop "takeStartBy_" takeStartBy_
|
|
|
|
takeProperties
|