git.iko.soy/typeable/attoparsec
on master help sign in
Common implementations for 'prompt' and 'demandInput'.
commit69951a5cad84decb7f2a7131b7c3b3bb3fe95195 authorMikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> dateTue 10 Jun 2014, 13:59 (12 years ago) parentd24855b
4 files changed+75−45
Data/Attoparsec/ByteString/Internal.hs+1−21 Data/Attoparsec/Internal.hs+46−3 Data/Attoparsec/Internal/Types.hs+27 Data/Attoparsec/Text/Internal.hs+1−21
Data/Attoparsec/ByteString/Internal.hs+1−21
@@ -70,6 +70,7 @@ import Control.Monad (when)
7070import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
7171import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
7272import Data.Attoparsec.Combinator ((<?>))
73+import Data.Attoparsec.Internal
7374import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
7475import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
7576import Data.ByteString (ByteString)
@@ -467,27 +468,6 @@ ensure n = T.Parser $ \t pos more lose succ ->
467468-- Non-recursive so the bounds check can be inlined:
468469{-# INLINE ensure #-}
469470
470−-- | Ask for input. If we receive any, pass it to a success
471−-- continuation, otherwise to a failure continuation.
472−prompt :: Buffer -> Pos -> More
473− -> (Buffer -> Pos -> More -> IResult ByteString r)
474− -> (Buffer -> Pos -> More -> IResult ByteString r)
475− -> IResult ByteString r
476−prompt t pos _more lose succ = Partial $ \s ->
477− if B.null s
478− then lose t pos Complete
479− else succ (Buf.pappend t s) pos Incomplete
480−
481−-- | Immediately demand more input via a 'Partial' continuation
482−-- result.
483−demandInput :: Parser ()
484−demandInput = T.Parser $ \t pos more lose succ ->
485− case more of
486− Complete -> lose t pos more [] "not enough input"
487− _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
488− succ' t' pos' more' = succ t' pos' more' ()
489− in prompt t pos more lose' succ'
490−
491471-- | This parser always succeeds. It returns 'True' if any input is
492472-- available either immediately or on demand, and 'False' if the end
493473-- of all input has been reached.
Data/Attoparsec/Internal.hs+46−3
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
22-- |
33-- Module : Data.Attoparsec.Internal
44-- Copyright : Bryan O'Sullivan 2007-2014
@@ -12,10 +12,15 @@
1212-- library.
1313
1414module Data.Attoparsec.Internal
15− (
16− compareResults
15+ ( compareResults
16+ , prompt
17+ , demandInput
1718 ) where
1819
20+#if __GLASGOW_HASKELL__ >= 700
21+import Data.ByteString (ByteString)
22+import Data.Text (Text)
23+#endif
1924import Data.Attoparsec.Internal.Types
2025import Prelude hiding (succ)
2126
@@ -31,3 +36,41 @@ compareResults (Done t0 r0) (Done t1 r1) =
3136 Just (t0 == t1 && r0 == r1)
3237compareResults (Partial _) (Partial _) = Nothing
3338compareResults _ _ = Just False
39+
40+-- | Ask for input. If we receive any, pass it to a success
41+-- continuation, otherwise to a failure continuation.
42+prompt :: Chunk t
43+ => State t -> Pos -> More
44+ -> (State t -> Pos -> More -> IResult t r)
45+ -> (State t -> Pos -> More -> IResult t r)
46+ -> IResult t r
47+prompt t pos _more lose succ = Partial $ \s ->
48+ if nullChunk s
49+ then lose t pos Complete
50+ else succ (pappendChunk t s) pos Incomplete
51+#if __GLASGOW_HASKELL__ >= 700
52+{-# SPECIALIZE prompt :: State ByteString -> Pos -> More
53+ -> (State ByteString -> Pos -> More
54+ -> IResult ByteString r)
55+ -> (State ByteString -> Pos -> More
56+ -> IResult ByteString r)
57+ -> IResult ByteString r #-}
58+{-# SPECIALIZE prompt :: State Text -> Pos -> More
59+ -> (State Text -> Pos -> More -> IResult Text r)
60+ -> (State Text -> Pos -> More -> IResult Text r)
61+ -> IResult Text r #-}
62+#endif
63+
64+-- | Immediately demand more input via a 'Partial' continuation
65+-- result.
66+demandInput :: Chunk t => Parser t ()
67+demandInput = Parser $ \t pos more lose succ ->
68+ case more of
69+ Complete -> lose t pos more [] "not enough input"
70+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
71+ succ' t' pos' more' = succ t' pos' more' ()
72+ in prompt t pos more lose' succ'
73+#if __GLASGOW_HASKELL__ >= 700
74+{-# SPECIALIZE demandInput :: Parser ByteString () #-}
75+{-# SPECIALIZE demandInput :: Parser Text () #-}
76+#endif
Data/Attoparsec/Internal/Types.hs+27
@@ -15,20 +15,25 @@
1515module Data.Attoparsec.Internal.Types
1616 (
1717 Parser(..)
18+ , State
1819 , Failure
1920 , Success
2021 , Pos(..)
2122 , IResult(..)
2223 , More(..)
2324 , (<>)
25+ , Chunk(..)
2426 ) where
2527
2628import Control.Applicative (Alternative(..), Applicative(..), (<$>))
2729import Control.DeepSeq (NFData(rnf))
2830import Control.Monad (MonadPlus(..))
31+import Data.Word (Word8)
2932import Data.ByteString (ByteString)
33+import qualified Data.ByteString as BS
3034import Data.Monoid (Monoid(..))
3135import Data.Text (Text)
36+import qualified Data.Text as Text
3237import Prelude hiding (getChar, succ)
3338import qualified Data.Attoparsec.ByteString.Buffer as B
3439import qualified Data.Attoparsec.Text.Buffer as T
@@ -196,3 +201,25 @@ instance Alternative (Parser i) where
196201(<>) :: (Monoid m) => m -> m -> m
197202(<>) = mappend
198203{-# INLINE (<>) #-}
204+
205+-- | A common interface for input chunks.
206+class Monoid c => Chunk c where
207+ type ChunkElem c
208+ -- | Test if the chunk is empty.
209+ nullChunk :: c -> Bool
210+ -- | Append chunk to a buffer.
211+ pappendChunk :: State c -> c -> State c
212+
213+instance Chunk ByteString where
214+ type ChunkElem ByteString = Word8
215+ nullChunk = BS.null
216+ {-# INLINE nullChunk #-}
217+ pappendChunk = B.pappend
218+ {-# INLINE pappendChunk #-}
219+
220+instance Chunk Text where
221+ type ChunkElem Text = Char
222+ nullChunk = Text.null
223+ {-# INLINE nullChunk #-}
224+ pappendChunk = T.pappend
225+ {-# INLINE pappendChunk #-}
Data/Attoparsec/Text/Internal.hs+1−21
@@ -68,6 +68,7 @@ module Data.Attoparsec.Text.Internal
6868import Control.Applicative ((<|>), (<$>))
6969import Control.Monad (when)
7070import Data.Attoparsec.Combinator ((<?>))
71+import Data.Attoparsec.Internal
7172import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
7273import qualified Data.Attoparsec.Text.Buffer as Buf
7374import Data.Attoparsec.Text.Buffer (Buffer, buffer)
@@ -478,27 +479,6 @@ ensure n = T.Parser $ \t pos more lose succ ->
478479-- Non-recursive so the bounds check can be inlined:
479480{-# INLINE ensure #-}
480481
481−-- | Ask for input. If we receive any, pass it to a success
482−-- continuation, otherwise to a failure continuation.
483−prompt :: Buffer -> Pos -> More
484− -> (Buffer -> Pos -> More -> IResult Text r)
485− -> (Buffer -> Pos -> More -> IResult Text r)
486− -> IResult Text r
487−prompt t pos _more lose succ = Partial $ \s ->
488− if T.null s
489− then lose t pos Complete
490− else succ (Buf.pappend t s) pos Incomplete
491−
492−-- | Immediately demand more input via a 'Partial' continuation
493−-- result.
494−demandInput :: Parser ()
495−demandInput = T.Parser $ \t pos more lose succ ->
496− case more of
497− Complete -> lose t pos more [] "not enough input"
498− _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
499− succ' t' pos' more' = succ t' pos' more' ()
500− in prompt t pos more lose' succ'
501−
502482-- | This parser always succeeds. It returns 'True' if any input is
503483-- available either immediately or on demand, and 'False' if the end
504484-- of all input has been reached.