c2ec0a4 · typeable/attoparsec

git.iko.soy/typeable/attoparsec

on master help sign in

Failed experiment: add a Status type.

c2ec0a4Bryan O'Sullivan15 years ago

Data/Attoparsec/Internal.hs+50−49

compare with master

unifiedsplit

@@ -85,49 +85,49 @@ import qualified Data.ByteString.Unsafe as B

85-- | If at least @n@ bytes of input are available, return the current

86-- input, otherwise fail.

87ensure :: Int -> Parser B.ByteString

88−ensure !n = Parser $ \i0 a0 m0 kf ks ->

88+ensure !n = Parser $ \i0 s0 a0 m0 kf ks ->

89 if B.length (unI i0) >= n

90− then ks i0 a0 m0 (unI i0)

90+ then ks i0 s0 a0 m0 (unI i0)

91− else runParser (demandInput >> ensure n) i0 a0 m0 kf ks

91+ else runParser (demandInput >> ensure n) i0 s0 a0 m0 kf ks

93-- | Ask for input. If we receive any, pass it to a success

94-- continuation, otherwise to a failure continuation.

95−prompt :: Input -> Added -> More

95+prompt :: Input -> Status -> Added -> More

96− -> (Input -> Added -> More -> Result r)

96+ -> (Input -> Status -> Added -> More -> Result r)

97− -> (Input -> Added -> More -> Result r)

97+ -> (Input -> Status -> Added -> More -> Result r)

98 -> Result r

99−prompt i0 a0 _m0 kf ks = Partial $ \s ->

99+prompt i0 s0 a0 _m0 kf ks = Partial $ \s ->

100 if B.null s

101− then kf i0 a0 Complete

101+ then kf i0 s0 a0 Complete

