core/src/Streamly/Internal/Unicode/Parser.hs · streamly

git.iko.soy/streamly

on efe0be3 help sign in

streamly/core/src/Streamly/Internal/Unicode/Parser.hs

460 lines 15 kB history raw

1-- |

2-- Module : Streamly.Internal.Unicode.Parser

4-- License : BSD-3-Clause

5-- Maintainer : streamly@composewell.com

6-- Stability : experimental

7-- Portability : GHC

8--

9-- To parse a text input, use the decode routines from

10-- "Streamly.Unicode.Stream" module to convert an input byte stream to a

11-- Unicode Char stream and then use these parsers on the Char stream.

13module Streamly.Internal.Unicode.Parser

14 (

15 -- * Generic

16 char

17 , charIgnoreCase

19 -- * Sequences

20 , string

21 , stringIgnoreCase

22 , dropSpace

23 , dropSpace1

25 -- * Classes

26 , alpha

27 , alphaNum

28 , letter

29 , ascii

30 , asciiLower

31 , asciiUpper

32 , latin1

33 , lower

34 , upper

35 , mark

36 , printable

37 , punctuation

38 , separator

39 , space

40 , symbol

42 -- digits

43 , digit

44 , octDigit

45 , hexDigit

46 , numeric

48 -- * Numeric

49 , signed

50 , number

51 , double

52 , decimal

53 , hexadecimal

54 )

55where

57import Control.Applicative (Alternative(..))

58import Data.Bits (Bits, (.|.), shiftL)

59import Data.Char (ord)

60import Data.Ratio ((%))

61import Fusion.Plugin.Types (Fuse(..))

62import Streamly.Internal.Data.Parser (Parser(..), Initial(..), Step(..))

64import qualified Data.Char as Char

65import qualified Streamly.Data.Fold as Fold

66import qualified Streamly.Internal.Data.Parser as Parser

67 (

68 lmap

69 , satisfy

70 , listEq

71 , takeWhile1

72 , dropWhile

73 )

75--------------------------------------------------------------------------------

76-- Character classification

77--------------------------------------------------------------------------------

79-- XXX It may be possible to implement faster predicates for ASCII byte stream.

80-- We can measure if there is a signficant difference and if so we can add such

81-- predicates to Streamly.Unicode.Parser.Latin1.

82--

83#define CHAR_PARSER_SIG(NAME) NAME :: Monad m => Parser Char m Char

84-- XXX Need to use the predicates from Unicode.Char module/unicode-data package

85#define CHAR_PARSER(NAME, PREDICATE) NAME = Parser.satisfy Char.PREDICATE

86#define CHAR_PARSER_DOC(PREDICATE) -- | Match any character that satisfies 'Char.PREDICATE'

87#define CHAR_PARSER_INLINE(NAME) {-# INLINE NAME #-}

89CHAR_PARSER_DOC(isSpace)

90CHAR_PARSER_INLINE(space)

91CHAR_PARSER_SIG(space)

92CHAR_PARSER(space,isSpace)

94CHAR_PARSER_DOC(isLower)

95CHAR_PARSER_INLINE(lower)

96CHAR_PARSER_SIG(lower)

97CHAR_PARSER(lower,isLower)

99CHAR_PARSER_DOC(isUpper)

100CHAR_PARSER_INLINE(upper)

101CHAR_PARSER_SIG(upper)

102CHAR_PARSER(upper,isUpper)

103

104CHAR_PARSER_DOC(isAlpha)

105CHAR_PARSER_INLINE(alpha)

106CHAR_PARSER_SIG(alpha)

107CHAR_PARSER(alpha,isAlpha)

108

109CHAR_PARSER_DOC(isAlphaNum)

110CHAR_PARSER_INLINE(alphaNum)

111CHAR_PARSER_SIG(alphaNum)

112CHAR_PARSER(alphaNum,isAlphaNum)

113

114CHAR_PARSER_DOC(isPrint)

115CHAR_PARSER_INLINE(printable)

116CHAR_PARSER_SIG(printable)

117CHAR_PARSER(printable,isPrint)

118

119CHAR_PARSER_DOC(isDigit)

120CHAR_PARSER_INLINE(digit)

121CHAR_PARSER_SIG(digit)

122CHAR_PARSER(digit,isDigit)

123

124CHAR_PARSER_DOC(isOctDigit)

125CHAR_PARSER_INLINE(octDigit)

126CHAR_PARSER_SIG(octDigit)

127CHAR_PARSER(octDigit,isOctDigit)

128

