@@ -1,7 +1,7 @@
11{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}
22-- |
33-- Module : Data.Attoparsec.Internal
4−-- Copyright : Bryan O'Sullivan 2007-2010
4+-- Copyright : Bryan O'Sullivan 2007-2011
55-- License : BSD3
66--
77-- Maintainer : bos@serpentine.com
@@ -64,12 +64,11 @@ module Data.Attoparsec.Internal
6464 , endOfLine
6565 ) where
6666
67−import Control.Applicative (Alternative(..), Applicative(..), (<$>))
68−import Control.DeepSeq (NFData(rnf))
69−import Control.Monad (MonadPlus(..), when)
67+import Control.Applicative ((<|>), (<$>))
68+import Control.Monad (when)
7069import Data.Attoparsec.Combinator
7170import Data.Attoparsec.FastSet (charClass, memberWord8)
72−import Data.Monoid (Monoid(..))
71+import Data.Attoparsec.Internal.Types
7372import Data.Word (Word8)
7473import Foreign.ForeignPtr (withForeignPtr)
7574import Foreign.Ptr (castPtr, minusPtr, plusPtr)
@@ -79,148 +78,8 @@ import System.IO.Unsafe (unsafePerformIO)
7978import qualified Data.ByteString as B8
8079import qualified Data.ByteString.Char8 as B
8180import qualified Data.ByteString.Internal as B
82−import qualified Data.ByteString.Unsafe as B
8381import qualified Data.ByteString.Lazy as L
84−
85−-- | The result of a parse.
86−data Result r = Fail B.ByteString [String] String
87− -- ^ The parse failed. The 'B.ByteString' is the input
88− -- that had not yet been consumed when the failure
89− -- occurred. The @[@'String'@]@ is a list of contexts
90− -- in which the error occurred. The 'String' is the
91− -- message describing the error, if any.
92− | Partial (B.ByteString -> Result r)
93− -- ^ Supply this continuation with more input so that
94− -- the parser can resume. To indicate that no more
95− -- input is available, use an 'B.empty' string.
96− | Done B.ByteString r
97− -- ^ The parse succeeded. The 'B.ByteString' is the
98− -- input that had not yet been consumed (if any) when
99− -- the parse succeeded.
100−
101−instance Show r => Show (Result r) where
102− show (Fail bs stk msg) =
103− "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
104− show (Partial _) = "Partial _"
105− show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
106−
107−instance (NFData r) => NFData (Result r) where
108− rnf (Fail _ _ _) = ()
109− rnf (Partial _) = ()
110− rnf (Done _ r) = rnf r
111− {-# INLINE rnf #-}
112−
113−fmapR :: (a -> b) -> Result a -> Result b
114−fmapR _ (Fail st stk msg) = Fail st stk msg
115−fmapR f (Partial k) = Partial (fmapR f . k)
116−fmapR f (Done bs r) = Done bs (f r)
117−
118−instance Functor Result where
119− fmap = fmapR
120−
121−newtype Input = I {unI :: B.ByteString}
122−newtype Added = A {unA :: B.ByteString}
123−
124−-- | The 'Parser' type is a monad.
125−newtype Parser a = Parser {
126− runParser :: forall r. Input -> Added -> More
127− -> Failure r
128− -> Success a r
129− -> Result r
130− }
131−
132−type Failure r = Input -> Added -> More -> [String] -> String -> Result r
133−type Success a r = Input -> Added -> More -> a -> Result r
134−
135−-- | Have we read all available input?
136−data More = Complete | Incomplete
137− deriving (Eq, Show)
138−
139−addS :: Input -> Added -> More
140− -> Input -> Added -> More
141− -> (Input -> Added -> More -> r) -> r
142−addS i0 a0 m0 _i1 a1 m1 f =
143− let !i = I (unI i0 +++ unA a1)
144− a = A (unA a0 +++ unA a1)
145− !m = m0 <> m1
146− in f i a m
147− where
148− Complete <> _ = Complete
149− _ <> Complete = Complete
150− _ <> _ = Incomplete
151−{-# INLINE addS #-}
152−
153−bindP :: Parser a -> (a -> Parser b) -> Parser b
154−bindP m g =
155− Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $
156− \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks
157−{-# INLINE bindP #-}
158−
159−returnP :: a -> Parser a
160−returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
161−{-# INLINE returnP #-}
162−
163−instance Monad Parser where
164− return = returnP
165− (>>=) = bindP
166− fail = failDesc
167−
168−noAdds :: Input -> Added -> More
169− -> (Input -> Added -> More -> r) -> r
170−noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
171−{-# INLINE noAdds #-}
172−
173−plus :: Parser a -> Parser a -> Parser a
174−plus a b = Parser $ \i0 a0 m0 kf ks ->
175− let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
176− \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
177− in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
178−{-# INLINE plus #-}
179−
180−instance MonadPlus Parser where
181− mzero = failDesc "mzero"
182− {-# INLINE mzero #-}
183− mplus = plus
184−
185−fmapP :: (a -> b) -> Parser a -> Parser b
186−fmapP p m = Parser $ \i0 a0 m0 f k ->
187− runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)
188−{-# INLINE fmapP #-}
189−
190−instance Functor Parser where
191− fmap = fmapP
192−
193−apP :: Parser (a -> b) -> Parser a -> Parser b
194−apP d e = do
195− b <- d
196− a <- e
197− return (b a)
198−{-# INLINE apP #-}
199−
200−instance Applicative Parser where
201− pure = returnP
202− (<*>) = apP
203−
204− -- These definitions are equal to the defaults, but this
205− -- way the optimizer doesn't have to work so hard to figure
206− -- that out.
207− (*>) = (>>)
208− x <* y = x >>= \a -> y >> return a
209−
210−instance Monoid (Parser a) where
211− mempty = failDesc "mempty"
212− {-# INLINE mempty #-}
213− mappend = plus
214−
215−instance Alternative Parser where
216− empty = failDesc "empty"
217− {-# INLINE empty #-}
218− (<|>) = plus
219−
220−failDesc :: String -> Parser a
221−failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
222− where msg = "Failed reading: " ++ err
223−{-# INLINE failDesc #-}
82+import qualified Data.ByteString.Unsafe as B
22483
22584-- | If at least @n@ bytes of input are available, return the current
22685-- input, otherwise fail.
@@ -269,10 +128,6 @@ get = Parser $ \i0 a0 m0 _kf ks -> ks i0 a0 m0 (unI i0)
269128put :: B.ByteString -> Parser ()
270129put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()
271130
272−(+++) :: B.ByteString -> B.ByteString -> B.ByteString
273−(+++) = B.append
274−{-# INLINE (+++) #-}
275−
276131-- | Attempt a parse, and if it fails, rewind the input so that no
277132-- input appears to have been consumed.
278133--
@@ -328,7 +183,7 @@ storable = hack undefined
328183 where
329184 hack :: Storable b => b -> Parser b
330185 hack dummy = do
331− (fp,o,_) <- B.toForeignPtr `fmapP` take (sizeOf dummy)
186+ (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
332187 return . B.inlinePerformIO . withForeignPtr fp $ \p ->
333188 peek (castPtr $ p `plusPtr` o)
334189
@@ -341,7 +196,7 @@ takeWith n p = do
341196 t = B.unsafeDrop n s
342197 if p h
343198 then put t >> return h
344− else failDesc "takeWith"
199+ else fail "takeWith"
345200
346201-- | Consume exactly @n@ bytes of input.
347202take :: Int -> Parser B.ByteString
@@ -498,10 +353,10 @@ takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
498353takeWhile1 p = do
499354 (`when` demandInput) =<< B.null <$> get
500355 (h,t) <- B8.span p <$> get
501− when (B.null h) $ failDesc "takeWhile1"
356+ when (B.null h) $ fail "takeWhile1"
502357 put t
503358 if B.null t
504− then (h+++) `fmapP` takeWhile p
359+ then (h+++) `fmap` takeWhile p
505360 else return h
506361
507362-- | Match any byte in a set.