4130d50 · isoparsec · git.iko.soy

src/Control/SemiIso.hs+8

compare with master

unifiedsplit

@@ -7,6 +7,8 @@ module Control.SemiIso

7 turn,

8 withSemiIso,

9 AlternativeMonad,

10+ maskr,

11+ maskl,

10 )

12 )

11where

13where

12

14

@@ -82,3 +84,9 @@ withSemiIso ::

82 ((a -> f b) -> (b -> f a) -> c) ->

84 ((a -> f b) -> (b -> f a) -> c) ->

83 c

85 c

84withSemiIso (SemiIso a b) f = f a b

86withSemiIso (SemiIso a b) f = f a b

87+

88+maskr :: SemiIso a () -> SemiIso a ()

89+maskr (SemiIso e p) = SemiIso (\a -> e a <|> pure ()) p

90+

91+maskl :: SemiIso () b -> SemiIso () b

92+maskl (SemiIso e p) = SemiIso e (\b -> p b <|> pure ())

src/Data/Isoparsec.hs+3−4

@@ -2,7 +2,6 @@

2

3module Data.Isoparsec

4 ( module X,

5− -- Isoparsec,

6 (%>>),

5 (%>>),

7 (%>%),

6 (%>%),

8 (>>%),

7 (>>%),

@@ -40,7 +39,7 @@ opt :: (ArrowPlus m, PolyArrow m SemiIso) => m () () -> m () ()

40opt m = m <+^ konst ()

39opt m = m <+^ konst ()

41

40

42opt' :: (ArrowPlus m, PolyArrow m SemiIso, Eq a) => a -> m () a -> m () ()

41opt' :: (ArrowPlus m, PolyArrow m SemiIso, Eq a) => a -> m () a -> m () ()

43−opt' a m = (m >>^ tsnok a) <+^ konst ()

42+opt' a m = (m >>^ turn (konst a)) <+^ konst ()

44

43

45repeating :: (PolyArrow m SemiIso, ArrowPlus m, Eq b) => m () b -> m () [b]

44repeating :: (PolyArrow m SemiIso, ArrowPlus m, Eq b) => m () b -> m () [b]

46repeating m = (m &&& (repeating m <+^ konst [])) >>^ siCons

45repeating m = (m &&& (repeating m <+^ konst [])) >>^ siCons

@@ -135,8 +134,8 @@ mapIso m = arr $ siMaybe (`M.lookup` n) (`M.lookup` u)

135auto :: forall x s m. (ToIsoparsec x s, Isoparsec m s) => m () x

134auto :: forall x s m. (ToIsoparsec x s, Isoparsec m s) => m () x

136auto = toIsoparsec

135auto = toIsoparsec

137

136

138−specific :: forall x s m. (ToIsoparsec x s, Isoparsec m s, Eq x, Show x) => x -> m () ()

137+specific :: forall x s m. (ToIsoparsec x s, Isoparsec m s, Eq x) => x -> m () ()

139−specific x = auto @x >>> check (== x) ^>^ tsnok x

138+specific x = auto @x >>^ turn (konst x)

140

139

141throughIntegral ::

140throughIntegral ::

142 (Integral a, Integral b, Num a, Num b, PolyArrow m SemiIso) =>

141 (Integral a, Integral b, Num a, Num b, PolyArrow m SemiIso) =>

src/Data/Isoparsec/Char.hs+4−4

@@ -14,11 +14,11 @@ import Prelude hiding ((.), id)

14space :: (Isoparsec m s, Element s ~ Char) => m () ()

15space = token ' '

16

17−unsafeWhiteSpace :: (Isoparsec m s, Element s ~ Char) => m () ()

17+unsafeWhiteSpace :: (Isoparsec m s, Element s ~ Char, Eq s) => m () ()

18−unsafeWhiteSpace = tokensWhile isSpace >>^ badTsnok mempty

18+unsafeWhiteSpace = tokensWhile isSpace >>^ (maskr . turn . konst $ mempty)

19

20−unsafeWhiteSpace1 :: (Isoparsec m s, Element s ~ Char) => m () ()

20+unsafeWhiteSpace1 :: (Isoparsec m s, Element s ~ Char, Eq s) => m () ()

21−unsafeWhiteSpace1 = tokensWhile1 isSpace >>^ badTsnok (singleton ' ')

21+unsafeWhiteSpace1 = tokensWhile1 isSpace >>^ (maskr . turn . konst $ singleton ' ')

22

23number :: (Isoparsec m s, Element s ~ Char) => m () Integer

24number =

src/Data/Isoparsec/Internal.hs+4−16

@@ -3,13 +3,10 @@ module Data.Isoparsec.Internal

3 IsoparsecFail (..),

4 Isoparsec (..),

5 konst,

6− tsnok,

7 siCons,

6 siCons,

8 isoCheck,

7 isoCheck,

9 siCheck,

8 siCheck,

10 check,

9 check,

11− badKonst,

12− badTsnok,

13 unroll,

10 unroll,

14 arrowsWhile,

11 arrowsWhile,

15 )

12 )

@@ -33,7 +30,7 @@ class

33

30

34 token :: Element s -> m () ()

31 token :: Element s -> m () ()

35 default token :: Eq (Element s) => Element s -> m () ()

32 default token :: Eq (Element s) => Element s -> m () ()

36− token x = anyToken >>^ tsnok x

33+ token x = anyToken >>^ turn (konst x)

37

34

38 tokens :: [Element s] -> m () ()

35 tokens :: [Element s] -> m () ()

39 default tokens :: [Element s] -> m () ()

36 default tokens :: [Element s] -> m () ()

@@ -115,17 +112,8 @@ isoCheck f a b = siCheck f (pure . a) (pure . b)

115isoConst :: s -> a -> SemiIso s a

112isoConst :: s -> a -> SemiIso s a

116isoConst s a = SI (const $ pure a) (const $ pure s)

113isoConst s a = SI (const $ pure a) (const $ pure s)

117

114

118−konst :: Eq x => x -> SemiIso () x

119−konst x = badKonst x >>> check (== x)

120−

121−badKonst :: x -> SemiIso () x

122−badKonst x = SI (const $ pure x) (const $ pure ())

123−

124−tsnok :: Eq x => x -> SemiIso x ()

125−tsnok x = check (== x) >>> badTsnok x

126−

127−badTsnok :: x -> SemiIso x ()

128−badTsnok x = SI (const $ pure ()) (const $ pure x)

129−

130check :: (s -> Bool) -> SemiIso s s

115check :: (s -> Bool) -> SemiIso s s

131check f = isoCheck f id id

116check f = isoCheck f id id

117+

118+konst :: Eq x => x -> SemiIso () x

119+konst x = SI (const $ pure x) (const $ pure ()) >>> check (== x)

test/Spec/Ssh.hs+1−1

@@ -100,7 +100,7 @@ instance ToIsoparsec Payload ByteString where

100 )

101 <+> ( _VersionPayload <.> chunk "SSH-2.0-"

102 &&& (tokensWhile (`BS.notElem` " \n\r") >>> utf8)

103− &&& ( (chunk " " >>> takeUntil "\r\n" >>^ turn (badKonst ""))

103+ &&& ( (chunk " " >>> takeUntil "\r\n" >>^ (maskr . turn . konst $ ""))

104 <+> chunk "\r\n"

105 )

106 )