129CHAR_PARSER_DOC(isHexDigit)

130CHAR_PARSER_INLINE(hexDigit)

131CHAR_PARSER_SIG(hexDigit)

132CHAR_PARSER(hexDigit,isHexDigit)

133

134CHAR_PARSER_DOC(isLetter)

135CHAR_PARSER_INLINE(letter)

136CHAR_PARSER_SIG(letter)

137CHAR_PARSER(letter,isLetter)

138

139CHAR_PARSER_DOC(isMark)

140CHAR_PARSER_INLINE(mark)

141CHAR_PARSER_SIG(mark)

142CHAR_PARSER(mark,isMark)

143

144CHAR_PARSER_DOC(isNumber)

145CHAR_PARSER_INLINE(numeric)

146CHAR_PARSER_SIG(numeric)

147CHAR_PARSER(numeric,isNumber)

148

149CHAR_PARSER_DOC(isPunctuation)

150CHAR_PARSER_INLINE(punctuation)

151CHAR_PARSER_SIG(punctuation)

152CHAR_PARSER(punctuation,isPunctuation)

153

154CHAR_PARSER_DOC(isSymbol)

155CHAR_PARSER_INLINE(symbol)

156CHAR_PARSER_SIG(symbol)

157CHAR_PARSER(symbol,isSymbol)

158

159CHAR_PARSER_DOC(isSeparator)

160CHAR_PARSER_INLINE(separator)

161CHAR_PARSER_SIG(separator)

162CHAR_PARSER(separator,isSeparator)

163

164CHAR_PARSER_DOC(isAscii)

165CHAR_PARSER_INLINE(ascii)

166CHAR_PARSER_SIG(ascii)

167CHAR_PARSER(ascii,isAscii)

168

169CHAR_PARSER_DOC(isLatin1)

170CHAR_PARSER_INLINE(latin1)

171CHAR_PARSER_SIG(latin1)

172CHAR_PARSER(latin1,isLatin1)

173

174CHAR_PARSER_DOC(isAsciiUpper)

175CHAR_PARSER_INLINE(asciiUpper)

176CHAR_PARSER_SIG(asciiUpper)

177CHAR_PARSER(asciiUpper,isAsciiUpper)

178

179CHAR_PARSER_DOC(isAsciiLower)

180CHAR_PARSER_INLINE(asciiLower)

181CHAR_PARSER_SIG(asciiLower)

182CHAR_PARSER(asciiLower,isAsciiLower)

183

184--------------------------------------------------------------------------------

185-- Character parsers

186--------------------------------------------------------------------------------

187

188-- | Match a specific character.

