git.iko.soy/isoparsec
on master help sign in
Added extra operators and passthough combinators (#42)
commitba2d36ca782b23580059cd73aca367c05935037f authoriko <ilyakooo0@gmail.com> dateThu 20 Feb 2020, 21:49 (7 years ago) parent2746b08
2 files changed+29−1
compare with master
unifiedsplit
src/Control/SemiIso.hs+17 src/Data/Isoparsec/Internal.hs+12−1
src/Control/SemiIso.hs+17
@@ -17,12 +17,16 @@ module Control.SemiIso
1717 assoc,
1818 ($$$),
1919 (*>>),
20+ (&>>),
2021 (**>),
2122 (>>*),
23+ (>>&),
2224 (>**),
2325 (<<*),
26+ (<<&),
2427 (<**),
2528 (*<<),
29+ (&<<),
2630 (**<),
2731 )
2832where
@@ -31,6 +35,7 @@ import Control.Applicative as X
3135import Control.Arrow.Extra
3236import Control.Monad as X
3337import Data.Bitraversable
38+import Data.Tuple
3439import Prelude hiding ((.), id)
3540
3641type AlternativeMonad m = (Alternative m, Monad m)
@@ -116,24 +121,36 @@ a $$$ c = a *** c >>^ check (uncurry (==)) >>^ siPure fst (\x -> (x, x))
116121(*>>) :: (PolyArrow m SemiIso) => m a () -> m a b -> m a b
117122a *>> b = a &&& b >>^ siPure snd ((),)
118123
124+(&>>) :: (PolyArrow m SemiIso) => m a () -> m b c -> m (a, b) c
125+a &>> b = a *** b >>^ siPure snd ((),)
126+
119127(**>) :: (PolyArrow m SemiIso) => m () () -> m a b -> m a b
120128a **> b = siPure ((),) snd ^>> a *** b >>^ siPure snd ((),)
121129
122130(>>*) :: (PolyArrow m SemiIso, Eq b) => m a b -> m () b -> m a b
123131a >>* b = siPure (,()) fst ^>> a $$$ b
124132
133+(>>&) :: (PolyArrow m SemiIso) => m a b -> m () c -> m a (b, c)
134+a >>& b = siPure (,()) fst ^>> a *** b >>> undefined
135+
125136(>**) :: (PolyArrow m SemiIso) => m a b -> m () () -> m a b
126137a >** b = siPure (,()) fst ^>> a *** b >>^ siPure fst (,())
127138
128139(<<*) :: (PolyArrow m SemiIso, Eq b) => m a b -> m () b -> m a b
129140a <<* b = siPure ((),) snd ^>> b $$$ a
130141
142+(<<&) :: (PolyArrow m SemiIso) => m a b -> m () c -> m a (b, c)
143+a <<& b = siPure ((),) snd ^>> b *** a >>^ siPure swap swap
144+
131145(<**) :: (PolyArrow m SemiIso) => m a b -> m () () -> m a b
132146a <** b = siPure ((),) snd ^>> b *** a >>^ siPure snd ((),)
133147
134148(*<<) :: (PolyArrow m SemiIso) => m a () -> m a b -> m a b
135149a *<< b = b &&& a >>^ siPure fst (,())
136150
151+(&<<) :: (PolyArrow m SemiIso) => m a () -> m b c -> m (a, b) c
152+a &<< b = siPure swap swap ^>> b *** a >>^ siPure fst (,())
153+
137154(**<) :: (PolyArrow m SemiIso) => m () () -> m a b -> m a b
138155a **< b = siPure (,()) fst ^>> b *** a >>^ siPure fst (,())
139156
src/Data/Isoparsec/Internal.hs+12−1
@@ -29,14 +29,25 @@ class
2929 default token :: Eq (Element s) => Element s -> m () ()
3030 token x = anyToken >>^ turn (konst x)
3131
32+ token' :: m (Element s) (Element s)
33+ default token' :: Eq (Element s) => m (Element s) (Element s)
34+ token' = id >>& anyToken >>^ check (uncurry (==)) >>^ siPure fst (\x -> (x, x))
35+
3236 tokens :: [Element s] -> m () ()
33− default tokens :: [Element s] -> m () ()
3437 tokens [] = arr $ isoConst () ()
3538 tokens (t : ts) = token t &&& tokens ts >>^ isoConst ((), ()) ()
3639
40+ tokens' :: m [Element s] [Element s]
41+ tokens' = (turn siCons ^>> token' *** tokens' >>^ siCons) <+^ isoConst [] []
42+
3743 chunk :: s -> m () ()
3844 chunk = tokens . otoList
3945
46+ chunk' :: m s s
47+ chunk' = list ^>> tokens' >>^ turn list
48+ where
49+ list = siPure otoList fromList
50+
4051 notToken :: Element s -> m () (Element s)
4152 default notToken :: Eq (Element s) => Element s -> m () (Element s)
4253 notToken t = tokenWhere (/= t)