102− else ks (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete

102+ else ks (i0 `mappend` I s) s0 (a0 `mappend` Added s) Incomplete

103

104-- | Immediately demand more input via a 'Partial' continuation

105-- result.

106demandInput :: Parser ()

107−demandInput = Parser $ \i0 a0 m0 kf ks ->

107+demandInput = Parser $ \i0 s0 a0 m0 kf ks ->

108 if m0 == Complete

109− then kf i0 a0 m0 ["demandInput"] "not enough bytes"

109+ then kf i0 s0 a0 m0 ["demandInput"] "not enough bytes"

110− else let kf' i a m = kf i a m ["demandInput"] "not enough bytes"

110+ else let kf' i s a m = kf i s a m ["demandInput"] "not enough bytes"

111− ks' i a m = ks i a m ()

111+ ks' i s a m = ks i s a m ()

112− in prompt i0 a0 m0 kf' ks'

112+ in prompt i0 s0 a0 m0 kf' ks'

113

114-- | This parser always succeeds. It returns 'True' if any input is

115-- available either immediately or on demand, and 'False' if the end

116-- of all input has been reached.

117wantInput :: Parser Bool

118−wantInput = Parser $ \i0 a0 m0 _kf ks ->

118+wantInput = Parser $ \i0 s0 a0 m0 _kf ks ->

119 case () of

120− _ | not (B.null (unI i0)) -> ks i0 a0 m0 True

120+ _ | not (B.null (unI i0)) -> ks i0 s0 a0 m0 True

121− | m0 == Complete -> ks i0 a0 m0 False

121+ | m0 == Complete -> ks i0 s0 a0 m0 False

122− | otherwise -> let kf' i a m = ks i a m False

122+ | otherwise -> let kf' i s a m = ks i s a m False

123− ks' i a m = ks i a m True

123+ ks' i s a m = ks i s a m True

124− in prompt i0 a0 m0 kf' ks'

124+ in prompt i0 s0 a0 m0 kf' ks'

125

126get :: Parser B.ByteString

127−get = Parser $ \i0 a0 m0 _kf ks -> ks i0 a0 m0 (unI i0)

127+get = Parser $ \i0 s0 a0 m0 _kf ks -> ks i0 s0 a0 m0 (unI i0)

128

129put :: B.ByteString -> Parser ()

130−put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()

130+put s = Parser $ \_i0 _s0 a0 m0 _kf ks -> ks (I s) Committed a0 m0 ()

131

132-- | Attempt a parse, and if it fails, rewind the input so that no

133-- input appears to have been consumed.

@@ -137,22 +137,23 @@ put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()

137-- lookahead. The downside to using this combinator is that it can

138-- retain input for longer than is desirable.

139try :: Parser a -> Parser a

140−try p = Parser $ \i0 a0 m0 kf ks ->

140+try p = Parser $ \i0 s0 a0 m0 kf ks ->

141− noAdds i0 a0 m0 $ \i1 a1 m1 ->

141+ noAdds i0 s0 a0 m0 $ \i1 s1 a1 m1 ->

142− let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf

142+ let kf' i2 s2 a2 m2 = addS i0 s0 a0 m0 i2 s2 a2 m2 kf

143− in runParser p i1 a1 m1 kf' ks

143+ in runParser p i1 s1 a1 m1 kf' ks

144− where noAdds i0 _a0 m0 f = f i0 mempty m0

144+ where noAdds i0 s0 _a0 m0 f = f i0 s0 mempty m0

145

146−addS :: Input -> Added -> More

146+addS :: Input -> Status -> Added -> More

147− -> Input -> Added -> More

147+ -> Input -> Status -> Added -> More

148− -> (Input -> Added -> More -> r) -> r

148+ -> (Input -> Status -> Added -> More -> r) -> r

149−addS i0 a0 m0 _i1 a1 m1 f =

149+addS i0 s0 a0 m0 _i1 s1 a1 m1 f =

150 let !i = case a1 of

151 Dropped -> i0

152− Added s -> i0 `mappend` I s

152+ Added bs -> i0 `mappend` I bs

153+ !s = s0 `mappend` s1

153 !a = a0 `mappend` a1

154 !a = a0 `mappend` a1

154 !m = m0 `mappend` m1

155 !m = m0 `mappend` m1

155− in f i a m

156+ in f i s a m

156{-# INLINE addS #-}

157{-# INLINE addS #-}

157

158

158-- | The parser @satisfy p@ succeeds for any byte for which the

159-- | The parser @satisfy p@ succeeds for any byte for which the

@@ -410,17 +411,17 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c

410

411

411-- | Match only if all input has been consumed.

412-- | Match only if all input has been consumed.

412endOfInput :: Parser ()

413endOfInput :: Parser ()

413−endOfInput = Parser $ \i0 a0 m0 kf ks ->

414+endOfInput = Parser $ \i0 s0 a0 m0 kf ks ->

414 if B.null (unI i0)

415 if B.null (unI i0)

415 then if m0 == Complete

416 then if m0 == Complete

416− then ks i0 a0 m0 ()

417+ then ks i0 s0 a0 m0 ()

417− else let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $

418+ else let kf' i1 s1 a1 m1 _ _ = addS i0 s0 a0 m0 i1 s1 a1 m1 $

418− \ i2 a2 m2 -> ks i2 a2 m2 ()

419+ \ i2 s2 a2 m2 -> ks i2 s2 a2 m2 ()

419− ks' i1 a1 m1 _ = addS i0 a0 m0 i1 a1 m1 $

420+ ks' i1 s1 a1 m1 _ = addS i0 s0 a0 m0 i1 s1 a1 m1 $

420− \ i2 a2 m2 -> kf i2 a2 m2 []

421+ \ i2 s2 a2 m2 -> kf i2 s2 a2 m2 []

421− "endOfInput"

422+ "endOfInput"

422− in runParser demandInput i0 a0 m0 kf' ks'

423+ in runParser demandInput i0 s0 a0 m0 kf' ks'

423− else kf i0 a0 m0 [] "endOfInput"

424+ else kf i0 s0 a0 m0 [] "endOfInput"

424

425

425-- | Return an indication of whether the end of input has been

426-- | Return an indication of whether the end of input has been

426-- reached.

427-- reached.

@@ -437,30 +438,30 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())

437(<?>) :: Parser a

438(<?>) :: Parser a

438 -> String -- ^ the name to use if parsing fails

439 -> String -- ^ the name to use if parsing fails

439 -> Parser a

440 -> Parser a

440−p <?> msg0 = Parser $ \i0 a0 m0 kf ks ->

441+p <?> msg0 = Parser $ \i0 s0 a0 m0 kf ks ->

441− let kf' i a m strs msg = kf i a m (msg0:strs) msg

442+ let kf' i s a m strs msg = kf i s a m (msg0:strs) msg

442− in runParser p i0 a0 m0 kf' ks

443+ in runParser p i0 s0 a0 m0 kf' ks

443{-# INLINE (<?>) #-}

444{-# INLINE (<?>) #-}

444infix 0 <?>

445infix 0 <?>

445

446

446-- | Terminal failure continuation.

447-- | Terminal failure continuation.

447failK :: Failure a

448failK :: Failure a

448−failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg

449+failK i0 _s0 _a0 _m0 stack msg = Fail (unI i0) stack msg

449{-# INLINE failK #-}

450{-# INLINE failK #-}

450

451

451-- | Terminal success continuation.

452-- | Terminal success continuation.

452successK :: Success a a

453successK :: Success a a

453−successK i0 _a0 _m0 a = Done (unI i0) a

454+successK i0 _s0 _a0 _m0 a = Done (unI i0) a

454{-# INLINE successK #-}

455{-# INLINE successK #-}

455

456

456-- | Run a parser.

457-- | Run a parser.

457parse :: Parser a -> B.ByteString -> Result a

458parse :: Parser a -> B.ByteString -> Result a

458−parse m s = runParser m (I s) mempty Incomplete failK successK

459+parse m s = runParser m (I s) Uncommitted mempty Incomplete failK successK

459{-# INLINE parse #-}

460{-# INLINE parse #-}

460

461

461-- | Run a parser that cannot be resupplied via a 'Partial' result.

462-- | Run a parser that cannot be resupplied via a 'Partial' result.

462parseOnly :: Parser a -> B.ByteString -> Either String a

463parseOnly :: Parser a -> B.ByteString -> Either String a

463−parseOnly m s = case runParser m (I s) mempty Complete failK successK of

464+parseOnly m s = case runParser m (I s) Uncommitted mempty Complete failK successK of

464 Fail _ _ err -> Left err

465 Fail _ _ err -> Left err

465 Done _ a -> Right a

466 Done _ a -> Right a

466 _ -> error "parseOnly: impossible error!"

467 _ -> error "parseOnly: impossible error!"

Data/Attoparsec/Internal/Types.hs+24−13

@@ -18,6 +18,7 @@ module Data.Attoparsec.Internal.Types

18 , Success

19 , Result(..)

20 , Input(..)

21+ , Status(..)

21 , Added(..)

22 , Added(..)

22 , More(..)

23 , More(..)

23 , (+++)

24 , (+++)

@@ -86,14 +87,23 @@ instance Monoid Added where

87-- | The 'Parser' type is a monad.

88-- | The 'Parser' type is a monad.

88newtype Parser a = Parser {

89newtype Parser a = Parser {

89− runParser :: forall r. Input -> Added -> More

90+ runParser :: forall r. Input -> Status -> Added -> More

90 -> Failure r

91 -> Failure r

91 -> Success a r

92 -> Success a r

92 -> Result r

93 -> Result r

93 }

94 }

95−type Failure r = Input -> Added -> More -> [String] -> String -> Result r

96+type Failure r = Input -> Status -> Added -> More -> [String] -> String -> Result r

96−type Success a r = Input -> Added -> More -> a -> Result r

97+type Success a r = Input -> Status -> Added -> More -> a -> Result r

98+

99+data Status = Uncommitted | Committed

100+ deriving (Eq, Show)

101+

102+instance Monoid Status where

103+ mempty = Uncommitted

104+ mappend c@Committed _ = c

105+ mappend _ c@Committed = c

106+ mappend _ _ = Uncommitted

107

98-- | Have we read all available input?

108-- | Have we read all available input?

99data More = Complete | Incomplete

109data More = Complete | Incomplete

@@ -106,13 +116,13 @@ instance Monoid More where

106 mappend _ _ = Incomplete

116 mappend _ _ = Incomplete

107

117

108bindP :: Parser a -> (a -> Parser b) -> Parser b

118bindP :: Parser a -> (a -> Parser b) -> Parser b

109−bindP m g =

119+bindP m g = Parser $ \i0 s0 a0 m0 kf ks ->

110− Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $

120+ runParser m i0 s0 a0 m0 kf $ \i1 s1 a1 m1 a ->

111− \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks

121+ runParser (g a) i1 s1 a1 m1 kf ks

112{-# INLINE bindP #-}

122{-# INLINE bindP #-}

113

123

114returnP :: a -> Parser a

124returnP :: a -> Parser a

115−returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)

125+returnP a = Parser (\i0 s0 a0 m0 _kf ks -> ks i0 s0 a0 m0 a)

116{-# INLINE returnP #-}

126{-# INLINE returnP #-}

117

127

118instance Monad Parser where

128instance Monad Parser where

@@ -121,9 +131,10 @@ instance Monad Parser where

121 fail = failDesc

131 fail = failDesc

122

132

123plus :: Parser a -> Parser a -> Parser a

133plus :: Parser a -> Parser a -> Parser a

124−plus a b = Parser $ \i0 a0 m0 kf ks ->

134+plus a b = Parser $ \i0 _s0 a0 m0 kf ks ->

125− let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks

135+ let kf' i1 s1@Uncommitted a1 m1 _ _ = runParser b i1 s1 a1 m1 kf ks

136+ kf' i1 s1 a1 m1 kf1 ks1 = kf i1 s1 a1 m1 kf1 ks1

126− in runParser a i0 a0 m0 kf' ks

137+ in runParser a i0 Uncommitted a0 m0 kf' ks

127{-# INLINE plus #-}

138{-# INLINE plus #-}

128

139

129instance MonadPlus Parser where

140instance MonadPlus Parser where

@@ -132,8 +143,8 @@ instance MonadPlus Parser where

132 mplus = plus

143 mplus = plus

133

144

134fmapP :: (a -> b) -> Parser a -> Parser b

145fmapP :: (a -> b) -> Parser a -> Parser b

135−fmapP p m = Parser $ \i0 a0 m0 f k ->

146+fmapP p m = Parser $ \i0 s0 a0 m0 f k ->

136− runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)

147+ runParser m i0 s0 a0 m0 f $ \i1 s1 a1 m1 a -> k i1 s1 a1 m1 (p a)

137{-# INLINE fmapP #-}

148{-# INLINE fmapP #-}

138

149

139instance Functor Parser where

150instance Functor Parser where

@@ -174,7 +185,7 @@ instance Alternative Parser where

174 {-# INLINE (<|>) #-}

185 {-# INLINE (<|>) #-}

175

186

176failDesc :: String -> Parser a

187failDesc :: String -> Parser a

177−failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)

188+failDesc err = Parser (\i0 s0 a0 m0 kf _ks -> kf i0 s0 a0 m0 [] msg)

178 where msg = "Failed reading: " ++ err

189 where msg = "Failed reading: " ++ err

179{-# INLINE failDesc #-}

190{-# INLINE failDesc #-}

180

191