189{-# INLINE char #-}

190char :: Monad m => Char -> Parser Char m Char

191char c = Parser.satisfy (== c)

192

193-- XXX Case conversion may lead to change in number of chars

194-- | Match a specific character ignoring case.

195{-# INLINE charIgnoreCase #-}

196charIgnoreCase :: Monad m => Char -> Parser Char m Char

197charIgnoreCase c = Parser.lmap Char.toLower (Parser.satisfy (== Char.toLower c))

198

199--------------------------------------------------------------------------------

200-- Character sequences

201--------------------------------------------------------------------------------

202

203-- | Match the input with the supplied string and return it if successful.

204string :: Monad m => String -> Parser Char m String

205string = Parser.listEq

206

207-- XXX Not accurate unicode case conversion

208-- | Match the input with the supplied string and return it if successful.

209stringIgnoreCase :: Monad m => String -> Parser Char m String

210stringIgnoreCase s =

211 Parser.lmap Char.toLower (Parser.listEq (map Char.toLower s))

212

213-- | Drop /zero/ or more white space characters.

214dropSpace :: Monad m => Parser Char m ()

215dropSpace = Parser.dropWhile Char.isSpace

216

217-- | Drop /one/ or more white space characters.

218dropSpace1 :: Monad m => Parser Char m ()

219dropSpace1 = Parser.takeWhile1 Char.isSpace Fold.drain

220

221--------------------------------------------------------------------------------

222-- Numeric parsers

223--------------------------------------------------------------------------------

224

225-- XXX It should fail if the number is larger than the size of the type.

226--

227-- | Parse and decode an unsigned integral decimal number.

228{-# INLINE decimal #-}

229decimal :: (Monad m, Integral a) => Parser Char m a

230decimal = Parser.takeWhile1 Char.isDigit (Fold.foldl' step 0)

231

232 where

233

234 step a c = a * 10 + fromIntegral (ord c - 48)

235

236-- | Parse and decode an unsigned integral hexadecimal number. The hex digits

237-- @\'a\'@ through @\'f\'@ may be upper or lower case.

238--

239-- Note: This parser does not accept a leading @\"0x\"@ string.

240{-# INLINE hexadecimal #-}

241hexadecimal :: (Monad m, Integral a, Bits a) => Parser Char m a

242hexadecimal = Parser.takeWhile1 isHexDigit (Fold.foldl' step 0)

243

244 where

245

246 isHexDigit c =

247 (c >= '0' && c <= '9')

248 || (c >= 'a' && c <= 'f')

249 || (c >= 'A' && c <= 'F')

250

251 step a c

252 | w >= 48 && w <= 57 =

253 (a `shiftL` 4) .|. fromIntegral (w - 48)

254 | w >= 97 =

255 (a `shiftL` 4) .|. fromIntegral (w - 87)

256 | otherwise =

257 (a `shiftL` 4) .|. fromIntegral (w - 55)

258

259 where

260

261 w = ord c

262

263-- | Allow an optional leading @\'+\'@ or @\'-\'@ sign character before any

264-- parser.

265{-# INLINE signed #-}

266signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a

267signed p = (negate <$> (char '-' *> p)) <|> (char '+' *> p) <|> p

268

269type Multiplier = Int

270

271-- XXX We can use Int instead of Integer to make it twice as fast. But then we

272-- will have to truncate the significant digits before overflow occurs.

273type Number = Integer

274type DecimalPlaces = Int

275type PowerMultiplier = Int

276type Power = Int

277

278{-# ANN type ScientificParseState Fuse #-}

279data ScientificParseState

280 = SPInitial

281 | SPSign !Multiplier

282 | SPAfterSign !Multiplier !Number

283 | SPDot !Multiplier !Number

284 | SPAfterDot !Multiplier !Number !DecimalPlaces

285 | SPExponent !Multiplier !Number !DecimalPlaces

286 | SPExponentWithSign !Multiplier !Number !DecimalPlaces !PowerMultiplier

287 | SPAfterExponent !Multiplier !Number !DecimalPlaces !PowerMultiplier !Power

288

289-- | A generic parser for scientific notation of numbers. Returns (mantissa,

290-- exponent) tuple. The result can be mapped to 'Double' or any other number

291-- representation e.g. @Scientific@.

292--

293-- For example, using the @scientific@ package:

294-- >> parserScientific = uncurry Data.Scientific.scientific <$> 'number'

295{-# INLINE number #-}

296number :: Monad m => Parser Char m (Integer, Int)

297number = Parser (\s a -> return $ step s a) initial (return . extract)

298

299 where

300

301 intToInteger :: Int -> Integer

302 intToInteger = fromIntegral

303

304 combineNum buf num = buf * 10 + num

305

306 {-# INLINE initial #-}

307 initial = pure $ IPartial SPInitial

308

309 exitSPInitial msg =

310 "number: expecting sign or decimal digit, got " ++ msg

311 exitSPSign msg =

312 "number: expecting decimal digit, got " ++ msg

313 exitSPAfterSign multiplier num = (intToInteger multiplier * num, 0)

314 exitSPAfterDot multiplier num decimalPlaces =

315 ( intToInteger multiplier * num

316 , -decimalPlaces

317 )

318 exitSPAfterExponent mult num decimalPlaces powerMult powerNum =

319 let e = powerMult * powerNum - decimalPlaces

320 in (intToInteger mult * num, e)

321

322 {-# INLINE step #-}

323 step SPInitial val =

324 case val of

325 '+' -> Continue 0 (SPSign 1)

326 '-' -> Continue 0 $ (SPSign (-1))

327 _ -> do

328 let num = ord val - 48

329 if num >= 0 && num <= 9

330 then Partial 0 $ SPAfterSign 1 (intToInteger num)

331 else Error $ exitSPInitial $ show val

332 step (SPSign multiplier) val =

333 let num = ord val - 48

334 in if num >= 0 && num <= 9

335 then Partial 0 $ SPAfterSign multiplier (intToInteger num)

336 else Error $ exitSPSign $ show val

337 step (SPAfterSign multiplier buf) val =

338 case val of

339 '.' -> Continue 0 $ SPDot multiplier buf

340 'e' -> Continue 0 $ SPExponent multiplier buf 0

341 'E' -> Continue 0 $ SPExponent multiplier buf 0

342 _ ->

343 let num = ord val - 48

344 in if num >= 0 && num <= 9

345 then

346 Partial 0

347 $ SPAfterSign multiplier (combineNum buf (intToInteger num))

348 else Done 1 $ exitSPAfterSign multiplier buf

349 step (SPDot multiplier buf) val =

350 let num = ord val - 48

351 in if num >= 0 && num <= 9

352 then Partial 0 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) 1

353 else Done 2 $ exitSPAfterSign multiplier buf

354 step (SPAfterDot multiplier buf decimalPlaces) val =

355 case val of

356 'e' -> Continue 0 $ SPExponent multiplier buf decimalPlaces

357 'E' -> Continue 0 $ SPExponent multiplier buf decimalPlaces

358 _ ->

359 let num = ord val - 48

360 in if num >= 0 && num <= 9

361 then

362 Partial 0

363 $ SPAfterDot

364 multiplier

365 (combineNum buf (intToInteger num))

366 (decimalPlaces + 1)

367 else Done 1 $ exitSPAfterDot multiplier buf decimalPlaces

368 step (SPExponent multiplier buf decimalPlaces) val =

369 case val of

370 '+' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces 1)

371 '-' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces (-1))

372 _ -> do

373 let num = ord val - 48

374 if num >= 0 && num <= 9

375 then Partial 0 $ SPAfterExponent multiplier buf decimalPlaces 1 num

376 else Error $ exitSPInitial $ show val

377 step (SPExponentWithSign mult buf decimalPlaces powerMult) val =

378 let num = ord val - 48

379 in if num >= 0 && num <= 9

380 then Partial 0 $ SPAfterExponent mult buf decimalPlaces powerMult num

381 else Error $ exitSPSign $ show val

382 step (SPAfterExponent mult num decimalPlaces powerMult buf) val =

383 let n = ord val - 48

384 in if n >= 0 && n <= 9

385 then

386 Partial 0

387 $ SPAfterExponent

388 mult num decimalPlaces powerMult (combineNum buf n)

389 else

390 Done 1

391 $ exitSPAfterExponent mult num decimalPlaces powerMult buf

392

393 {-# INLINE extract #-}

394 extract SPInitial = Error $ exitSPInitial "end of input"

395 extract (SPSign _) = Error $ exitSPSign "end of input"

396 extract (SPAfterSign mult num) = Done 0 $ exitSPAfterSign mult num

397 extract (SPDot mult num) = Done 1 $ exitSPAfterSign mult num

398 extract (SPAfterDot mult num decimalPlaces) =

399 Done 0 $ exitSPAfterDot mult num decimalPlaces

400 extract (SPExponent mult num decimalPlaces) =

401 Done 1 $ exitSPAfterDot mult num decimalPlaces

402 extract (SPExponentWithSign mult num decimalPlaces _) =

403 Done 2 $ exitSPAfterDot mult num decimalPlaces

404 extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) =

405 Done 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum

406

407-- | Parse a decimal 'Double' value. This parser accepts an optional sign (+ or

408-- -) followed by at least one decimal digit. Decimal digits are optionally

409-- followed by a decimal point and at least one decimal digit after the point.

410-- This parser accepts the maximal valid input as long as it gives a valid

411-- number. Specifcally a trailing decimal point is allowed but not consumed.

412-- This function does not accept \"NaN\" or \"Infinity\" string representations

413-- of double values.

414--

415-- >>> import qualified Streamly.Data.Stream as Stream

416-- >>> import qualified Streamly.Unicode.Parser as Unicode

417--

418-- >>> p = Stream.parse Unicode.double . Stream.fromList

419--

420-- >>> p "-1.23e-123"

421-- Right (-1.23e-123)

422--

423-- Trailing input examples:

424--

425-- >>> p "1."

426-- Right 1.0

427--

428-- >>> p "1.2.3"

429-- Right 1.2

430--

431-- >>> p "1e"

432-- Right 1.0

433--

434-- >>> p "1e2.3"

435-- Right 100.0

436--

437-- >>> p "1+2"

438-- Right 1.0

439--

440-- Error cases:

441--

442-- >>> p ""

443-- Left (ParseError "number: expecting sign or decimal digit, got end of input")

444--

445-- >>> p ".1"

446-- Left (ParseError "number: expecting sign or decimal digit, got '.'")

447--

448-- >>> p "+"

449-- Left (ParseError "number: expecting decimal digit, got end of input")

450--

451{-# INLINE double #-}

452double :: Monad m => Parser Char m Double

453double = fmap f number

454

455 where

456

457 f (m, e) =

458 if e > 0

459 then fromIntegral (m * 10 ^ e)

460 else fromRational (m % 10 ^ (-e))