AttoJson (empty) → 0.5

raw patch · 4 files changed

+301/−0 lines, 4 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, bytestring-show, containers, mtl, utf8-string

Files

• AttoJson.cabal +64/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• Text/JSON/AttoJSON.hs +205/−0

@@ -0,0 +1,64 @@+-- AttoJson.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                AttoJson++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.5++-- A short (one-line) description of the package.+Synopsis:            Simple lightweight JSON parser based on ByteString++-- A longer description of the package.+Description: Simple Lightweight JSON parser based on ByteString++-- URL for the project homepage or repository.+Homepage:            http://github.com/konn/AttoJSON++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Hiromi ISHII++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          mr_konn _at_ jcom.home.ne.jp++-- A copyright notice.+-- Copyright:           ++Category:            Text++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.6++source-repository head+  type: git+  location: http://github.com/konn/AttoJSON/tree/master++Library+  -- Modules exported by the library.+  Exposed-modules:     Text.JSON.AttoJSON+  +  -- Packages needed in order to build this package.+  Build-depends: containers >=0.1, base >= 4 && < 5, bytestring-show >= 0.1, utf8-string >= 0.1, attoparsec >= 0.8, bytestring >= 0.9, mtl >= 1.0+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +  

@@ -0,0 +1,30 @@+Copyright (c)2010, Hiromi ISHII++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Hiromi ISHII nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fwarn-unused-imports #-}+module Text.JSON.AttoJSON (JSValue (..), getField, getFields, JSON(..), parseJSON, readJSON, showJSON) where+import Control.Applicative hiding (many)+import qualified Data.ByteString.Lazy as L (unpack)+import Control.Monad.Identity (runIdentity)+import Data.ByteString ( append, ByteString, replicate, unfoldr, take, reverse+                       , singleton, pack, intercalate, concat, unpack+                       )+import Data.Attoparsec ( maybeResult, parse, string, try, Parser, endOfInput+                       , parseWith, eitherResult, inClass, many, count, sepBy+                       , satisfy, option +                       )+import Data.Attoparsec.Char8 (char8, decimal, skipSpace, signed)+import Prelude hiding (concatMap, reverse, replicate, take, Show(..), concat)+import qualified Prelude as P (Show, reverse, map)+import Data.Foldable (foldrM)+import Data.Bits (shiftR, (.&.))+import Codec.Binary.UTF8.String (encode, decode)+import Data.Word (Word8)+import Text.Show.ByteString (show)+import Data.Ratio (denominator, numerator)+import Numeric (readHex)+import Data.Map (Map, fromList, elems, mapWithKey)+import qualified Data.Map as M (lookup)++fromLazy = pack . L.unpack++data JSValue = JSString {fromJSString :: !ByteString}+             | JSNumber Rational+             | JSObject (Map ByteString JSValue)+             | JSArray [JSValue]+             | JSBool !Bool+             | JSNull deriving (P.Show, Eq)++getField :: JSON a => ByteString -> JSValue -> Maybe a+getField key (JSObject dic) = M.lookup key dic >>= fromJSON+getField _ _                = Nothing++getFields :: JSON a => [ByteString] -> JSValue -> Maybe a+getFields keys jso = fromJSON =<< foldrM getField jso (P.reverse keys)++class JSON a where+    fromJSON :: JSValue -> Maybe a+    toJSON   :: a -> JSValue++instance JSON JSValue where+    fromJSON = return+    toJSON   = id++instance JSON Int where+    fromJSON (JSNumber a) = fromInteger <$> fromJSON (JSNumber a)+    fromJSON (JSString a) = maybeResult $ parse (signed decimal) a+    fromJSON _            = Nothing+    toJSON a              = JSNumber (fromIntegral a)++instance JSON Integer where+    fromJSON (JSNumber a) | denominator a == 1 = Just $ numerator a+                          | otherwise          = Nothing+    fromJSON (JSString a) = maybeResult $ parse (signed decimal) a+    fromJSON _            = Nothing+    toJSON a              = JSNumber (fromIntegral a)++instance JSON Double where+    fromJSON (JSNumber a) = Just $ fromRational a+    fromJSON _            = Nothing+    toJSON a              = JSNumber $ toRational a++instance JSON ByteString where+    fromJSON (JSString a) = Just a+    fromJSON _            = Nothing+    toJSON str            = JSString str++instance JSON String where+    fromJSON (JSString a) = Just $ w8sToStr $ unpack a+    fromJSON _            = Nothing+    toJSON str            = JSString $ pack $ strToW8s str++lexeme p = skipSpace *> p+symbol s = lexeme $ string s ++value :: Parser JSValue+value = jsString <|> number <|> object <|> array <|> try bool <|> try jsNull++parseJSON :: ByteString -> Either String JSValue+parseJSON = eitherResult . runIdentity . parseWith (return "") (value <* skipSpace <* endOfInput)+readJSON :: ByteString -> Maybe JSValue+readJSON = maybeResult . runIdentity . parseWith (return "") (value <* skipSpace <* endOfInput)++jsNull = lexeme (JSNull <$ symbol "null")+bool   = lexeme $+           JSBool True  <$ symbol "true"+       <|> JSBool False <$ symbol "false"+number = lexeme $ do+  sig   <- option 1 $ (-1 <$ char8 '-')+  int   <- decimal+  float <- option 0 frac+  pow  <- option 1 power+  return $ JSNumber (sig*(fromIntegral int+float)*pow)++frac = do+  char8 '.'+  dgs <- fromIntegral <$> decimal+  return (dgs / (10^^ceiling(logBase 10 (fromRational dgs))) )++power = do+  string "E" <|> string "e"+  sgn <- option 1 ((1 <$ char8 '+') <|> (-1 <$ char8 '-'))+  pow <- decimal+  return (10^^(sgn*pow))++array  = lexeme (symbol "[" *> (JSArray <$> (value `sepBy` (symbol ","))) <* symbol "]")++isControlChar ch = (0 <= ch && ch <= 31) || ch == 127+isNotHadaka ch = ch == 34 || ch == 92++w8sToStr :: [Word8] -> String+w8sToStr = map (toEnum . fromEnum)++strToW8s :: String -> [Word8]+strToW8s = map (toEnum . fromEnum)++chToW8 :: Char -> Word8+chToW8 = toEnum . fromEnum++w8ToCh :: Char -> Word8+w8ToCh = toEnum . fromEnum++jsString :: Parser JSValue+jsString = lexeme ( string "\"" *> (JSString . concat <$> many jsChar) <* string "\"")+jsChar :: Parser ByteString+jsChar = singleton <$> satisfy (\a -> not (isControlChar a || isNotHadaka a))+     <|> string "\\" *> (escapeChar <|> hex4digit)++escapeChar :: Parser ByteString+escapeChar = string "\"" +         <|> string "\\" +         <|> "\b" <$ char8 'b'+         <|> "\f" <$ char8 'f'+         <|> "/"  <$ char8 '/'+         <|> "\n" <$ char8 'n'+         <|> "\r" <$ char8 'r'+         <|> "\t" <$ char8 't'++hex4digit :: Parser ByteString+hex4digit = do+  string "u"+  ((hex, _):_) <- readHex . w8sToStr <$> count 4 (satisfy $ inClass "0-9a-zA-Z")+  return $ pack $ encode $ [toEnum hex]+object = lexeme ( symbol "{" *> (JSObject . fromList <$> (objMember `sepBy` symbol ",")) <* symbol "}")++objMember :: Parser (ByteString, JSValue)+objMember = lexeme ((,) <$> (fromJSString <$> jsString) <*> (symbol ":" *> value))++showJSON :: JSValue -> ByteString+showJSON (JSObject dic) = "{" `append` intercalate "," mems `append` "}"+  where+    mems = elems $ mapWithKey (\k v -> showJSString k `append` ":" `append` showJSON v) dic+showJSON (JSString jss)     = showJSString jss+showJSON (JSNumber jsn) | denominator jsn == 1 = fromLazy $ show $ numerator jsn+                        | otherwise            = fromLazy $ show (fromRational jsn :: Double)+showJSON (JSArray jss)      = "[" `append` intercalate ", " (P.map showJSON jss) `append` "]"+showJSON (JSNull)           = "null"+showJSON (JSBool True)      = "true"+showJSON (JSBool False)     = "false"++showJSString :: ByteString -> ByteString+showJSString js = "\"" `append` escape js `append` "\""+  where+    escape :: ByteString -> ByteString+    escapeCh :: Char -> ByteString+    escape = concat . P.map escapeCh . decode . unpack+    escapeCh '\\' = "\\\\"+    escapeCh '"'  = "\\\""+    escapeCh '\b' = "\\b"+    escapeCh '\f' = "\\f"+    escapeCh '/'  = "\\/"+    escapeCh '\n' = "\\n"+    escapeCh '\r' = "\\r"+    escapeCh '\t' = "\\t"+    escapeCh ch | mustEscape ch    = escapeHex $ fromEnum ch+                | otherwise        = singleton $ chToW8 ch++unfoldrStep :: (a -> Bool) -> (a -> Word8) -> (a -> a) -> a -> Maybe (Word8, a)+unfoldrStep p f g a | p a       = Nothing+                    | otherwise = Just (f a, g a)++mustEscape ch = ch < ' ' || ch == '\x7f' || ch > '\xff'++escapeHex :: Int -> ByteString+escapeHex c | c < 0x10000 = show4Hex c+            | otherwise   = astral c++show4Hex :: Int -> ByteString+show4Hex = ("\\u" `append`) . reverse . take 4 . (`append` replicate 4 48) . unfoldr (unfoldrStep (==0) (toHexWord8 .(`mod` 16)) (`div` 16)) ++astral :: Int -> ByteString+astral n = show4Hex (a + 0xd800) `append` show4Hex (b + 0xdc00)+  where+    a = (n `shiftR` 10) .&. 0x3ff+    b = n .&. 0x3ff++toHexWord8 :: Int -> Word8+toHexWord8 d | 0 <= d && d <= 9 = 48 + toEnum d+             | 10 <= d          = 87 + toEnum d