@@ -745,6 +745,306 @@ manyEqParseMany =
745745
746746 split i = P.fromFold (FL.take i FL.toList)
747747
748+
749+takeEndBy1 :: Property
750+takeEndBy1 =
751+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
752+ case S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
753+ Right parsed_list ->
754+ checkListEqual
755+ parsed_list
756+ (takeWhileAndFirstFail (not . predicate) ls)
757+ Left _ -> property False
758+ where
759+ prsr = P.many (P.satisfy (const True)) FL.toList
760+
761+ predicate = (== 1)
762+
763+ takeWhileAndFirstFail prd (x : xs) =
764+ if prd x
765+ then x : takeWhileAndFirstFail prd xs
766+ else [x]
767+ takeWhileAndFirstFail _ [] = []
768+
769+takeEndBy2 :: Property
770+takeEndBy2 =
771+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
772+ let
773+ strm = S.fromList ls
774+
775+ predicate = (==0)
776+
777+ eitherParsedList =
778+ S.toList $
779+ S.parseMany (P.takeEndBy predicate prsr) strm
780+
781+ where
782+
783+ prsr = P.many (P.satisfy (const True)) FL.toList
784+
785+ eitherSplitList =
786+ case ls of
787+ [] -> return []
788+ _ ->
789+ if last ls == 0
790+ then S.toList $ S.append strm1 (S.fromList [])
791+ else S.toList strm1
792+
793+ where
794+
795+ strm1 = S.splitWithSuffix predicate FL.toList strm
796+ in
797+ case eitherParsedList of
798+ Left _ -> property False
799+ Right parsedList ->
800+ case eitherSplitList of
801+ Left _ -> property False
802+ Right splitList -> checkListEqual parsedList splitList
803+
804+takeEndByEsc :: Property
805+takeEndByEsc =
806+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
807+ let
808+ msg = "takeEndByEsc: trailing escape"
809+
810+ isSep = even
811+
812+ isEsc x = x `mod` 6 == 0
813+
814+ prsr = P.takeEndByEsc isEsc isSep prsr0
815+
816+ where
817+
818+ prsr0 = P.many (P.satisfy (const True)) FL.toList
819+
820+ escapeSep maybePrevEsc [] =
821+ case maybePrevEsc of
822+ Nothing -> []
823+ Just prevEsc -> [prevEsc]
824+ escapeSep maybePrevEsc (x : xs) =
825+ case maybePrevEsc of
826+ Nothing ->
827+ if isEsc x
828+ then escapeSep (Just x) xs
829+ else
830+ if isSep x
831+ then [x]
832+ else x : escapeSep Nothing xs
833+ Just _ ->
834+ x : escapeSep Nothing xs
835+ in
836+ case S.parse prsr (S.fromList ls) of
837+ Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
838+ Left err -> property (displayException err == msg)
839+
840+takeFramedByEsc_ :: Property
841+takeFramedByEsc_ =
842+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
843+ let
844+ isBegin = (== 0)
845+
846+ isEnd = (== 1)
847+
848+ isEsc = (== 2)
849+
850+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
851+
852+ checkPass (x : xs) maybePrevEsc openMinusClose =
853+ case maybePrevEsc of
854+ Nothing ->
855+ if isEsc x
856+ then checkPass xs (Just x) openMinusClose
857+ else
858+ if isBegin x
859+ then checkPass xs Nothing (openMinusClose + 1)
860+ else
861+ if isEnd x
862+ then
863+ case openMinusClose of
864+ 0 -> False
865+ 1 -> True
866+ _ ->
867+ checkPass
868+ xs
869+ Nothing
870+ (openMinusClose - 1)
871+ else
872+ checkPass xs Nothing openMinusClose
873+ Just _ -> checkPass xs Nothing openMinusClose
874+ checkPass [] _ _ = False
875+
876+ escapeFrame begin end escape l =
877+ let
878+ helper (x : xs) maybePrevEsc openMinusClose =
879+ case maybePrevEsc of
880+ Nothing ->
881+ if escape x
882+ then helper xs (Just x) openMinusClose
883+ else
884+ if begin x
885+ then helper xs Nothing (openMinusClose + 1)
886+ else
887+ if end x
888+ then
889+ if openMinusClose - 1 == 0
890+ then []
891+ else
892+ helper
893+ xs
894+ Nothing
895+ (openMinusClose - 1)
896+ else
897+ x : helper xs Nothing openMinusClose
898+ Just prevEsc ->
899+ if escape x || begin x || end x
900+ then x : helper xs Nothing openMinusClose
901+ else
902+ prevEsc : x : helper xs Nothing openMinusClose
903+ helper [] _ _ = error "Cannot Reach Here"
904+ in
905+ helper l Nothing (0 :: Int)
906+ in
907+ case S.parse prsr (S.fromList ls) of
908+ Right parsed_list ->
909+ if checkPass ls Nothing (0 :: Int)
910+ then checkListEqual parsed_list $
911+ escapeFrame isBegin isEnd isEsc ls
912+ else property False
913+ Left _ ->
914+ if checkPass ls Nothing (0 :: Int)
915+ then property False
916+ else property True
917+
918+takeFramedByEsc_Pass :: Property
919+takeFramedByEsc_Pass =
920+ forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
921+ let
922+ ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
923+
924+ isBegin = (== 0)
925+
926+ isEnd = (== 1)
927+
928+ isEsc = (== 2)
929+
930+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
931+
932+ escapeFrame begin end escape l =
933+ let
934+ helper (x : xs) maybePrevEsc openMinusClose =
935+ case maybePrevEsc of
936+ Nothing ->
937+ if escape x
938+ then helper xs (Just x) openMinusClose
939+ else
940+ if begin x
941+ then
942+ if openMinusClose == 0
943+ then helper xs Nothing (openMinusClose + 1)
944+ else x : helper xs Nothing (openMinusClose + 1)
945+ else
946+ if end x
947+ then
948+ if openMinusClose - 1 == 0
949+ then []
950+ else
951+ x :
952+ helper
953+ xs
954+ Nothing
955+ (openMinusClose - 1)
956+ else
957+ x : helper xs Nothing openMinusClose
958+ Just _ ->
959+ if escape x || begin x || end x
960+ then helper xs Nothing openMinusClose
961+ else
962+ x : helper xs Nothing openMinusClose
963+ helper [] _ _ = error "Cannot Reach Here"
964+ in
965+ helper l Nothing (0 :: Int)
966+ in
967+ case S.parse prsr (S.fromList ls) of
968+ Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
969+ _ -> property False
970+
971+takeFramedByEsc_Fail1 :: Property
972+takeFramedByEsc_Fail1 =
973+ let
974+ msg = "takeFramedByEsc_: missing frame end"
975+
976+ isBegin = (== 0)
977+
978+ isEnd = (== 0)
979+
980+ isEsc = (== 2)
981+
982+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
983+
984+ ls = [0 :: Int]
985+ in
986+ case S.parse prsr (S.fromList ls) of
987+ Right _ -> property False
988+ Left err -> property (displayException err == msg)
989+
990+takeFramedByEsc_Fail2 :: Property
991+takeFramedByEsc_Fail2 =
992+ let
993+ msg = "takeFramedByEsc_: missing frame start"
994+
995+ isBegin = (== 0)
996+
997+ isEnd = (== 1)
998+
999+ isEsc = (== 1)
1000+
1001+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1002+
1003+ ls = [1 :: Int]
1004+ in
1005+ case S.parse prsr (S.fromList ls) of
1006+ Right _ -> property False
1007+ Left err -> property (displayException err == msg)
1008+
1009+takeFramedByEsc_Fail3 :: Property
1010+takeFramedByEsc_Fail3 =
1011+ let
1012+ msg = "takeFramedByEsc_: missing frame end"
1013+
1014+ isBegin = (== 2)
1015+
1016+ isEnd = (== 1)
1017+
1018+ isEsc = (== 2)
1019+
1020+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1021+
1022+ ls = [2 :: Int]
1023+ in
1024+ case S.parse prsr (S.fromList ls) of
1025+ Right _ -> property False
1026+ Left err -> property $ (displayException err == msg)
1027+
1028+takeStartBy_ :: Property
1029+takeStartBy_ =
1030+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1031+ let ls1 = 1:ls
1032+ msg = "takeFramedByGeneric: empty token"
1033+ in
1034+ case S.parse parser (S.fromList ls1) of
1035+ Right parsed_list ->
1036+ if not $ Prelude.null ls1
1037+ then
1038+ let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1039+ in checkListEqual parsed_list $
1040+ if predicate (head ls1)
1041+ then tls
1042+ else Prelude.takeWhile (not . predicate) ls1
1043+ else property $ Prelude.null parsed_list
1044+ Left err -> property (displayException err == msg)
1045+ where
1046+ predicate = odd
1047+ parser = P.takeStartBy_ predicate FL.toList
7481048-------------------------------------------------------------------------------
7491049-- Main
7501050-------------------------------------------------------------------------------
@@ -763,7 +1063,6 @@ main =
7631063 prop "applicative" applicative
7641064 prop "monad" monad
7651065 prop "sequence" sequence
766−
7671066 describe "Stream parsing" $ do
7681067 prop "parseMany" parseMany
7691068 prop "parseMany2Events" parseMany2Events
@@ -831,4 +1130,16 @@ main =
8311130 ++ "Prelude.filter (== 0)") some
8321131 -- prop "fail due to parser being die" someFail
8331132 prop "P.many == S.parseMany" manyEqParseMany
1133+
1134+ prop "takeEndBy_" takeEndBy_
1135+ prop "takeEndBy1" takeEndBy1
1136+ prop "takeEndBy2" takeEndBy2
1137+ prop "takeEndByEsc" takeEndByEsc
1138+ prop "takeFramedByEsc_" takeFramedByEsc_
1139+ prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1140+ prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1141+ prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1142+ prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1143+ prop "takeStartBy_" takeStartBy_
1144+
8341145 takeProperties