Skip to content
This repository
Browse code

Refactor a little

  • Loading branch information...
commit 35ce22d878feec2f5f8a4f68d0ebec810d0084f5 1 parent 42efd76
Bryan O'Sullivan authored
87 Data/Aeson/Parser.hs
@@ -3,12 +3,21 @@
3 3 module Data.Aeson.Parser
4 4 (
5 5 json
  6 + , value
6 7 ) where
7 8
8 9 import Control.Applicative as A
9   -import Data.Attoparsec.Char8
10 10 import Data.Aeson.Types (Value(..))
11   -import Data.Aeson.Parser.Internal (array, object)
  11 +import Data.Attoparsec.Char8
  12 +import Data.Bits (shiftL)
  13 +import Data.ByteString as B
  14 +import Data.Char (chr)
  15 +import Data.Map as Map
  16 +import Data.Text as T
  17 +import Data.Text.Encoding (decodeUtf8, encodeUtf8)
  18 +import Data.Vector as Vector hiding ((++))
  19 +import Data.Word (Word8)
  20 +import qualified Data.Attoparsec as A
12 21
13 22 json :: Parser Value
14 23 json = do
@@ -18,3 +27,77 @@ json = do
18 27 '{' -> skipSpace *> object
19 28 '[' -> skipSpace *> array
20 29 _ -> fail "root value is not an object or array"
  30 +
  31 +object :: Parser Value
  32 +object = do
  33 + let pair = liftA2 (,) (jstring <* skipSpace) (char8 ':' *> skipSpace *> value)
  34 + vals <- (pair <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
  35 + _ <- char8 '}'
  36 + return . Object $ Map.fromList vals
  37 +
  38 +array :: Parser Value
  39 +array = do
  40 + vals <- (value <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
  41 + _ <- char8 ']'
  42 + return . Array $ Vector.fromList vals
  43 +
  44 +value :: Parser Value
  45 +value = most <|> (Number <$> double)
  46 + where
  47 + most = do
  48 + c <- anyChar
  49 + case c of
  50 + '{' -> skipSpace *> object
  51 + '[' -> skipSpace *> array
  52 + '"' -> String <$> jstring_
  53 + 'f' -> string "alse" *> pure (Bool False)
  54 + 't' -> string "rue" *> pure (Bool True)
  55 + 'n' -> string "ull" *> pure Null
  56 + _ -> A.empty
  57 +
  58 +doubleQuote :: Word8
  59 +doubleQuote = 34
  60 +
  61 +jstring :: Parser Text
  62 +jstring = A.word8 doubleQuote *> jstring_
  63 +
  64 +-- | Parse a string without a leading quote.
  65 +jstring_ :: Parser Text
  66 +jstring_ = do
  67 + let backslash = 92
  68 + s <- A.scan False $ \s c -> if s then Just False
  69 + else if c == doubleQuote
  70 + then Nothing
  71 + else Just (c == backslash)
  72 + _ <- A.word8 doubleQuote
  73 + (decodeUtf8 . B.concat) <$> reparse unescape s
  74 +
  75 +reparse :: Parser a -> ByteString -> Parser a
  76 +reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
  77 + Done "" r -> return r
  78 + Fail _ _ msg -> fail msg
  79 + _ -> fail "unexpected failure"
  80 +
  81 +unescape :: Parser [ByteString]
  82 +unescape = do
  83 + let backslash = 92
  84 + h <- A.takeWhile (/=backslash)
  85 + let rest = do
  86 + w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
  87 + case B.findIndex (==w) "\"\\/ntbrf" of
  88 + Just i ->
  89 + ([h,B.singleton $ B.index "\"\\/\n\t\b\r\f" i]++) <$> unescape
  90 + Nothing -> do
  91 + a <- reparse hexadecimal =<< A.take 4
  92 + if a < 0xd800 || a > 0xdfff
  93 + then ([h,encodeUtf8 . T.singleton . chr $ a]++) <$> unescape
  94 + else do
  95 + _ <- string "\\u"
  96 + b <- reparse hexadecimal =<< A.take 4
  97 + if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
  98 + then do
  99 + let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
  100 + 0x10000
  101 + ([h,encodeUtf8 . T.singleton . chr $ c]++) <$> unescape
  102 + else fail "invalid UTF-16 surrogates"
  103 + rest <|> return [h]
95 Data/Aeson/Parser/Internal.hs
... ... @@ -1,95 +0,0 @@
1   -{-# LANGUAGE OverloadedStrings #-}
2   -
3   -module Data.Aeson.Parser.Internal
4   - (
5   - value
6   - , object
7   - , array
8   - ) where
9   -
10   -import Control.Applicative as A
11   -import Data.Aeson.Types (Value(..))
12   -import Data.Attoparsec.Char8
13   -import Data.Bits (shiftL)
14   -import Data.ByteString as B
15   -import Data.Char (chr)
16   -import Data.Map as Map
17   -import Data.Text as T
18   -import Data.Text.Encoding (decodeUtf8, encodeUtf8)
19   -import Data.Vector as Vector hiding ((++))
20   -import Data.Word (Word8)
21   -import qualified Data.Attoparsec as A
22   -
23   -object :: Parser Value
24   -object = do
25   - let pair = liftA2 (,) (jstring <* skipSpace) (char8 ':' *> skipSpace *> value)
26   - vals <- (pair <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
27   - _ <- char8 '}'
28   - return . Object $ Map.fromList vals
29   -
30   -array :: Parser Value
31   -array = do
32   - vals <- (value <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
33   - _ <- char8 ']'
34   - return . Array $ Vector.fromList vals
35   -
36   -value :: Parser Value
37   -value = most <|> (Number <$> double)
38   - where
39   - most = do
40   - c <- anyChar
41   - case c of
42   - '{' -> skipSpace *> object
43   - '[' -> skipSpace *> array
44   - '"' -> String <$> jstring_
45   - 'f' -> string "alse" *> pure (Bool False)
46   - 't' -> string "rue" *> pure (Bool True)
47   - 'n' -> string "ull" *> pure Null
48   - _ -> A.empty
49   -
50   -doubleQuote :: Word8
51   -doubleQuote = 34
52   -
53   -jstring :: Parser Text
54   -jstring = A.word8 doubleQuote *> jstring_
55   -
56   --- | Parse a string without a leading quote.
57   -jstring_ :: Parser Text
58   -jstring_ = do
59   - let backslash = 92
60   - s <- A.scan False $ \s c -> if s then Just False
61   - else if c == doubleQuote
62   - then Nothing
63   - else Just (c == backslash)
64   - _ <- A.word8 doubleQuote
65   - (decodeUtf8 . B.concat) <$> reparse unescape s
66   -
67   -reparse :: Parser a -> ByteString -> Parser a
68   -reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
69   - Done "" r -> return r
70   - Fail _ _ msg -> fail msg
71   - _ -> fail "unexpected failure"
72   -
73   -unescape :: Parser [ByteString]
74   -unescape = do
75   - let backslash = 92
76   - h <- A.takeWhile (/=backslash)
77   - let rest = do
78   - w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
79   - case B.findIndex (==w) "\"\\/ntbrf" of
80   - Just i ->
81   - ([h,B.singleton $ B.index "\"\\/\n\t\b\r\f" i]++) <$> unescape
82   - Nothing -> do
83   - a <- reparse hexadecimal =<< A.take 4
84   - if a < 0xd800 || a > 0xdfff
85   - then ([h,encodeUtf8 . T.singleton . chr $ a]++) <$> unescape
86   - else do
87   - _ <- string "\\u"
88   - b <- reparse hexadecimal =<< A.take 4
89   - if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
90   - then do
91   - let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
92   - 0x10000
93   - ([h,encodeUtf8 . T.singleton . chr $ c]++) <$> unescape
94   - else fail "invalid UTF-16 surrogates"
95   - rest <|> return [h]
3  Setup.lhs
... ... @@ -0,0 +1,3 @@
  1 +#!/usr/bin/env runhaskell
  2 +> import Distribution.Simple
  3 +> main = defaultMain
1  aeson.cabal
@@ -27,7 +27,6 @@ library
27 27 Data.Aeson
28 28 Data.Aeson.Encode
29 29 Data.Aeson.Parser
30   - Data.Aeson.Parser.Internal
31 30 Data.Aeson.Types
32 31
33 32 build-depends:

0 comments on commit 35ce22d

Please sign in to comment.
Something went wrong with that request. Please try again.