streamly-0.9.0: test/Streamly/Test/Data/Parser/ParserD.hs
module Main (main) where
import Control.Applicative ((<|>))
import Control.Exception (SomeException(..), try)
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 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.ParserD as P
import qualified Streamly.Internal.Data.Producer.Source as Source
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Stream as S
import qualified Streamly.Internal.Data.Stream.StreamD as D
import qualified Streamly.Internal.Data.Unfold as Unfold
import qualified Test.Hspec as H
import Prelude hiding (sequence)
#if MIN_VERSION_QuickCheck(2,14,0)
import Test.QuickCheck (chooseAny)
import Control.Monad.Identity (runIdentity, Identity (Identity))
#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
toList :: Monad m => S.Stream m a -> m [a]
toList = S.fold FL.toList
-- Accumulator Tests
fromFold :: Property
fromFold =
forAll (listOf $ chooseInt (min_value, max_value))
$ \ls ->
case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls))
<*> (S.fold FL.sum (S.fromList ls)) of
Right is_equal -> is_equal
Left _ -> False
fromPure :: Property
fromPure =
forAll (chooseInt (min_value, max_value)) $ \x ->
case runIdentity $ S.parseD (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.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
Right r -> r == x
Left _ -> False
die :: Property
die =
property $
case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of
Right _ -> False
Left _ -> True
dieM :: Property
dieM =
property $
case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of
Right _ -> False
Left _ -> True
-- 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.parseD 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.parseD P.peek (S.fromList []) of
Right _ -> False
Left _ -> True)
eofPass :: Property
eofPass =
property (case S.parseD 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.parseD 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.parseD (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.parseD (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)
-- 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.parseD (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 ->
let
list_length = Prelude.length ls
in monadicIO $ do
let p = P.takeBetween m n FL.toList
r <- run $ try $ S.parseD p (S.fromList ls)
return $ case r of
Right x -> case x of
Right parsed_list ->
if m <= list_length && n >= m
then
let len = Prelude.length parsed_list
in checkListEqual
parsed_list (Prelude.take len ls)
else property False
Left _ ->
property (m > n || list_length < m)
Left (_ :: SomeException) ->
property (m > n || list_length < m)
take :: Property
take =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
case runIdentity $ S.parseD (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.parseD (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.parseD (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.parseD (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.parseD (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.parseD (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.parseD 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
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.parseD 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
takeWhile :: Property
takeWhile =
forAll (listOf (chooseInt (0, 1))) $ \ ls ->
case runIdentity $ S.parseD (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)
takeWhile1 :: Property
takeWhile1 =
forAll (listOf (chooseInt (0, 1))) $ \ ls ->
case runIdentity $ S.parseD (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)
groupBy :: Property
groupBy =
forAll (listOf (chooseInt (0, 1)))
$ \ls ->
case runIdentity $ S.parseD 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.parseD 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 []
takeEndByOrMax :: Property
takeEndByOrMax =
forAll (chooseInt (min_value, max_value)) $ \n ->
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case runIdentity $ S.parseD (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)
wordBy :: Property
wordBy =
forAll (listOf (elements [' ', 's']))
$ \ls ->
case runIdentity $ S.parseD 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
splitWith :: Property
splitWith =
forAll (listOf (chooseInt (0, 1))) $ \ls ->
case runIdentity $ S.parseD (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.parseD (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.parseD (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.parseD (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.parseD (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.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
Right _ -> False
Left _ -> True)
teeWithFailRight :: Property
teeWithFailRight =
property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
Right _ -> False
Left _ -> True)
teeWithFailBoth :: Property
teeWithFailBoth =
property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
Right _ -> False
Left _ -> True)
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.parseD 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.parseD (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.parseD (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.parseD
(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.parseD prsr_longest (S.fromList ls) of
Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls
Left _ -> False
longestPassLeft :: Property
longestPassLeft =
property (case S.parseD (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.parseD (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.parseD (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
prsr =
flip P.many concatFold
$ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
in case runIdentity $ S.parseD 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.parseD (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)))
$ \ls ->
let fldstp conL currL = return $ FL.Partial $ conL ++ currL
concatFold = FL.Fold fldstp (return (FL.Partial [])) return
prsr =
flip P.some concatFold
$ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
in case runIdentity $ S.parseD prsr (S.fromList ls) of
Right res_list -> res_list == Prelude.filter (== 0) ls
Left _ -> False
someFail :: Property
someFail =
property (case runIdentity $ S.parseD (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 ->
monadicIO $ do
let parser =
(,)
<$> P.fromFold (FL.take (length list1) FL.toList)
<*> P.fromFold (FL.take (length list2) FL.toList)
return $
case runIdentity $ S.parseD 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 ->
monadicIO $ do
let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins
outs <- S.parseD
(Prelude.sequence parsers)
(S.fromList $ concat ins)
return $
case outs of
Right x -> x == ins
Left _ -> False
altEOF1 :: Property
altEOF1 =
monadicIO $ do
s1 <- S.parseD
(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.parseD
((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 ->
monadicIO $ do
let parser = do
olist1 <- P.fromFold (FL.take (length list1) FL.toList)
olist2 <- P.fromFold (FL.take (length list2) FL.toList)
return (olist1, olist2)
s1 <- S.parseD parser (S.fromList $ list1 ++ list2)
return $
case s1 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 <-
(toList $ S.catRights $ S.parseManyD
(P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)
)
return $ 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 <- toList $ S.chunksOf clen (S.fromList ls)
let src = Source.source (Just (Producer.OuterLoop arrays))
let parser = P.fromFold (FL.take tlen FL.toList)
let readSrc =
Source.producer
$ Producer.concat Producer.fromList A.producer
let streamParser =
Producer.simplify (Source.parseManyD parser readSrc)
xs <- run
$ 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 = D.fromList
$ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins
let sequencedParser = P.sequence parsers FL.sum
outs <-
S.parseD 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.unsafeIndex 0 arr1
eflags = A.unsafeIndex 1 arr1
pathLen = fromIntegral $ A.unsafeIndex 2 arr1
path <- P.takeEQ pathLen (A.writeN pathLen)
return $ Event
{ eventId = eid
, eventFlags = fromIntegral eflags
, eventAbsPath = path
}
parseMany2Events :: Property
parseMany2Events =
monadicIO $ do
xs <-
( run
$ toList
$ S.catRights
$ S.parseManyD 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)
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
moduleName :: String
moduleName = "Data.Parser.ParserD"
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 "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 "check first element exists and satisfies predicate" satisfy
describe "test for sequence parser" $ do
prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"
takeBetweenPass
prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"
++ " fail otherwise") 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 "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1
prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
prop "groupByRolling" groupByRolling
prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax
prop "many (P.wordBy ' ') = words'" wordBy
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 "parsed two lists should be equal" teeWithPass
prop "fail due to die as left parser" teeWithFailLeft
prop "fail due to die as right parser" teeWithFailRight
prop "fail due to die as both parsers" teeWithFailBoth
prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass
prop "pass even if die is left parser" shortestPassLeft
prop "pass even if die is right parser" shortestPassRight
prop "fail due to die as both parsers" shortestFailBoth
prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass
prop "pass even if die is left parser" longestPassLeft
prop "pass even if die is right parser" longestPassRight
prop "fail due to die as both parsers" longestFailBoth
-}
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
takeProperties