ilyakooo0/isoparsec
1
0
Fork 0
mirror of https://github.com/ilyakooo0/isoparsec.git synced 2024-11-25 20:34:00 +03:00
Code Issues Projects Releases Wiki Activity

Added arrowsuntil (#39)

Browse Source
This commit is contained in:
iko 2020-02-19 20:47:50 +03:00 committed by GitHub
parent 1ea7c742c6
commit 6091e0c6c9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Data/Isoparsec/Internal.hs
View File

@ -9,6 +9,8 @@ module Data.Isoparsec.Internal
check, check,
unroll, unroll,
arrowsWhile, arrowsWhile,
assoc,
arrowsUntil,
) )
where where
@ -82,6 +84,9 @@ class
arrowsWhile :: (PolyArrow m SemiIso, ArrowPlus m) => m () a -> m () [a] arrowsWhile :: (PolyArrow m SemiIso, ArrowPlus m) => m () a -> m () [a]
arrowsWhile f = ((f &&& arrowsWhile f) >>^ siCons) <+^ isoConst () [] arrowsWhile f = ((f &&& arrowsWhile f) >>^ siCons) <+^ isoConst () []
arrowsUntil :: (ArrowPlus m, Eq a, PolyArrow m SemiIso) => m () a -> m () b -> m () ([a], b)
arrowsUntil a b = (arr (konst []) &&& b) <+> (a &&& arrowsUntil a b >>^ (assoc >>> first siCons))
unroll :: (PolyArrow m SemiIso, ArrowPlus m, Eq a) => a -> m a (b, a) -> m () [b] unroll :: (PolyArrow m SemiIso, ArrowPlus m, Eq a) => a -> m a (b, a) -> m () [b]
unroll a f = (konst a ^>> unroll' f) <+^ isoConst () [] unroll a f = (konst a ^>> unroll' f) <+^ isoConst () []
where where
@ -117,3 +122,6 @@ check f = isoCheck f id id
konst :: Eq x => x -> SemiIso () x konst :: Eq x => x -> SemiIso () x
konst x = isoConst () x >>> check (== x) konst x = isoConst () x >>> check (== x)
assoc :: SemiIso (a, (b, c)) ((a, b), c)
assoc = siPure (\(a, (b, c)) -> ((a, b), c)) (\((a, b), c) -> (a, (b, c)))