Bryan O'Sullivan avatar Bryan O'Sullivan committed 863c08c

Refactor a little

Comments (0)

Files changed (4)

Data/Aeson/Parser.hs

 module Data.Aeson.Parser
     (
       json
+    , value
     ) where
 
 import Control.Applicative as A
+import Data.Aeson.Types (Value(..))
 import Data.Attoparsec.Char8
-import Data.Aeson.Types (Value(..))
-import Data.Aeson.Parser.Internal (array, object)
+import Data.Bits (shiftL)
+import Data.ByteString as B
+import Data.Char (chr)
+import Data.Map as Map
+import Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Vector as Vector hiding ((++))
+import Data.Word (Word8)
+import qualified Data.Attoparsec as A
 
 json :: Parser Value
 json = do
     '{' -> skipSpace *> object
     '[' -> skipSpace *> array
     _   -> fail "root value is not an object or array"
+
+object :: Parser Value
+object = do
+  let pair = liftA2 (,) (jstring <* skipSpace) (char8 ':' *> skipSpace *> value)
+  vals <- (pair <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
+  _ <- char8 '}'
+  return . Object $ Map.fromList vals
+
+array :: Parser Value
+array = do
+  vals <- (value <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
+  _ <- char8 ']'
+  return . Array $ Vector.fromList vals
+
+value :: Parser Value
+value = most <|> (Number <$> double)
+ where
+  most = do
+    c <- anyChar
+    case c of
+      '{' -> skipSpace *> object
+      '[' -> skipSpace *> array
+      '"' -> String <$> jstring_
+      'f' -> string "alse" *> pure (Bool False)
+      't' -> string "rue" *> pure (Bool True)
+      'n' -> string "ull" *> pure Null
+      _   -> A.empty
+
+doubleQuote :: Word8
+doubleQuote = 34
+
+jstring :: Parser Text
+jstring = A.word8 doubleQuote *> jstring_
+
+-- | Parse a string without a leading quote.
+jstring_ :: Parser Text
+jstring_ = do
+  let backslash = 92
+  s <- A.scan False $ \s c -> if s then Just False
+                                   else if c == doubleQuote
+                                        then Nothing
+                                        else Just (c == backslash)
+  _ <- A.word8 doubleQuote
+  (decodeUtf8 . B.concat) <$> reparse unescape s
+
+reparse :: Parser a -> ByteString -> Parser a
+reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
+                Done "" r    -> return r
+                Fail _ _ msg -> fail msg
+                _            -> fail "unexpected failure"
+
+unescape :: Parser [ByteString]
+unescape = do
+  let backslash = 92
+  h <- A.takeWhile (/=backslash)
+  let rest = do
+        w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
+        case B.findIndex (==w) "\"\\/ntbrf" of
+          Just i ->
+               ([h,B.singleton $ B.index "\"\\/\n\t\b\r\f" i]++) <$> unescape
+          Nothing -> do
+               a <- reparse hexadecimal =<< A.take 4
+               if a < 0xd800 || a > 0xdfff
+                 then ([h,encodeUtf8 . T.singleton . chr $ a]++) <$> unescape
+                 else do
+                   _ <- string "\\u"
+                   b <- reparse hexadecimal =<< A.take 4
+                   if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
+                     then do
+                       let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
+                               0x10000
+                       ([h,encodeUtf8 . T.singleton . chr $ c]++) <$> unescape
+                     else fail "invalid UTF-16 surrogates"
+  rest <|> return [h]

Data/Aeson/Parser/Internal.hs

-{-# LANGUAGE OverloadedStrings #-}
-
-module Data.Aeson.Parser.Internal
-    (
-      value
-    , object
-    , array
-    ) where
-
-import Control.Applicative as A
-import Data.Aeson.Types (Value(..))
-import Data.Attoparsec.Char8
-import Data.Bits (shiftL)
-import Data.ByteString as B
-import Data.Char (chr)
-import Data.Map as Map
-import Data.Text as T
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import Data.Vector as Vector hiding ((++))
-import Data.Word (Word8)
-import qualified Data.Attoparsec as A
-
-object :: Parser Value
-object = do
-  let pair = liftA2 (,) (jstring <* skipSpace) (char8 ':' *> skipSpace *> value)
-  vals <- (pair <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
-  _ <- char8 '}'
-  return . Object $ Map.fromList vals
-
-array :: Parser Value
-array = do
-  vals <- (value <* skipSpace) `sepBy` (char8 ',' *> skipSpace)
-  _ <- char8 ']'
-  return . Array $ Vector.fromList vals
-
-value :: Parser Value
-value = most <|> (Number <$> double)
- where
-  most = do
-    c <- anyChar
-    case c of
-      '{' -> skipSpace *> object
-      '[' -> skipSpace *> array
-      '"' -> String <$> jstring_
-      'f' -> string "alse" *> pure (Bool False)
-      't' -> string "rue" *> pure (Bool True)
-      'n' -> string "ull" *> pure Null
-      _   -> A.empty
-
-doubleQuote :: Word8
-doubleQuote = 34
-
-jstring :: Parser Text
-jstring = A.word8 doubleQuote *> jstring_
-
--- | Parse a string without a leading quote.
-jstring_ :: Parser Text
-jstring_ = do
-  let backslash = 92
-  s <- A.scan False $ \s c -> if s then Just False
-                                   else if c == doubleQuote
-                                        then Nothing
-                                        else Just (c == backslash)
-  _ <- A.word8 doubleQuote
-  (decodeUtf8 . B.concat) <$> reparse unescape s
-
-reparse :: Parser a -> ByteString -> Parser a
-reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
-                Done "" r    -> return r
-                Fail _ _ msg -> fail msg
-                _            -> fail "unexpected failure"
-
-unescape :: Parser [ByteString]
-unescape = do
-  let backslash = 92
-  h <- A.takeWhile (/=backslash)
-  let rest = do
-        w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
-        case B.findIndex (==w) "\"\\/ntbrf" of
-          Just i ->
-               ([h,B.singleton $ B.index "\"\\/\n\t\b\r\f" i]++) <$> unescape
-          Nothing -> do
-               a <- reparse hexadecimal =<< A.take 4
-               if a < 0xd800 || a > 0xdfff
-                 then ([h,encodeUtf8 . T.singleton . chr $ a]++) <$> unescape
-                 else do
-                   _ <- string "\\u"
-                   b <- reparse hexadecimal =<< A.take 4
-                   if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
-                     then do
-                       let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
-                               0x10000
-                       ([h,encodeUtf8 . T.singleton . chr $ c]++) <$> unescape
-                     else fail "invalid UTF-16 surrogates"
-  rest <|> return [h]
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
     Data.Aeson
     Data.Aeson.Encode
     Data.Aeson.Parser
-    Data.Aeson.Parser.Internal
     Data.Aeson.Types
 
   build-depends:
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.