git.iko.soy/typeable/aeson
on master help sign in
Refactor a little
commit2bb111131a22c3819062d60f8d4a88dfa8e51432 authorBryan O'Sullivan <bos@mailrank.com> dateFri 21 Jan 2011, 15:22 (16 years ago) parentd254e34
4 files changed+88−98
compare with master
unifiedsplit
Data/Aeson/Parser.hs+85−2 Data/Aeson/Parser/Internal.hs−95 Setup.lhs+3 aeson.cabal−1
Data/Aeson/Parser.hs+85−2
@@ -3,12 +3,21 @@
33module Data.Aeson.Parser
44 (
55 json
6+ , value
67 ) where
78
89import Control.Applicative as A
9−import Data.Attoparsec.Char8
1010import 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
1221
1322json :: Parser Value
1423json = do
@@ -18,3 +27,77 @@ json = do
1827 '{' -> skipSpace *> object
1928 '[' -> skipSpace *> array
2029 _ -> 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]
Data/Aeson/Parser/Internal.hsdeleted−95
@@ -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]
Setup.lhsnew file+3
@@ -0,0 +1,3 @@
1+#!/usr/bin/env runhaskell
2+> import Distribution.Simple
3+> main = defaultMain
aeson.cabal−1
@@ -27,7 +27,6 @@ library
2727 Data.Aeson
2828 Data.Aeson.Encode
2929 Data.Aeson.Parser
30− Data.Aeson.Parser.Internal
3130 Data.Aeson.Types
3231
3332 build-depends: