@@ -16,7 +16,6 @@ module Data.Attoparsec.Internal
1616 -- * Parser types
1717 Parser
1818 , Result(..)
19− , S(input)
2019
2120 -- * Running parsers
2221 , parse
@@ -75,38 +74,59 @@ import qualified Data.ByteString.Char8 as B
7574import qualified Data.ByteString.Internal as B
7675import qualified Data.ByteString.Unsafe as B
7776
78−data Result r = Fail S [String] String
77+-- | The result of a parse.
78+data Result r = Fail B.ByteString [String] String
79+ -- ^ The parse failed. The 'B.ByteString' is the input
80+ -- that had not yet been consumed when the failure
81+ -- occurred. The @[@'String'@]@ is a list of contexts
82+ -- in which the error occurred. The 'String' is the
83+ -- message describing the error, if any.
7984 | Partial (B.ByteString -> Result r)
80− | Done S r
85+ -- ^ Supply this continuation with more input so that
86+ -- the parser can resume. To indicate that no more
87+ -- input is available, use an 'B.empty' string.
88+ | Done B.ByteString r
89+ -- ^ The parse succeeded. The 'B.ByteString' is the
90+ -- input that had not yet been consumed (if any) when
91+ -- the parse succeeded.
92+
93+instance Show r => Show (Result r) where
94+ show (Fail bs stk msg) =
95+ "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
96+ show (Partial _) = "Partial _"
97+ show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
98+
99+fmapR :: (a -> b) -> Result a -> Result b
100+fmapR _ (Fail st stk msg) = Fail st stk msg
101+fmapR f (Partial k) = Partial (fmapR f . k)
102+fmapR f (Done bs r) = Done bs (f r)
103+
104+instance Functor Result where
105+ fmap = fmapR
106+
107+newtype Input = I {unI :: B.ByteString}
108+newtype Added = A {unA :: B.ByteString}
81109
82110-- | The 'Parser' type is a monad.
83111newtype Parser a = Parser {
84− runParser :: forall r. S
112+ runParser :: forall r. Input -> Added -> More
85113 -> Failure r
86114 -> Success a r
87115 -> Result r
88116 }
89117
90−type Failure r = S -> [String] -> String -> Result r
91−type Success a r = S -> a -> Result r
118+type Failure r = Input -> Added -> More -> [String] -> String -> Result r
119+type Success a r = Input -> Added -> More -> a -> Result r
92120
93121-- | Have we read all available input?
94122data More = Complete | Incomplete
95123 deriving (Eq, Show)
96124
97−data S = S {
98− input :: !B.ByteString
99− , _added :: B.ByteString
100− , more :: !More
101− } deriving (Show)
102−
103−instance Show r => Show (Result r) where
104− show (Fail _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg
105− show (Partial _) = "Partial _"
106− show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
107−
108−addS :: S -> S -> S
109−addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (c0 <> c1)
125+addS :: Input -> Added -> More
126+ -> Input -> Added -> More
127+ -> (Input -> Added -> More -> r) -> r
128+addS i0 a0 m0 _i1 a1 m1 f =
129+ f (I (unI i0 +++ unA a1)) (A (unA a0 +++ unA a1)) (m0 <> m1)
110130 where
111131 Complete <> _ = Complete
112132 _ <> Complete = Complete
@@ -115,11 +135,12 @@ addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (c0 <> c1)
115135
116136bindP :: Parser a -> (a -> Parser b) -> Parser b
117137bindP m g =
118− Parser (\st0 kf ks -> runParser m st0 kf (\s a -> runParser (g a) s kf ks))
138+ Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $
139+ \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks
119140{-# INLINE bindP #-}
120141
121142returnP :: a -> Parser a
122−returnP a = Parser (\st0 _kf ks -> ks st0 a)
143+returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
123144{-# INLINE returnP #-}
124145
125146instance Monad Parser where
@@ -127,15 +148,16 @@ instance Monad Parser where
127148 (>>=) = bindP
128149 fail = failDesc
129150
130−noAdds :: S -> S
131−noAdds (S s0 _a0 c0) = S s0 B.empty c0
151+noAdds :: Input -> Added -> More
152+ -> (Input -> Added -> More -> r) -> r
153+noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
132154{-# INLINE noAdds #-}
133155
134156plus :: Parser a -> Parser a -> Parser a
135−plus a b = Parser $ \st0 kf ks ->
136− let kf' st1 _ _ = runParser b (addS st0 st1) kf ks
137− !st2 = noAdds st0
138− in runParser a st2 kf' ks
157+plus a b = Parser $ \i0 a0 m0 kf ks ->
158+ let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
159+ \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
160+ in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
139161{-# INLINE plus #-}
140162
141163instance MonadPlus Parser where
@@ -144,7 +166,8 @@ instance MonadPlus Parser where
144166 mplus = plus
145167
146168fmapP :: (a -> b) -> Parser a -> Parser b
147−fmapP p m = Parser (\st0 f k -> runParser m st0 f (\s a -> k s (p a)))
169+fmapP p m = Parser $ \i0 a0 m0 f k ->
170+ runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)
148171{-# INLINE fmapP #-}
149172
150173instance Functor Parser where
@@ -178,48 +201,56 @@ instance Alternative Parser where
178201 (<|>) = plus
179202
180203failDesc :: String -> Parser a
181−failDesc err = Parser (\st0 kf _ks -> kf st0 [] msg)
204+failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
182205 where msg = "Failed reading: " ++ err
183206{-# INLINE failDesc #-}
184207
185208-- | Succeed only if at least @n@ bytes of input are available.
186209ensure :: Int -> Parser ()
187−ensure n = Parser $ \st0@(S s0 _a0 _c0) kf ks ->
188− if B.length s0 >= n
189− then ks st0 ()
190− else runParser (demandInput >> ensure n) st0 kf ks
210+ensure n = Parser $ \i0 a0 m0 kf ks ->
211+ if B.length (unI i0) >= n
212+ then ks i0 a0 m0 ()
213+ else runParser (demandInput >> ensure n) i0 a0 m0 kf ks
191214
192215-- | Ask for input. If we receive any, pass it to a success
193216-- continuation, otherwise to a failure continuation.
194−prompt :: S -> (S -> Result r) -> (S -> Result r) -> Result r
195−prompt (S s0 a0 _c0) kf ks = Partial $ \s ->
217+--prompt :: S -> (S -> Result r) -> (S -> Result r) -> Result r
218+prompt :: Input -> Added -> More
219+ -> (Input -> Added -> More -> Result r)
220+ -> (Input -> Added -> More -> Result r)
221+ -> Result r
222+prompt i0 a0 _m0 kf ks = Partial $ \s ->
196223 if B.null s
197− then kf $! S s0 a0 Complete
198− else ks $! S (s0 +++ s) (a0 +++ s) Incomplete
224+ then kf i0 a0 Complete
225+ else ks (I (unI i0 +++ s)) (A (unA a0 +++ s)) Incomplete
199226
200227-- | Immediately demand more input via a 'Partial' continuation
201228-- result.
202229demandInput :: Parser ()
203−demandInput = Parser $ \st0 kf ks ->
204− if more st0 == Complete
205− then kf st0 ["demandInput"] "not enough bytes"
206− else prompt st0 (\st -> kf st ["demandInput"] "not enough bytes") (`ks` ())
230+demandInput = Parser $ \i0 a0 m0 kf ks ->
231+ if m0 == Complete
232+ then kf i0 a0 m0 ["demandInput"] "not enough bytes"
233+ else let kf' i a m = kf i a m ["demandInput"] "not enough bytes"
234+ ks' i a m = ks i a m ()
235+ in prompt i0 a0 m0 kf' ks'
207236
208237-- | This parser always succeeds. It returns 'True' if any input is
209238-- available either immediately or on demand, and 'False' if the end
210239-- of all input has been reached.
211240wantInput :: Parser Bool
212−wantInput = Parser $ \st0@(S s0 _a0 c0) _kf ks ->
241+wantInput = Parser $ \i0 a0 m0 _kf ks ->
213242 case () of
214− _ | not (B.null s0) -> ks st0 True
215− | c0 == Complete -> ks st0 False
216− | otherwise -> prompt st0 (`ks` False) (`ks` True)
243+ _ | not (B.null (unI i0)) -> ks i0 a0 m0 True
244+ | m0 == Complete -> ks i0 a0 m0 False
245+ | otherwise -> let kf' i a m = ks i a m False
246+ ks' i a m = ks i a m True
247+ in prompt i0 a0 m0 kf' ks'
217248
218249get :: Parser B.ByteString
219−get = Parser (\st0 _kf ks -> ks st0 (input st0))
250+get = Parser $ \i0 a0 m0 _kf ks -> ks i0 a0 m0 (unI i0)
220251
221252put :: B.ByteString -> Parser ()
222−put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ())
253+put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()
223254
224255(+++) :: B.ByteString -> B.ByteString -> B.ByteString
225256(+++) = B.append
@@ -233,8 +264,10 @@ put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ())
233264-- lookahead. The downside to using this combinator is that it can
234265-- retain input for longer than is desirable.
235266try :: Parser a -> Parser a
236−try p = Parser $ \st0 kf ks ->
237− runParser p (noAdds st0) (kf . addS st0) ks
267+try p = Parser $ \i0 a0 m0 kf ks ->
268+ noAdds i0 a0 m0 $ \i1 a1 m1 ->
269+ let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf
270+ in runParser p i1 a1 m1 kf' ks
238271
239272-- | The parser @satisfy p@ succeeds for any byte for which the
240273-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -282,7 +315,8 @@ storable = hack undefined
282315 hack :: Storable b => b -> Parser b
283316 hack dummy = do
284317 (fp,o,_) <- B.toForeignPtr `fmapP` take (sizeOf dummy)
285− return . B.inlinePerformIO . withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)
318+ return . B.inlinePerformIO . withForeignPtr fp $ \p ->
319+ peek (castPtr $ p `plusPtr` o)
286320
287321-- | Consume @n@ bytes of input, but succeed only if the predicate
288322-- returns 'True'.
@@ -461,14 +495,17 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
461495
462496-- | Match only if all input has been consumed.
463497endOfInput :: Parser ()
464−endOfInput = Parser $ \st0@S{..} kf ks ->
465− if B.null input
466− then if more == Complete
467− then ks st0 ()
468− else let kf' st1 _ _ = ks (addS st0 st1) ()
469− ks' st1 _ = kf (addS st0 st1) [] "endOfInput"
470− in runParser demandInput st0 kf' ks'
471− else kf st0 [] "endOfInput"
498+endOfInput = Parser $ \i0 a0 m0 kf ks ->
499+ if B.null (unI i0)
500+ then if m0 == Complete
501+ then ks i0 a0 m0 ()
502+ else let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
503+ \ i2 a2 m2 -> ks i2 a2 m2 ()
504+ ks' i1 a1 m1 _ = addS i0 a0 m0 i1 a1 m1 $
505+ \ i2 a2 m2 -> kf i2 a2 m2 []
506+ "endOfInput"
507+ in runParser demandInput i0 a0 m0 kf' ks'
508+ else kf i0 a0 m0 [] "endOfInput"
472509
473510-- | Match either a single newline character @\'\\n\'@, or a carriage
474511-- return followed by a newline character @\"\\r\\n\"@.
@@ -479,19 +516,21 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
479516(<?>) :: Parser a
480517 -> String -- ^ the name to use if parsing fails
481518 -> Parser a
482−p <?> msg = Parser $ \s kf ks -> runParser p s (\s' strs m -> kf s' (msg:strs) m) ks
519+p <?> msg0 = Parser $ \i0 a0 m0 kf ks ->
520+ let kf' i a m strs msg = kf i a m (msg0:strs) msg
521+ in runParser p i0 a0 m0 kf' ks
483522{-# INLINE (<?>) #-}
484523infix 0 <?>
485524
486525-- | Terminal failure continuation.
487526failK :: Failure a
488−failK st0 stack msg = Fail st0 stack msg
527+failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg
489528
490529-- | Terminal success continuation.
491530successK :: Success a a
492−successK state a = Done state a
531+successK i0 _a0 _m0 a = Done (unI i0) a
493532
494533-- | Run a parser.
495534parse :: Parser a -> B.ByteString -> Result a
496−parse m s = runParser m (S s B.empty Incomplete) failK successK
535+parse m s = runParser m (I s) (A B.empty) Incomplete failK successK
497536{-# INLINE parse #-}