json-b (empty) → 0.0.0
raw patch · 13 files changed
+1081/−0 lines, 13 filesdep +basedep +bytestringdep +bytestring-numssetup-changed
Dependencies added: base, bytestring, bytestring-nums, bytestring-trie, bytestringparser-temporary, containers, utf8-string
Files
- LICENSE +28/−0
- README +21/−0
- Setup.hs +4/−0
- Text/JSON/Escape.hs +76/−0
- Text/JSONb.hs +28/−0
- Text/JSONb/Decode.hs +213/−0
- Text/JSONb/Encode.hs +68/−0
- Text/JSONb/Schema.hs +193/−0
- Text/JSONb/Schema/Display.hs +111/−0
- Text/JSONb/Simple.hs +45/−0
- examples/JSONSchema.hs +104/−0
- json-b.cabal +57/−0
- test/SimpleUnits.hs +133/−0
+ LICENSE view
@@ -0,0 +1,28 @@++ ©2009 Jason Dusek.++ 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.++ . Names of the contributors to this software may not be used to endorse or+ promote products derived from this software without specific prior written+ permission.++ This software is provided by the 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 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. +
+ README view
@@ -0,0 +1,21 @@+ JSONb is a library for parsing JSON from lazy ByteStrings. It assumes the+ input is UTF-8.+++ Test Suite+ ----------------------------------------------------------------------------++ We test the library by:++ . Pulling down large amounts of JSON from various web service providers.++ . Parsing and unparsing the JSON with our parser.++ . Feeding the original JSON along with our unparsed variety to the+ json.org parser.++ . Testing that our parsed-unparsed JSON parses to the same JavaScript+ values as the original JSON from the point of view of the json.org+ parser.++
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+
+ Text/JSON/Escape.hs view
@@ -0,0 +1,76 @@+++{-# LANGUAGE TypeSynonymInstances+ #-}+++module Text.JSON.Escape where+++import Data.Char+import Data.List+import qualified Data.ByteString.Lazy.Char8 as Lazy+import qualified Data.ByteString.Char8 as Strict+++++{-| Class of JSON escapable text. The solidus (@/@) is always escaped, as are+ all ASCII control characters. Non-ASCII control characters + -}+class Escape t where+ escape :: t -> t+instance Escape Strict.ByteString where+ escape = Strict.concatMap (Strict.pack . esc)+instance Escape Lazy.ByteString where+ escape = Lazy.concatMap (Lazy.pack . esc)+instance Escape String where+ escape = concatMap esc+++{-| Escapes an individual character for embedding in a JSON string.+ -}+esc :: Char -> String+esc c = case c of+ '"' -> "\\\""+ '\\' -> "\\\\"+ '/' -> "\\/"+ '\NUL' -> "\\u0000"+ '\SOH' -> "\\u0001"+ '\STX' -> "\\u0002"+ '\ETX' -> "\\u0003"+ '\EOT' -> "\\u0004"+ '\ENQ' -> "\\u0005"+ '\ACK' -> "\\u0006"+ '\a' -> "\\u0007"+ '\b' -> "\\b"+ '\t' -> "\\t"+ '\n' -> "\\n"+ '\v' -> "\\u000b"+ '\f' -> "\\f"+ '\r' -> "\\r"+ '\SO' -> "\\u000e"+ '\SI' -> "\\u000f"+ '\DLE' -> "\\u0010"+ '\DC1' -> "\\u0011"+ '\DC2' -> "\\u0012"+ '\DC3' -> "\\u0013"+ '\DC4' -> "\\u0014"+ '\NAK' -> "\\u0015"+ '\SYN' -> "\\u0016"+ '\ETB' -> "\\u0017"+ '\CAN' -> "\\u0018"+ '\EM' -> "\\u0019"+ '\SUB' -> "\\u001a"+ '\ESC' -> "\\u001b"+ '\FS' -> "\\u001c"+ '\GS' -> "\\u001d"+ '\RS' -> "\\u001e"+ '\US' -> "\\u001f"+ '\DEL' -> "\\u007f"+ _ -> [c]+++escaped c = esc c /= [c]++
+ Text/JSONb.hs view
@@ -0,0 +1,28 @@+++{-| ByteString parser for a simple, monomorphic JSON datatype.+ -}+module Text.JSONb+ ( Text.JSONb.Simple.JSON(..)+ , Text.JSONb.Decode.decode+ , Text.JSONb.Decode.break+ , Text.JSONb.Encode.Style(..)+ , Text.JSONb.Encode.encode+ , Text.JSONb.Schema.Schema()+ , Text.JSONb.Schema.schema+ , Text.JSONb.Schema.schemas+ , Text.JSONb.Schema.OneMany(..)+ , Text.JSONb.Schema.Display.Display(..)+ , Text.JSON.Escape.Escape(..)+ , Text.JSON.Escape.escaped+ ) where+++import Text.JSONb.Simple+import Text.JSONb.Decode+import Text.JSONb.Encode+import Text.JSONb.Schema+import Text.JSONb.Schema.Display+import Text.JSON.Escape++
+ Text/JSONb/Decode.hs view
@@ -0,0 +1,213 @@+++{-# LANGUAGE ScopedTypeVariables+ , ParallelListComp+ #-}+++{-| Parse UTF-8 JSON into native Haskell types.+ -}+++module Text.JSONb.Decode where+++import Data.Char+import Prelude hiding (null, last, takeWhile)+import qualified Data.ByteString as ByteString.Strict+import Data.ByteString.Lazy.Char8+ hiding (reverse, null, takeWhile, elem, concatMap)+import Control.Applicative hiding (empty)++import qualified Data.ByteString.Lazy.UTF8 as UTF8+import qualified Data.Trie.Convenience as Trie+import Data.ParserCombinators.Attoparsec.Char8 hiding (string)+import qualified Data.ParserCombinators.Attoparsec.Char8 as Attoparsec+import Data.ByteString.Nums.Careless++import Text.JSONb.Simple+++++{-| Interpret a 'ByteString' as any JSON literal.+ -}+decode :: ByteString -> Either (ParseError, ByteString) JSON+decode bytes = case Attoparsec.parse json bytes of+ (remainder, Left e) -> Left (e, remainder)+ (r, Right j) -> Right j+++{-| Split out the first parseable JSON literal from the input, returning+ the result of the attempt along with the remainder of the input or the+ whole input if not parseable item was discovered.+ -}+break :: ByteString -> (Either ParseError JSON, ByteString)+break bytes = case Attoparsec.parse json bytes of+ (_, Left e) -> (Left e, bytes)+ (remainder, result) -> (result, remainder)+++{-| Tries to parse any JSON literal.+ -}+json :: Parser JSON+json = do+ whitespace+ choice [object, array, string, number, boolean, null]+++{-| Parse a JSON object (dictionary).+ -}+object :: Parser JSON+object = do+ char '{'+ whitespace+ Object . Trie.fromListS <$> properties []+ where+ properties acc = do+ key <- string_literal+ whitespace+ char ':'+ something <- json+ whitespace+ let+ acc' = (strictify key, something) : acc+ choice+ [ char ',' >> whitespace >> choice+ [ char '}' >> return acc'+ , properties acc'+ ]+ , char '}' >> return acc'+ ]+++{-| Parse a JSON array.+ -}+array :: Parser JSON+array = do+ char '['+ Array <$> elements []+ where+ elements acc = do+ something <- json+ whitespace+ let+ acc' = something : acc+ finish = char ']' >> return (reverse acc')+ choice+ [ char ',' >> whitespace >> choice [finish, elements acc']+ , finish+ ]+++{-| Parses a string literal, unescaping as it goes.+ -}+string :: Parser JSON+string = String . strictify <$> string_literal+++{-| Parses a numeric literal to a @Rational@.+ -}+number :: Parser JSON+number = Number <$> do+ (sign :: Rational) <- '-' ?> (-1) <|> pure 1+ n <- choice+ [ do+ integer_part <- digits+ char '.'+ fractional_part <- digits+ return $ float (integer_part `snoc` '.' `append` fractional_part)+ , do+ char '.'+ fractional_part <- digits+ return $ float ('.' `cons` fractional_part)+ , do+ integer_part <- digits+ return $ int integer_part+ ]+ (exponent <*> pure (sign * n)) <|> (ended >> return (sign * n))+ where+ c ?> r = char c >> pure r+ digits = takeWhile1 isDigit+ exponent :: Parser (Rational -> Rational)+ exponent = do+ char 'e' <|> char 'E'+ op <- '-' ?> (/) <|> '+' ?> (*) <|> pure (*)+ (e :: Int) <- int <$> digits+ pure (`op` (10^e)) + ended = notFollowedBy $ satisfy oops+ where+ oops c = isAlphaNum c || elem c ".+-"+++{-| Parse a JSON Boolean literal.+ -}+boolean :: Parser JSON+boolean = Boolean <$> choice+ [ Attoparsec.string "true" >> return True+ , Attoparsec.string "false" >> return False+ ]+++{-| Parse a JSON null literal.+ -}+null :: Parser JSON+null = Attoparsec.string "null" >> return Null+++++{-| Per RFC 4627, section 2 "JSON Grammar", only a limited set of whitespace+ characters actually count as insignificant whitespace. + -}+whitespace :: Parser ()+whitespace = skipMany (satisfy w)+ where+ w ' ' = True -- ASCII space.+ w '\n' = True -- Newline.+ w '\r' = True -- Carriage return.+ w '\t' = True -- Horizontal tab.+ w _ = False -- Not a JSON space.+++{-| Parse a JSON string literal and unescape it but don't wrap it in a string+ constructor (we might wrap it as a dict key instead).+ -}+string_literal :: Parser ByteString+string_literal = char '"' >> recurse empty+ where+ recurse acc = do+ text <- takeWhile (not . (`elem` "\\\""))+ choice+ [ char '"' >> return (acc `append` text)+ , do+ char '\\'+ c <- escape_sequence+ recurse (acc `append` text `append` UTF8.fromString [c])+ ]+ where+ escape_sequence = do+ choice [ c >> r | c <- fmap char "n/\"rfbt\\u"+ | r <- fmap return "\n/\"\r\f\b\t\\" ++ [u] ]+ where+ u = do+ (a,b,c,d) <- (,,,) <$> hex <*> hex <*> hex <*> hex+ return . toEnum $ a * 0x1000+ + b * 0x100+ + c * 0x10+ + d * 0x1+ where + hex = choice digits+ where+ prep (n, chars) = fmap (fmap ((+n) . ord) . char) chars+ digits = concatMap prep [ (-48, ['0'..'9'])+ , (-55, ['A'..'F'])+ , (-87, ['a'..'f']) ]+++{-| Turn a lazy 'ByteString' in to a strict 'ByteString.Strict.ByteString'.+ -}+strictify :: ByteString -> ByteString.Strict.ByteString+strictify = ByteString.Strict.concat . toChunks++
+ Text/JSONb/Encode.hs view
@@ -0,0 +1,68 @@+++{-# LANGUAGE StandaloneDeriving+ #-}+++module Text.JSONb.Encode where+++import Data.Ratio+import Data.ByteString.Char8+import qualified Data.ByteString.Lazy as Lazy++import Data.Trie hiding (singleton)++import Text.JSONb.Simple+import Text.JSON.Escape+++++{-| Encode 'JSON' as a lazy 'Lazy.ByteString'. All strings are treated as+ UTF-8; ASCII control characters are escaped and UTF-8 multi-char sequences+ are simply passed through.+ -}+encode :: Style -> JSON -> Lazy.ByteString+encode style = Lazy.fromChunks . (:[]) . encode' style+++{-| Encode 'JSON' as a strict 'ByteString'. All strings are treated as UTF-8;+ ASCII control characters are escaped and UTF-8 multi-char sequences are+ simply passed through.+ -}+encode' :: Style -> JSON -> ByteString+encode' style@Compact json = case json of+ Object trie -> '{' `cons` pairs trie `snoc` '}'+ Array elems -> '[' `cons` elements elems `snoc` ']'+ String s -> stringify s+ Number r+ | denominator r == 1 -> (pack . show . numerator) r+ | otherwise -> (pack . show) (fromRational r :: Double)+ Boolean True -> pack "true"+ Boolean False -> pack "false"+ Null -> pack "null"+ where+ comcat = intercalate (singleton ',')+ elements = comcat . fmap (encode' style)+ pairs = comcat . toListBy pair+ where+ pair k v = stringify k `snoc` ':' `append` encode' style v+++{-| Style of serialization. Compact is the only one that is implemented at+ present.+ -}+data Style = Compact -- | LightSpaces | Indented+deriving instance Show Style+deriving instance Eq Style+++{-| Escape a 'ByteString' representing a JSON string and wrap it in quote+ marks.+ -}+stringify :: ByteString -> ByteString+stringify s = '"' `cons` escape s `snoc` '"'+++
+ Text/JSONb/Schema.hs view
@@ -0,0 +1,193 @@+++{-# LANGUAGE StandaloneDeriving+ , RelaxedPolyRec+ #-}+++module Text.JSONb.Schema where+++import Data.Ord+import Data.Word+import Data.List (permutations)+import Data.Set as Set++import Data.Trie as Trie++import qualified Text.JSONb.Simple as Simple+++++{-++ JSON Schemas:++ document ::= array++ element ::= num | str | null | bool | object | array++ object ::= "{" Set(element) "}"++ array ::= "[" List(element) "]"++ num ::= "num"+ str ::= "str"+ null ::= "null"+ bool ::= "bool"++ -}+++++{-| The type of JSON schemas. We treat the atomic types simply whereas objects+ and arrays are treated specially.++ Objects are treated as maps of keys to sets of schema types. Say a certain+ type of object sometimes has a string at a certain key and sometimes has a+ null at that key; we should merge them and say the schema of that key is a+ union of string and null.++ Arrays admit measure in the sense of how many elements there are of a+ certain kind. We support three measures at present: any, one or more and+ individual counts. We expect the "any" measure to prevail practice. Arrays+ are also ordered; so one can distinguish an array that interleaves strings+ and ints from one that is all strings and then all ints.+ -}+data Schema counter+ = Num+ | Str+ | Bool+ | Null+ | Obj (Props counter)+ | Arr (Elements counter)+deriving instance (Eq counter) => Eq (Schema counter)+deriving instance (Ord counter) => Ord (Schema counter)+++{-| Determine a schema for one JSON data item.+ -}+schema :: (Counter counter) => Simple.JSON -> Schema counter+schema json = case json of+ Simple.Object trie -> Obj $ props trie+ Simple.Array list -> Arr . Elements $ schemas list+ Simple.String _ -> Str+ Simple.Number _ -> Num+ Simple.Boolean _ -> Bool+ Simple.Null -> Null+++props :: (Counter counter) => Trie.Trie Simple.JSON -> Props counter+props = Props . fmap (Set.singleton . schema)+++{-| Develop a schema for a list of JSON data, collating schemas according to+ the measure, a well-ordered semigroup. + -}+schemas :: (Counter counter) => [Simple.JSON] -> [(counter, Schema counter)] +schemas json = foldr collate []+ [ (bottom, schema e) | e <- json ]+++{-| Collate a list of counted schemas. Alike counted schemas that are adjacent+ are replaced by a counted schema with an incremented counter. This+ operation is mutually recursive with 'merge', in order to merge comaptible+ object definitions before collating.+ -}+collate+ :: (Counter counter, Counter counter')+ => (counter, Schema counter')+ -> [(counter, Schema counter')]+ -> [(counter, Schema counter')]+collate s [] = [s]+collate (c0, Obj p0) ((c1, Obj p1):t)+ | match p0 p1 = (c0 `plus` c1, Obj $ merge p0 p1):t+ | otherwise = (c0, Obj p0):(c1, Obj p1):t+collate (c0, schema0) ((c1, schema1):t)+ | schema0 == schema1 = (c0 `plus` c1, schema0):t+ | otherwise = (c0, schema0):(c1, schema1):t+++++data Props counter = Props (Trie.Trie (Set.Set (Schema counter)))+deriving instance (Eq counter) => Eq (Props counter)+instance (Ord counter) => Ord (Props counter) where+ compare (Props trie0) (Props trie1) = comparing Trie.toList trie0 trie1++{-| Merge two property sets. This operation is mutually recursive with our+ 'collate' and relies on polymorphic recusion in 'collate'.+ -}+merge+ :: (Counter counter)+ => Props counter+ -> Props counter+ -> Props counter+merge (Props a) (Props b) = Props $ Trie.mergeBy ((Just .) . merge') a b+ where+ merge' = ((count_in . merge'' . count_out) .) . Set.union+ where+ -- We use the unary (existence) counter so that it collates set-like. + count_out = fmap ((,) ()) . Set.toList+ count_in = Set.fromList . fmap snd+ merge'' [ ] = []+ merge'' (h:t) = foldr collate' t (h:t)+ where+ -- We expect only very small sets of schemas.+ collate' schema = shortest . fmap (collate schema) . permutations+ shortest [ ] = []+ shortest (h:t) = foldr shortest' h t+ where+ shortest' x h+ | length h < length x = h+ | otherwise = x++match+ :: (Counter counter)+ => Props counter+ -> Props counter+ -> Bool+match (Props a) (Props b) = Trie.keys a == Trie.keys b+++data Elements counter = Elements [(counter, Schema counter)]+deriving instance (Eq counter) => Eq (Elements counter)+deriving instance (Ord counter) => Ord (Elements counter)+++data OneMany = One | Many+deriving instance Eq OneMany+deriving instance Ord OneMany+deriving instance Show OneMany+++++{-| A well-ordered semigroup has a minimal element and an associative+ operation. These are used to provide measures for schema. At present, we+ allow three measures: whether there is one or more of a schema (measured+ with '()'), whether there is one or more than one of an item (measured with+ 'OneMany') and positive counts of items (measured with 'Word').+ -}+class (Eq t, Show t, Ord t) => Counter t where+ bottom :: t+ plus :: t -> t -> t++instance Counter OneMany where+ bottom = One+ plus _ _ = Many++instance Counter Word where+ bottom = 1+ plus = (+)++instance Counter () where+ bottom = ()+ plus _ _ = ()+++++
+ Text/JSONb/Schema/Display.hs view
@@ -0,0 +1,111 @@+++module Text.JSONb.Schema.Display where+++import Prelude hiding+ ( lines+ , unlines+ , tail+ , null+ , unwords+ , length+ , repeat+ , elem+ , take+ , concat+ )+import Data.Ord+import Data.List (foldl1')+import Data.Word+import Data.ByteString.Lazy.Char8 hiding (any, foldl1')+import qualified Data.Set as Set++import qualified Data.Trie as Trie++import Text.JSONb.Schema+++++class Display t where+ {-| Provide a formatted 'ByteString' for the displayable.+ -}+ bytes :: t -> ByteString+++instance (Display counter) => Display (Schema counter) where+ bytes schema = case schema of+ Num -> pack "num"+ Str -> pack "str"+ Bool -> pack "bool"+ Null -> pack "null"+ Obj (Props trie) -> pack "{ " `append` f trie `append` pack "\n}"+ where+ m = longest_key_len trie+ f = dent 2 . unlines . Trie.toListBy prop_bytes+ where+ prop_bytes k set = k' `append` colon `append` join set'+ where+ colon = take (m - length k') space `append` pack " : "+ k' = fromChunks [k]+ k'' = length k'+ bar = '\n' `cons` take m space `append` pack " | "+ set' = (fmap bytes . Set.toList) set+ join = if must_be_multiline 3 set'+ then intercalate bar . fmap (dent (m + 3))+ else intercalate (pack " | ")+ Arr (Elements list) -> if must_be_multiline 1 list'+ then pack "[ " `append` intercalate nl list' `append` pack "\n]"+ else pack "[ " `append` intercalate (pack " ") list' `append` pack " ]"+ where+ nl = pack "\n "+ list' = fmap bytes list++len = 64++must_be_multiline s items = broken items || too_long s items++broken = any (elem '\n')++too_long s = (> len + s) . sum . fmap ((+s) . length)++dent n = intercalate ('\n' `cons` take n space) . lines++space = repeat ' '++{-| Warning -- does not work on empty tries. + -}+longest_key_len = length . foldl1' longest . lazify . Trie.keys+ where+ lazify = fmap $ fromChunks . (:[])+ longest x h+ | length h > length x = h+ | otherwise = x+++instance Display () where+ bytes _ = empty+++instance Display OneMany where+ bytes One = empty+ bytes Many = singleton '+'+++instance Display Word where+ bytes = (' ' `cons`) . pack . show+++instance (Display counter) => Display (counter, Schema counter) where+ bytes (count, schema) = bytes schema `append` bytes count+++++instance (Display counter) => Show (Schema counter) where+ show = unpack . bytes++++
+ Text/JSONb/Simple.hs view
@@ -0,0 +1,45 @@++++{-# LANGUAGE StandaloneDeriving+ #-}+++{-| JSON datatype definition.+ -}+++module Text.JSONb.Simple where+++import Data.ByteString++import Data.Trie++++{-| A monomorphic JSON datatype, backed with 'Rational', strict 'ByteString'+ and 'ByteString' 'Trie'.+ -}+data JSON+ = Object (Trie JSON)+ | Array [JSON]+ | String ByteString+ | Number Rational+ | Boolean Bool+ | Null+deriving instance Eq JSON+instance Show JSON where+ show json = case json of+ Object trie -> unlines $ "Object" : trie_show trie+ Array list -> unlines $ "Array" : fmap show list+ String bytes -> unwords ["String", show bytes]+ Number rational -> unwords ["Number", show rational]+ Boolean bool -> unwords ["Boolean", show bool]+ Null -> "Null"+ where+ trie_show = fmap edge_show . toList+ where+ edge_show (k, v) = unwords [show k, "->", show v]++
+ examples/JSONSchema.hs view
@@ -0,0 +1,104 @@+#!/usr/bin/env runhaskell+++{-# LANGUAGE NoMonomorphismRestriction+ #-}+++import Prelude hiding+ ( interact+ , lines+ , unlines+ , tail+ , null+ , unwords+ , length+ , repeat+ , elem+ , take+ )+import System.Exit+import System.IO (stderr, stdout)+import System.Environment+import Data.ByteString.Lazy (hPutStr)+import Data.ByteString.Lazy.Char8 hiding (any, reverse, foldr)+import Data.Word+import qualified Data.Set as Set++import qualified Data.Trie as Trie++import qualified Text.JSONb as JSONb+++++help = (unlines . fmap pack)+ [ "USAGE: json-schema (--any|--count|--one-many)? < json_file.json"+ , ""+ , "Derives a schema for JSON input, counting according to the option"+ , "spec or using one-many counting by default. An example is probably best."+ , "JSON that looks this:"+ , ""+ , " { id: 0, name: \"molly\", windage: 1.2 }"+ , " { id: 0, name: \"edmund\", windage: null }"+ , ""+ , "is assigned this schema under one-many counting:"+ , ""+ , " { id : num"+ , " name : str"+ , " windage : num | null"+ , " }+"+ , ""+ , "but is assigned this schema under plain old integral counting:"+ , ""+ , " { id : num"+ , " name : str"+ , " windage : num | null"+ , " } 2"+ , ""+ , "and is assigned this schema under any counting:"+ , ""+ , " { id : num"+ , " name : str"+ , " windage : num | null"+ , " }"+ , ""+ , "Notice that properties sum types; the schema inferencer assumes JSON"+ , "objects with like property names are the same object type."+ , ""+ ]+++main = do+ args <- getArgs+ case args of+ [] -> op (JSONb.schemas :: Counting JSONb.OneMany)+ ["--any"] -> op (JSONb.schemas :: Counting ())+ ["--one-many"] -> op (JSONb.schemas :: Counting JSONb.OneMany)+ ["--count"] -> op (JSONb.schemas :: Counting Word)+ ["-h"] -> hPutStr stdout help+ ["-?"] -> hPutStr stdout help+ ["--help"] -> hPutStr stdout help+ _ -> do+ hPutStr stderr $ pack "!! Invalid option or options.\n"+ hPutStr stderr help+ exitFailure+ where+ op schemas = interact (display . schemas . progressive)+++display = unlines . fmap JSONb.bytes+++progressive = progressive_parse' []+ where+ progressive_parse' acc bytes+ | null bytes = reverse acc+ | otherwise = case JSONb.break bytes of+ (Left _, _) -> progressive_parse' acc (tail bytes)+ (Right piece, rem) -> progressive_parse' (piece:acc) rem+++type Counting c = [JSONb.JSON] -> [(c, JSONb.Schema c)]++
+ json-b.cabal view
@@ -0,0 +1,57 @@+name : json-b+version : 0.0.0+category : Text+license : BSD3+license-file : LICENSE+author : Jason Dusek+maintainer : jsonb@solidsnack.be +homepage : http://github.com/jsnx/JSONb/+synopsis : JSON parser that uses byte strings.+description :+ This parser consumes lazy ByteStrings to produce JSON in a simple, efficient+ format backed with a strict ByteStrings, Rationals and ByteString tries. See+ the schema generation tools and the command line JSON schema generator (in+ the examples subdir) for an example of how to use the parsing tools.+++cabal-version : >= 1.2.3+build-type : Simple+extra-source-files : README+ test/SimpleUnits.hs+++library+ build-depends : base >= 2 && < 4+ , containers+ , utf8-string >= 0.3+ , bytestring >= 0.9+ , bytestringparser-temporary >= 0.4.1+ , bytestring-nums >= 0.3.1+ , bytestring-trie >= 0.1.4+ exposed-modules : Text.JSONb+ Text.JSONb.Simple+ Text.JSONb.Schema+ Text.JSONb.Schema.Display+ Text.JSONb.Decode+ Text.JSONb.Encode+ Text.JSON.Escape+ extensions : StandaloneDeriving+ FlexibleInstances+ RelaxedPolyRec+ ScopedTypeVariables+ ParallelListComp+++executable json-schema+ main-is : examples/JSONSchema.hs+ build-depends : base + , containers+ , utf8-string >= 0.3+ , bytestring >= 0.9+ , bytestringparser-temporary >= 0.4.1+ , bytestring-nums >= 0.3.1+ , bytestring-trie >= 0.1.4+ extensions : FlexibleInstances+ RelaxedPolyRec+ NoMonomorphismRestriction+
+ test/SimpleUnits.hs view
@@ -0,0 +1,133 @@+++{-# LANGUAGE StandaloneDeriving+ #-}+++import Data.List (concatMap, nub)+import Data.Ratio+import Data.ByteString.Lazy.Char8 (pack)+import qualified Data.ByteString.Char8 as Strict+import Test.QuickCheck++import Data.Trie+import qualified Data.ByteString.UTF8 as UTF8++import qualified Text.JSONb as JSONb+++++prop_structures_parse = samples structure_tests+++samples tests = forAll (elements tests) with_classifiers+ where+ with_classifiers :: (String, JSONb.JSON, [String]) -> Property+ with_classifiers = compound (property . array_parse) classifiers+ where+ compound = foldl (flip ($))+ array_parse (s, j, info) = rt s == Right j+ classifiers = (fmap classifier . nub . concatMap third) tests + where+ third (_,_,t) = t+ classifier string p x = classify (string `elem` third x) string $ p x+++prop_integer_round_trip :: Integer -> Property+prop_integer_round_trip n = collect bin $ case (rt . show) n of+ Right (JSONb.Number r) -> r == fromIntegral n+ _ -> False+ where+ bin+ | n == 0 = Bounds (Open (-1)) (Open 1)+ | n >= 1 && n < 100 = Bounds (Closed 1) (Open 100)+ | n > -100 && n <= -1 = Bounds (Open (-100)) (Closed (-1))+ | n <= -100 = Bounds Infinite (Closed (-100))+ | n >= -100 = Bounds (Closed (100)) Infinite+++prop_double_round_trip :: Double -> Property+prop_double_round_trip n = collect bin $ case (rt . show) n of+ Right (JSONb.Number r) -> fromRational r == n+ _ -> False+ where+ bin+ | n < 1 && n > -1 = Bounds (Open (-1)) (Open 1)+ | n >= 1 && n < 100 = Bounds (Closed 1) (Open 100)+ | n > -100 && n <= -1 = Bounds (Open (-100)) (Closed (-1))+ | n <= -100 = Bounds Infinite (Closed (-100))+ | n >= -100 = Bounds (Closed (100)) Infinite+++prop_string_round_trip s = high . escapes $ case round_trip bytes of+ Right (JSONb.String b) -> bytes == b+ _ -> False+ where+ bytes = UTF8.fromString s+ round_trip = JSONb.decode . JSONb.encode JSONb.Compact . JSONb.String+ high = classify (any (> '\x7f') s) "above ASCII"+ escapes = classify (any JSONb.escaped s) "escaped chars"+++data Bounds n where+ Bounds :: (Show n, Num n) => Bound n -> Bound n -> Bounds n+instance (Show n) => Show (Bounds n) where+ show (Bounds l r) = case (l, r) of+ (Open l, Open r) -> "(" ++ show l ++ ".." ++ show r ++ ")"+ (Closed l, Closed r) -> "[" ++ show l ++ ".." ++ show r ++ "]"+ (Closed l, Open r) -> "[" ++ show l ++ ".." ++ show r ++ ")"+ (Open l, Closed r) -> "(" ++ show l ++ ".." ++ show r ++ "]"+ (Closed l, Infinite) -> "[" ++ show l ++ ".."+ (Infinite, Closed r) -> ".." ++ show r ++ "]"+ (Open l, Infinite) -> "(" ++ show l ++ ".."+ (Infinite, Open r) -> ".." ++ show r ++ ")"+ (Infinite, Infinite) -> ".."+++data Bound n where+ Open :: (Show n, Num n) => n -> Bound n+ Closed :: (Show n, Num n) => n -> Bound n+ Infinite :: (Show n, Num n) => Bound n+++rt = JSONb.decode . pack++++structure_tests =+ [ ( "[ 7, 6 ]", (JSONb.Array . fmap JSONb.Number) [7, 6]+ , ["array", "excessive spacing", "integers"] )+ , ( "[7,6]", (JSONb.Array . fmap JSONb.Number) [7, 6]+ , ["array", "compact spacing", "integers"] )+ , ( "[7.6, 21]", (JSONb.Array . fmap JSONb.Number) [7.6, 21.0]+ , ["array", "normal spacing", "floats"] )+ , ( "[22.0 ,7.6,]", (JSONb.Array . fmap JSONb.Number) [22, 7.6]+ , ["array", "weird comma spacing", "extra comma", "floats"] )+ , ( "[\"22.0\" ,7.6,]"+ , JSONb.Array [(JSONb.String . Strict.pack) "22.0", JSONb.Number 7.6]+ , ["array", "weird comma spacing", "extra comma", "floats", "strings"] )+ , ( "{ \"ixion\":6 }"+ , (JSONb.Object . fromList) [(Strict.pack "ixion", JSONb.Number 6)]+ , ["object", "no commas", "integers"] )+ , ( "{ \"Ack\":\"Success\" ,\"Build\" :\"e605_core_Bundled_8000231_R1\"}"+ , (JSONb.Object . fromList)+ [ (Strict.pack "Ack", JSONb.String (Strict.pack "Success"))+ , ( Strict.pack "Build"+ , JSONb.String (Strict.pack "e605_core_Bundled_8000231_R1") ) ]+ , ["object", "random spacing", "strings"] )+ , ( "{\n\"Ack\"\n:\n\"Success\" , \"Build\":\"e605_core_Bundled_8000231_R1\"}"+ , (JSONb.Object . fromList)+ [ (Strict.pack "Ack", JSONb.String (Strict.pack "Success"))+ , ( Strict.pack "Build"+ , JSONb.String (Strict.pack "e605_core_Bundled_8000231_R1") ) ]+ , ["object", "newlines", "strings"] )+ , ( "{\"Ack\":\"Success\",\"Build\":\"e605_core_Bundled_8000231_R1\"}"+ , (JSONb.Object . fromList)+ [ (Strict.pack "Ack", JSONb.String (Strict.pack "Success"))+ , ( Strict.pack "Build"+ , JSONb.String (Strict.pack "e605_core_Bundled_8000231_R1") ) ]+ , ["object", "compact spacing", "strings"] )+ ]++