git.iko.soy/typeable/attoparsec
on master help sign in
Get the Char8 code up to snuff.
51082f4Bryan O'Sullivan
Data/Attoparsec.hs+51−19
@@ -15,44 +15,76 @@
15module Data.Attoparsec
15module Data.Attoparsec
16 (
16 (
17 -- * Parser types
17 -- * Parser types
18− Parser
18+ I.Parser
19− , Result
19+ , Result(..)
20
20
21 -- * Running parsers
21 -- * Running parsers
22 , parse
22 , parse
23 , parseTest
23 , parseTest
24+ , feed
24
25
25 -- * Combinators
26 -- * Combinators
26− , (<?>)
27+ , (I.<?>)
27− , try
28+ , I.try
28 , module Data.Attoparsec.Combinator
29 , module Data.Attoparsec.Combinator
29
30
30 -- * Parsing individual bytes
31 -- * Parsing individual bytes
31− , anyWord8
32+ , I.anyWord8
32− , notWord8
33+ , I.notWord8
33− , word8
34+ , I.word8
34− , satisfy
35+ , I.satisfy
35
36
36 -- ** Byte classes
37 -- ** Byte classes
37− , inClass
38+ , I.inClass
38− , notInClass
39+ , I.notInClass
39
40
40 -- * Efficient string handling
41 -- * Efficient string handling
41− , string
42+ , I.string
42− , skipWhile
43+ , I.skipWhile
43− , stringTransform
44+ , I.stringTransform
44− , takeTill
45+ , I.takeTill
45− , takeWhile
46+ , I.takeWhile
46− , takeWhile1
47+ , I.takeWhile1
47
48
48 -- * State observation functions
49 -- * State observation functions
49− , endOfInput
50+ , I.endOfInput
50 ) where
51 ) where
51
52
52import Data.Attoparsec.Combinator
53import Data.Attoparsec.Combinator
53−import Data.Attoparsec.Internal
54import Prelude hiding (takeWhile)
54import Prelude hiding (takeWhile)
55+import qualified Data.Attoparsec.Internal as I
55import qualified Data.ByteString as B
56import qualified Data.ByteString as B
56
57
58+data Result r = Fail B.ByteString [String] String
59+ | Partial (B.ByteString -> Result r)
60+ | Done B.ByteString r
61+
62+instance Show r => Show (Result r) where
63+ show (Fail bs stk msg) = "Fail " ++ show bs ++ show stk ++ " " ++ show msg
64+ show (Partial _) = "Partial _"
65+ show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
66+
67+feed :: Result r -> B.ByteString -> Result r
68+feed f@(Fail _ _ _) _ = f
69+feed (Partial k) d = k d
70+feed (Done bs r) d = Done (B.append bs d) r
71+
72+fmapR :: (a -> b) -> Result a -> Result b
73+fmapR _ (Fail st stk msg) = Fail st stk msg
74+fmapR f (Partial k) = Partial (fmapR f . k)
75+fmapR f (Done bs r) = Done bs (f r)
76+
77+instance Functor Result where
78+ fmap = fmapR
79+
57−parseTest :: (Show a) => Parser a -> B.ByteString -> IO ()
80+parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO ()
58parseTest p s = print (parse p s)
81parseTest p s = print (parse p s)
82+
83+translate :: I.Result a -> Result a
84+translate (I.Fail st stk msg) = Fail (I.input st) stk msg
85+translate (I.Partial k) = Partial (translate . k)
86+translate (I.Done st r) = Done (I.input st) r
87+
88+parse :: I.Parser a -> B.ByteString -> Result a
89+parse m s = translate (I.parse m s)
90+{-# INLINE parse #-}
Data/Attoparsec/Char8.hs+108−39
@@ -1,16 +1,15 @@
1−{-# LANGUAGE CPP #-}
2-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
3-- |
2-- |
4-- Module : Data.Attoparsec.Char8
3-- Module : Data.Attoparsec.Char8
5−-- Copyright : Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2009
4+-- Copyright : Bryan O'Sullivan 2007-2010
6-- License : BSD3
5-- License : BSD3
7--
6--
8-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : unknown
9-- Portability : unknown
11--
10--
12−-- Simple, efficient, character-oriented parser combinators for lazy
11+-- Simple, efficient, character-oriented parser combinators for
13−-- 'LB.ByteString' strings, loosely based on the Parsec library.
12+-- 'B.ByteString' strings, loosely based on the Parsec library.
14--
13--
15-- /Note/: This module is intended for parsing text that is
14-- /Note/: This module is intended for parsing text that is
16-- represented using an 8-bit character set, e.g. ASCII or
15-- represented using an 8-bit character set, e.g. ASCII or
@@ -21,17 +20,17 @@
21module Data.Attoparsec.Char8
20module Data.Attoparsec.Char8
22 (
21 (
23 -- * Parser types
22 -- * Parser types
24− ParseError
23+ Parser
25− , Parser
24+ , A.Result(..)
26
25
27 -- * Running parsers
26 -- * Running parsers
28− , parse
27+ , A.parse
29− , parseAt
30− , parseTest
28+ , A.parseTest
29+ , A.feed
31
30
32 -- * Combinators
31 -- * Combinators
33− , (<?>)
32+ , (I.<?>)
34− , try
33+ , I.try
35
34
36 -- * Parsing individual characters
35 -- * Parsing individual characters
37 , anyChar
36 , anyChar
@@ -48,57 +47,129 @@ module Data.Attoparsec.Char8
48 , notInClass
47 , notInClass
49
48
50 -- * Efficient string handling
49 -- * Efficient string handling
51− , string
50+ , I.string
52 , stringCI
51 , stringCI
53 , skipSpace
52 , skipSpace
54 , skipWhile
53 , skipWhile
55− , takeAll
54+ , take
56− , takeCount
57 , takeTill
55 , takeTill
58 , takeWhile
56 , takeWhile
59 , takeWhile1
57 , takeWhile1
60
58
61− -- ** Combinators
62− , match
63− , notEmpty
64−
65 -- * Text parsing
59 -- * Text parsing
66− , endOfLine
60+ , I.endOfLine
67
61
68 -- * Numeric parsers
62 -- * Numeric parsers
69− , int
63+ --, int
70− , integer
64+ --, integer
71− , double
65+ --, double
72
66
73 -- * State observation functions
67 -- * State observation functions
74− , endOfInput
68+ , I.endOfInput
75− , getConsumed
76− , getInput
77− , lookAhead
78
69
79 -- * Combinators
70 -- * Combinators
80 , module Data.Attoparsec.Combinator
71 , module Data.Attoparsec.Combinator
81 ) where
72 ) where
82
73
74+import Data.Attoparsec.Combinator
75+import Data.Attoparsec.FastSet (charClass, memberChar)
76+import Data.Attoparsec.Internal (Parser, (<?>))
83import Data.ByteString.Internal (c2w, w2c)
77import Data.ByteString.Internal (c2w, w2c)
78+import Data.ByteString.Lex.Double (readDouble)
84import Data.Char (isDigit, isLetter, isSpace, toLower)
79import Data.Char (isDigit, isLetter, isSpace, toLower)
85−import Data.Attoparsec.FastSet (charClass, memberChar)
86import Data.Word (Word8)
80import Data.Word (Word8)
81+import Prelude hiding (takeWhile)
82+import qualified Data.Attoparsec as A
87import qualified Data.Attoparsec.Internal as I
83import qualified Data.Attoparsec.Internal as I
88−import Data.Attoparsec.Combinator
84+import qualified Data.ByteString.Char8 as B
89−import Data.Attoparsec.Internal
90−import Data.ByteString.Lex.Double (readDouble)
91
85
92-- | Satisfy a literal string, ignoring case.
86-- | Satisfy a literal string, ignoring case.
93−stringCI :: LB.ByteString -> Parser LB.ByteString
87+stringCI :: B.ByteString -> Parser B.ByteString
94−stringCI = I.stringTransform (LB.map toLower)
88+stringCI = I.stringTransform (B.map toLower)
95{-# INLINE stringCI #-}
89{-# INLINE stringCI #-}
96
90
97−takeWhile1 :: (Char -> Bool) -> Parser LB.ByteString
91+takeWhile1 :: (Char -> Bool) -> Parser B.ByteString
98takeWhile1 p = I.takeWhile1 (p . w2c)
92takeWhile1 p = I.takeWhile1 (p . w2c)
99{-# INLINE takeWhile1 #-}
93{-# INLINE takeWhile1 #-}
100
94
95+-- | Character parser.
96+satisfy :: (Char -> Bool) -> Parser Char
97+satisfy p = w2c `fmap` I.satisfy (p . w2c)
98+{-# INLINE satisfy #-}
99+
100+letter :: Parser Char
101+letter = satisfy isLetter <?> "letter"
102+{-# INLINE letter #-}
103+
104+digit :: Parser Char
105+digit = satisfy isDigit <?> "digit"
106+{-# INLINE digit #-}
107+
108+anyChar :: Parser Char
109+anyChar = satisfy $ const True
110+{-# INLINE anyChar #-}
111+
112+space :: Parser Char
113+space = satisfy isSpace <?> "space"
114+{-# INLINE space #-}
115+
116+-- | Match a specific character.
117+char :: Char -> Parser Char
118+char c = satisfy (== c) <?> [c]
119+{-# INLINE char #-}
120+
121+-- | Match a specific character.
122+char8 :: Char -> Parser Word8
123+char8 c = I.satisfy (== c2w c) <?> [c]
124+{-# INLINE char8 #-}
125+
126+-- | Match any character except the given one.
127+notChar :: Char -> Parser Char
128+notChar c = satisfy (/= c) <?> "not " ++ [c]
129+{-# INLINE notChar #-}
130+
131+-- | Match any character in a set.
132+--
133+-- > vowel = inClass "aeiou"
134+--
135+-- Range notation is supported.
136+--
137+-- > halfAlphabet = inClass "a-nA-N"
138+--
139+-- To add a literal \'-\' to a set, place it at the beginning or end
140+-- of the string.
141+inClass :: String -> Char -> Bool
142+inClass s = (`memberChar` mySet)
143+ where mySet = charClass s
144+{-# INLINE inClass #-}
145+
146+-- | Match any character not in a set.
147+notInClass :: String -> Char -> Bool
148+notInClass s = not . inClass s
149+{-# INLINE notInClass #-}
150+
151+-- | Consume characters while the predicate succeeds.
152+takeWhile :: (Char -> Bool) -> Parser B.ByteString
153+takeWhile p = I.takeWhile (p . w2c)
154+{-# INLINE takeWhile #-}
155+
156+-- | Consume characters while the predicate fails.
157+takeTill :: (Char -> Bool) -> Parser B.ByteString
158+takeTill p = I.takeTill (p . w2c)
159+{-# INLINE takeTill #-}
160+
161+-- | Skip over characters while the predicate succeeds.
162+skipWhile :: (Char -> Bool) -> Parser ()
163+skipWhile p = I.skipWhile (p . w2c)
164+{-# INLINE skipWhile #-}
165+
166+-- | Skip over white space.
167+skipSpace :: Parser ()
168+skipSpace = skipWhile isSpace >> return ()
169+{-# INLINE skipSpace #-}
170+
171+{-
101−numeric :: String -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser a
172+numeric :: String -> (B.ByteString -> Maybe (a,B.ByteString)) -> Parser a
102numeric desc f = do
173numeric desc f = do
103 s <- getInput
174 s <- getInput
104 case f s of
175 case f s of
@@ -107,15 +178,13 @@ numeric desc f = do
107
178
108-- | Parse an integer. The position counter is not updated.
179-- | Parse an integer. The position counter is not updated.
109int :: Parser Int
180int :: Parser Int
110−int = numeric "Int" LB.readInt
181+int = numeric "Int" B.readInt
111
182
112-- | Parse an integer. The position counter is not updated.
183-- | Parse an integer. The position counter is not updated.
113integer :: Parser Integer
184integer :: Parser Integer
114−integer = numeric "Integer" LB.readInteger
185+integer = numeric "Integer" B.readInteger
115
186
116-- | Parse a Double. The position counter is not updated.
187-- | Parse a Double. The position counter is not updated.
117double :: Parser Double
188double :: Parser Double
118double = numeric "Double" readDouble
189double = numeric "Double" readDouble
119−
190+-}
120−#define PARSER Parser
121−#include "Char8Boilerplate.h"
Data/Attoparsec/Char8Boilerplate.hdeleted−77
@@ -1,77 +0,0 @@
1−-- -*- haskell -*-
2−
3−-- | Character parser.
4−satisfy :: (Char -> Bool) -> PARSER Char
5−satisfy p = w2c <$> I.satisfy (p . w2c)
6−{-# INLINE satisfy #-}
7−
8−letter :: PARSER Char
9−letter = satisfy isLetter <?> "letter"
10−{-# INLINE letter #-}
11−
12−digit :: PARSER Char
13−digit = satisfy isDigit <?> "digit"
14−{-# INLINE digit #-}
15−
16−anyChar :: PARSER Char
17−anyChar = satisfy $ const True
18−{-# INLINE anyChar #-}
19−
20−space :: PARSER Char
21−space = satisfy isSpace <?> "space"
22−{-# INLINE space #-}
23−
24−-- | Match a specific character.
25−char :: Char -> PARSER Char
26−char c = satisfy (== c) <?> [c]
27−{-# INLINE char #-}
28−
29−-- | Match a specific character.
30−char8 :: Char -> PARSER Word8
31−char8 c = I.satisfy (== c2w c) <?> [c]
32−{-# INLINE char8 #-}
33−
34−-- | Match any character except the given one.
35−notChar :: Char -> PARSER Char
36−notChar c = satisfy (/= c) <?> "not " ++ [c]
37−{-# INLINE notChar #-}
38−
39−-- | Match any character in a set.
40−--
41−-- > vowel = inClass "aeiou"
42−--
43−-- Range notation is supported.
44−--
45−-- > halfAlphabet = inClass "a-nA-N"
46−--
47−-- To add a literal \'-\' to a set, place it at the beginning or end
48−-- of the string.
49−inClass :: String -> Char -> Bool
50−inClass s = (`memberChar` mySet)
51− where mySet = charClass s
52−{-# INLINE inClass #-}
53−
54−-- | Match any character not in a set.
55−notInClass :: String -> Char -> Bool
56−notInClass s = not . inClass s
57−{-# INLINE notInClass #-}
58−
59−-- | Consume characters while the predicate succeeds.
60−takeWhile :: (Char -> Bool) -> PARSER LB.ByteString
61−takeWhile p = I.takeWhile (p . w2c)
62−{-# INLINE takeWhile #-}
63−
64−-- | Consume characters while the predicate fails.
65−takeTill :: (Char -> Bool) -> PARSER LB.ByteString
66−takeTill p = I.takeTill (p . w2c)
67−{-# INLINE takeTill #-}
68−
69−-- | Skip over characters while the predicate succeeds.
70−skipWhile :: (Char -> Bool) -> PARSER ()
71−skipWhile p = I.skipWhile (p . w2c)
72−{-# INLINE skipWhile #-}
73−
74−-- | Skip over white space.
75−skipSpace :: PARSER ()
76−skipSpace = skipWhile isSpace >> return ()
77−{-# INLINE skipSpace #-}
Data/Attoparsec/Internal.hs+10−6
@@ -18,6 +18,7 @@ module Data.Attoparsec.Internal
18 -- * Parser types
18 -- * Parser types
19 Parser
19 Parser
20 , Result(..)
20 , Result(..)
21+ , S(input)
21
22
22 -- * Running parsers
23 -- * Running parsers
23 , parse
24 , parse
@@ -135,14 +136,14 @@ instance Monad Parser where
135 (>>=) = bindP
136 (>>=) = bindP
136 fail = failDesc
137 fail = failDesc
137
138
138−clear :: S -> S
139+noAdds :: S -> S
139−clear (S s0 _a0 c0) = S s0 B.empty c0
140+noAdds (S s0 _a0 c0) = S s0 B.empty c0
140−{-# INLINE clear #-}
141+{-# INLINE noAdds #-}
141
142
142plus :: Parser a -> Parser a -> Parser a
143plus :: Parser a -> Parser a -> Parser a
143plus a b = Parser $ \st0 kf ks ->
144plus a b = Parser $ \st0 kf ks ->
144 let kf' st1 _ _ = runParser b (mappend st0 st1) kf ks
145 let kf' st1 _ _ = runParser b (mappend st0 st1) kf ks
145− in runParser a (clear st0) kf' ks
146+ in runParser a (noAdds st0) kf' ks
146{-# INLINE plus #-}
147{-# INLINE plus #-}
147
148
148instance MonadPlus Parser where
149instance MonadPlus Parser where
@@ -213,7 +214,7 @@ take n = takeWith n (const True)
213
214
214try :: Parser a -> Parser a
215try :: Parser a -> Parser a
215try p = Parser $ \st0 kf ks ->
216try p = Parser $ \st0 kf ks ->
216− runParser p (clear st0) (kf . mappend st0) ks
217+ runParser p (noAdds st0) (kf . mappend st0) ks
217
218
218satisfy :: (Word8 -> Bool) -> Parser Word8
219satisfy :: (Word8 -> Bool) -> Parser Word8
219satisfy p = do
220satisfy p = do
@@ -241,14 +242,15 @@ takeWith n p = do
241 if p h
242 if p h
242 then put t >> return h
243 then put t >> return h
243 else failDesc "takeWith"
244 else failDesc "takeWith"
244−{-# INLINE takeWith #-}
245
245
246string :: B.ByteString -> Parser B.ByteString
246string :: B.ByteString -> Parser B.ByteString
247string s = takeWith (B.length s) (==s)
247string s = takeWith (B.length s) (==s)
248+{-# INLINE string #-}
248
249
249stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
250stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
250 -> Parser B.ByteString
251 -> Parser B.ByteString
251stringTransform f s = takeWith (B.length s) ((==s) . f)
252stringTransform f s = takeWith (B.length s) ((==s) . f)
253+{-# INLINE stringTransform #-}
252
254
253skipWhile :: (Word8 -> Bool) -> Parser ()
255skipWhile :: (Word8 -> Bool) -> Parser ()
254skipWhile p = do
256skipWhile p = do
@@ -261,6 +263,7 @@ skipWhile p = do
261
263
262takeTill :: (Word8 -> Bool) -> Parser B.ByteString
264takeTill :: (Word8 -> Bool) -> Parser B.ByteString
263takeTill p = takeWhile (not . p)
265takeTill p = takeWhile (not . p)
266+{-# INLINE takeTill #-}
264
267
265takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
268takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
266takeWhile p = do
269takeWhile p = do
@@ -338,6 +341,7 @@ infix 0 <?>
338
341
339parse :: Parser a -> B.ByteString -> Result a
342parse :: Parser a -> B.ByteString -> Result a
340parse m s = runParser m (S s B.empty Incomplete) failK successK
343parse m s = runParser m (S s B.empty Incomplete) failK successK
344+{-# INLINE parse #-}
341
345
342feed :: Result r -> B.ByteString -> Result r
346feed :: Result r -> B.ByteString -> Result r
343feed f@(Fail _ _ _) _ = f
347feed f@(Fail _ _ _) _ = f
attoparsec.cabal+1−1
@@ -34,7 +34,7 @@ library
34
34
35 extensions: CPP
35 extensions: CPP
36 exposed-modules: Data.Attoparsec
36 exposed-modules: Data.Attoparsec
37− --Data.Attoparsec.Char8
37+ Data.Attoparsec.Char8
38 Data.Attoparsec.Combinator
38 Data.Attoparsec.Combinator
39 Data.Attoparsec.FastSet
39 Data.Attoparsec.FastSet
40 other-modules: Data.Attoparsec.Internal
40 other-modules: Data.Attoparsec.Internal
benchmarks/Arselet.hsnew file+49
@@ -0,0 +1,49 @@
1+module Main (main) where
2+
3+import Control.Monad
4+import qualified Data.ByteString as B
5+import qualified Data.ByteString.Lazy as L
6+import Data.Attoparsec.Char8 hiding (digit, letter)
7+import qualified Data.Attoparsec.Char8 as A
8+import System.Environment
9+
10+letter :: Parser Char
11+letter = satisfy $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
12+
13+digit :: Parser Char
14+digit = satisfy $ \c -> c >= '0' && c <= '9'
15+
16+letters :: Parser B.ByteString
17+letters = takeWhile1 $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
18+
19+digits :: Parser B.ByteString
20+digits = takeWhile1 $ \c -> c >= '0' && c <= '9'
21+
22+chunksOf :: Int -> B.ByteString -> [B.ByteString]
23+chunksOf n = go
24+ where go s | B.null s = []
25+ | otherwise = let (h,t) = B.splitAt n s
26+ in h : go t
27+
28+parseAll :: Parser a -> [B.ByteString] -> Result a
29+parseAll p ss = case ss of
30+ [] -> go (parse p B.empty) []
31+ (c:cs) -> go (parse p c) cs
32+ where go (Partial k) (c:cs) = go (k c) cs
33+ go (Partial k) [] = k B.empty
34+ go r _ = r
35+
36+main = do
37+ args <- getArgs
38+ forM_ args $ \arg -> do
39+ chunks <- if False
40+ then L.toChunks `fmap` L.readFile arg
41+ else do
42+ content <- B.readFile arg
43+ return $ if False
44+ then [content]
45+ else chunksOf 24 content
46+ let p1 = many (many1 letter `mplus` many1 digit)
47+ p2 = many (many1 A.letter `mplus` many1 A.digit)
48+ p3 = many (letters `mplus` digits)
49+ print (parseAll p3 chunks)