hw-json 0.2.0.0 → 0.2.0.1

raw patch · 11 files changed

+251/−25 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• corpus/5000B.bp +1/−0
• corpus/5000B.ib +1/−0
• corpus/5000B.json +1/−0
• hw-json.cabal +11/−4
• src/HaskellWorks/Data/Json/Conduit.hs +21/−7
• src/HaskellWorks/Data/Json/PartialValue.hs +58/−0
• src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +12/−12
• src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +1/−2
• src/HaskellWorks/Data/Json/Succinct/PartialIndex.hs +59/−0
• test/HaskellWorks/Data/Json/CorpusSpec.hs +60/−0
• test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs +26/−0

@@ -0,0 +1,1 @@+111011010010101010101010101010101010101010101010101010101010101010101010101010101010110100101010101011011110100100111010010011101001000010111010101001101010100010111010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010000101110110101010001101101010100011011010101000110110101010001101101010100011011010101000000

@@ -0,0 +1,1 @@+10101000000010100000000100000000000000000000000000000100000000100000000000100000000000001000000010000000000000000001000000000000000000000000000000000000000000000100000000000000001000000000000000000000000001000000000000100000000000000000000000000000010000000000000000010000000000000000000000000000000000010000000000000000000010000000000000000001000000000000000001000000100000000000000000000000100010000000000000000100000100000000000000000100010000000000000001000100000000000000000001001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000000001000100000000000000000100000000000000000000100000000000000001000000000000000100000000000000010000000000000000000000000000001000000000000001010000000001000000000000000010000000000000010000000000000000000000000000000100000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001010000000000000000000101010100001000001000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000001010100001000000100000000000000000000000000000000000000000000000000000000000000001000000000000101010000000010000000000000000000100000000000001000000000000000000101000000001000000000000000000000000000000000000001000000000000010000000000000000000000000000000000000000001000000000000000001010100000000000100000010000000001000000000000000000000000000000000000000000000000000001000000000010100000000000000100000000001000000000000010000000001000000000000010000000000000000000001010000000000010000001000000000100000000000000000000000000000000000010000000000101000000000000001000000100000000000001000000000010000000000000100000000000000000010100000000000100000010000000001000000000000000000000000010000000000101000000000000001000000100000000000001000000001000000000000010000000000000000101000000000001000000100000000010000000000000000000000000000000000000000010000000000101000000000000001000000001000000000000010000000001000000000000010000000000000000000101000000000001000000100000000010000000010000000000101000000000000001000000000001000000000000010000000000010000000000000100000000000000000000000010100000000000100000010000000001000000000000000100000000001010000000000000010000001000000000000010000001000000000000010000000000000010100000000000100000010000000001000000001000000000010100000000000000100000010000000000000100000000010000000000000100000000000000000101000000000001000000100000000010000000000000000000000000000000001000000000010100000000000000100000001000000000000010000000000001000000000000010000000000000000000001010000000000010000010000000001000000100000000001010000000000000010000000100000000000001000000001000000000000010000000000000000010100000000000100000100000000010000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000000000000001000000000010100000000000000100000010000000000000100000000100000000000001000000000000000010100000000000100000100000000010000000000000000000000000000010000000000101000000000000001000000000100000000000001000000001000000000000010000000000000000000101000000000001000001000000000100000000000000010000000000101000000000000001000000001000000000000010000000000010000000000000100000000000000000000010100000000000100000100000000010000000000000000000001000000000010100000000000000100000001000000000000010000000100000000000001000000000000000010100000000000100000100000000010000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000001000000000010100000000000000100000000100000000000001000000000100000000000001000000000000000000000100000000000000001010100000000000000101000000001000000001000000000000010000000000001010000000000000010100000000100000000001000000000000010000000000000010100000000000000101000000001000000000000010000000000000100000000000000000101000000000000001010000000010000000000000000000001000000000000010000000000010100000000000000101000000001000000000100000000000001000000000000010100000000000000101000001000010000100000

@@ -0,0 +1,1 @@+[ { "_id" : { "$oid" : "52cdef7c4bab8bd675297d8a" }, "name" : "Wetpaint", "permalink" : "abc2", "crunchbase_url" : "http://www.crunchbase.com/company/wetpaint", "homepage_url" : "http://wetpaint-inc.com", "blog_url" : "http://digitalquarters.net/", "blog_feed_url" : "http://digitalquarters.net/feed/", "twitter_username" : "BachelrWetpaint", "category_code" : "web", "number_of_employees" : 47, "founded_year" : 2005, "founded_month" : 10, "founded_day" : 17, "deadpooled_year" : 1, "tag_list" : "wiki, seattle, elowitz, media-industry, media-platform, social-distribution-system", "alias_list" : "", "email_address" : "info@wetpaint.com", "phone_number" : "206.859.6300", "description" : "Technology Platform Company", "created_at" : { "$date" : 1180075887000 }, "updated_at" : "Sun Dec 08 07:15:44 UTC 2013", "overview" : "<p>Wetpaint is a technology platform company that uses its proprietary state-of-the-art technology and expertise in social media to build and monetize audiences for digital publishers. Wetpaint's own online property, Wetpaint Entertainment, an entertainment news site that attracts more than 12 million unique visitors monthly and has over 2 million Facebook fans, is a proof point to the company's success in building and engaging audiences. Media companies can license Wetpaint's platform which includes a dynamic playbook tailored to their individual needs and comprehensive training. Founded by Internet pioneer Ben Elowitz, and with offices in New York and Seattle, Wetpaint is backed by Accel Partners, the investors behind Facebook.</p>", "image" : { "available_sizes" : [ [ [ 150, 75 ], "assets/images/resized/0000/3604/3604v14-max-150x150.jpg" ], [ [ 250, 125 ], "assets/images/resized/0000/3604/3604v14-max-250x250.jpg" ], [ [ 450, 225 ], "assets/images/resized/0000/3604/3604v14-max-450x450.jpg" ] ] }, "products" : [ { "name" : "Wikison Wetpaint", "permalink" : "wetpaint-wiki" }, { "name" : "Wetpaint Social Distribution System", "permalink" : "wetpaint-social-distribution-system" } ], "relationships" : [ { "is_past" : false, "title" : "Co-Founder and VP, Social and Audience Development", "person" : { "first_name" : "Michael", "last_name" : "Howell", "permalink" : "michael-howell" } }, { "is_past" : false, "title" : "Co-Founder/CEO/Board of Directors", "person" : { "first_name" : "Ben", "last_name" : "Elowitz", "permalink" : "ben-elowitz" } }, { "is_past" : false, "title" : "COO/Board of Directors", "person" : { "first_name" : "Rob", "last_name" : "Grady", "permalink" : "rob-grady" } }, { "is_past" : false, "title" : "SVP, Strategy and Business Development", "person" : { "first_name" : "Chris", "last_name" : "Kollas", "permalink" : "chris-kollas" } }, { "is_past" : false, "title" : "Board", "person" : { "first_name" : "Theresia", "last_name" : "Ranzetta", "permalink" : "theresia-ranzetta" } }, { "is_past" : false, "title" : "Board Member", "person" : { "first_name" : "Gus", "last_name" : "Tai", "permalink" : "gus-tai" } }, { "is_past" : false, "title" : "Board", "person" : { "first_name" : "Len", "last_name" : "Jordan", "permalink" : "len-jordan" } }, { "is_past" : false, "title" : "Head of Technology and Product", "person" : { "first_name" : "Alex", "last_name" : "Weinstein", "permalink" : "alex-weinstein" } }, { "is_past" : true, "title" : "CFO", "person" : { "first_name" : "Bert", "last_name" : "Hogue", "permalink" : "bert-hogue" } }, { "is_past" : true, "title" : "CFO/ CRO", "person" : { "first_name" : "Brian", "last_name" : "Watkins", "permalink" : "brian-watkins" } }, { "is_past" : true, "title" : "Senior Vice President, Marketing", "person" : { "first_name" : "Rob", "last_name" : "Grady", "permalink" : "rob-grady" } }, { "is_past" : true, "title" : "VP, Technology and Product", "person" : { "first_name" : "Werner", "last_name" : "Koepf", "permalink" : "werner-koepf" } }, { "is_past" : true, "title" : "VP Marketing", "person" : { "first_name" : "Kevin", "last_name" : "Flaherty", "permalink" : "kevin-flaherty" } }, { "is_past" : true, "title" : "VP User Experience", "person" : { "first_name" : "Alex", "last_name" : "Berg", "permalink" : "alex-berg" } }, { "is_past" : true, "title" : "VP Engineering", "person" : { "first_name" : "Steve", "last_name" : "McQuade", "permalink" : "steve-mcquade" } }, { "is_past" : true, "title" : "Executive Editor", "person" : { "first_name" : "Susan", "last_name" : "Mulcahy", "permalink" : "susan-mulcahy" } }, { "is_past" : true, "title" : "VP Business Development", "person" : { "first_name" : "Chris", "last_name" : "Kollas", "permalink" : "chris-kollas" } } ], "competitions" : [ { "competitor" : { "name" : "Wikia", "permalink" : "wikia" } }, { "competitor" : { "name" : "JotSpot", "permalink" : "jotspot" } }, { "competitor" : { "name" : "Socialtext", "permalink" : "socialtext" } }, { "competitor" : { "name" : "Ning by Glam Media", "permalink" : "ning" } }, { "competitor" : { "name" : "Soceeo", "permalink" : "soceeo" } }, { "competitor" : { "n" : "Y", "" : 1234567}}]}]

@@ -1,5 +1,5 @@ name:                   hw-json-version:                0.2.0.0+version:                0.2.0.1 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-json#readme@@ -10,7 +10,10 @@ copyright:              2016 John Ky category:               Data, Conduit build-type:             Simple-extra-source-files:     README.md+extra-source-files:     README.md,+                        corpus/5000B.bp,+                        corpus/5000B.ib,+                        corpus/5000B.json cabal-version:          >= 1.22  executable hw-json-example@@ -41,6 +44,7 @@                       , HaskellWorks.Data.Json.Conduit.Blank                       , HaskellWorks.Data.Json.Conduit.Words                       , HaskellWorks.Data.Json.FromValue+                      , HaskellWorks.Data.Json.PartialValue                       , HaskellWorks.Data.Json.Succinct                       , HaskellWorks.Data.Json.Succinct.Cursor                       , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens@@ -49,6 +53,7 @@                       , HaskellWorks.Data.Json.Succinct.Cursor.Internal                       , HaskellWorks.Data.Json.Succinct.Cursor.Token                       , HaskellWorks.Data.Json.Succinct.Index+                      , HaskellWorks.Data.Json.Succinct.PartialIndex                       , HaskellWorks.Data.Json.Token.Tokenize                       , HaskellWorks.Data.Json.Token.Types                       , HaskellWorks.Data.Json.Token@@ -81,9 +86,11 @@   type:                 exitcode-stdio-1.0   hs-source-dirs:       test   main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.Json.Token.TokenizeSpec-                      , HaskellWorks.Data.Json.Succinct.CursorSpec+  other-modules:        HaskellWorks.Data.Json.CorpusSpec+                      , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec                       , HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec+                      , HaskellWorks.Data.Json.Succinct.CursorSpec+                      , HaskellWorks.Data.Json.Token.TokenizeSpec                       , HaskellWorks.Data.Json.TypeSpec                       , HaskellWorks.Data.Json.ValueSpec   build-depends:        base                          >= 4          && < 5

@@ -83,14 +83,27 @@     blankedJsonToBalancedParens' cs   Nothing -> return () +repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)+repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS)+  where abBS = BS.concat [aBS, bBS]+        abLen = BS.length abBS+        cLen = (abLen `div` 8) * 8+ compressWordAsBit :: Monad m => Conduit BS.ByteString m BS.ByteString-compressWordAsBit = do-  mbs <- await-  case mbs of-    Just bs -> do-      let (cs, _) = BS.unfoldrN (BS.length bs + 7 `div` 8) gen bs+compressWordAsBit = compressWordAsBit' BS.empty++compressWordAsBit' :: Monad m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString+compressWordAsBit' aBS = do+  mbBS <- await+  case mbBS of+    Just bBS -> do+      let (cBS, dBS) = repartitionMod8 aBS bBS+      let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS       yield cs-    Nothing -> return ()+      compressWordAsBit' dBS+    Nothing -> do+      let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS+      yield cs   where gen :: ByteString -> Maybe (Word8, ByteString)         gen xs = if BS.length xs == 0           then Nothing@@ -105,13 +118,14 @@     Just bs -> do       let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)       yield cs+      blankedJsonToBalancedParens2     Nothing -> return ()   where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))         gen (Just True  , bs) = Just (0xFF, (Nothing, bs))         gen (Just False , bs) = Just (0x00, (Nothing, bs))         gen (Nothing    , bs) = case BS.uncons bs of           Just (c, cs) -> case balancedParensOf c of-            MiniN   -> gen        (Nothing    , cs)+            MiniN   -> gen         (Nothing    , cs)             MiniT   -> Just (0xFF, (Nothing    , cs))             MiniF   -> Just (0x00, (Nothing    , cs))             MiniTF  -> Just (0xFF, (Just False , cs))

@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TupleSections         #-}++module HaskellWorks.Data.Json.PartialValue+  ( JsonPartialValue(..)+  , JsonPartialValueAt(..)+  ) where++import           Control.Arrow+import qualified Data.Attoparsec.ByteString.Char8             as ABC+import qualified Data.ByteString                              as BS+import           HaskellWorks.Data.Json.Succinct.PartialIndex+import           HaskellWorks.Data.Json.Value.Internal++data JsonPartialValue+  = JsonPartialString String+  | JsonPartialNumber Double+  | JsonPartialObject [(String, JsonPartialValue)]+  | JsonPartialArray [JsonPartialValue]+  | JsonPartialBool Bool+  | JsonPartialNull+  | JsonPartialError String+  deriving (Eq, Show)++class JsonPartialValueAt a where+  jsonPartialJsonValueAt :: a -> JsonPartialValue++asString :: JsonPartialValue -> String+asString pjv = case pjv of+  JsonPartialString s -> s+  _                   -> ""++instance JsonPartialValueAt JsonPartialIndex where+  jsonPartialJsonValueAt i = case i of+    JsonPartialIndexString s  -> case ABC.parse parseJsonString s of+      ABC.Fail    {}          -> JsonPartialError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'")+      ABC.Partial _           -> JsonPartialError "Unexpected end of string"+      ABC.Done    _ r         -> JsonPartialString r+    JsonPartialIndexNumber s  -> case ABC.parse ABC.rational s of+      ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")+      ABC.Partial f     -> case f " " of+        ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")+        ABC.Partial _     -> JsonPartialError "Unexpected end of number"+        ABC.Done    _ r   -> JsonPartialNumber r+      ABC.Done    _ r   -> JsonPartialNumber r+    JsonPartialIndexObject  fs -> JsonPartialObject (map ((asString . parseString) *** jsonPartialJsonValueAt) fs)+    JsonPartialIndexArray   es -> JsonPartialArray (map jsonPartialJsonValueAt es)+    JsonPartialIndexBool    v  -> JsonPartialBool v+    JsonPartialIndexNull       -> JsonPartialNull+    JsonPartialIndexError s    -> JsonPartialError s+    where parseString bs = case ABC.parse parseJsonString bs of+            ABC.Fail    {}  -> JsonPartialError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'")+            ABC.Partial _   -> JsonPartialError "Unexpected end of field"+            ABC.Done    _ s -> JsonPartialString s

@@ -31,21 +31,21 @@   fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (runListConduit blankedJsonToBalancedParens bj))  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where-  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))-          newLen        = (BS.length interestBS + 7) `div` 8 * 8+  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))+    where bpBS        = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen      = (BS.length bpBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where-  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))-          newLen        = (BS.length interestBS + 7) `div` 8 * 8+  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))+    where bpBS        = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen      = (BS.length bpBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where-  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))-          newLen        = (BS.length interestBS + 7) `div` 8 * 8+  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))+    where bpBS        = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen      = (BS.length bpBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where-  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))-          newLen        = (BS.length interestBS + 7) `div` 8 * 8+  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))+    where bpBS        = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen      = (BS.length bpBS + 7) `div` 8 * 8

@@ -29,7 +29,6 @@ import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 import           HaskellWorks.Data.TreeCursor-import           HaskellWorks.Data.Vector.VectorLike  data JsonCursor t v w = JsonCursor   { cursorText     :: !t@@ -107,7 +106,7 @@   subtreeSize :: JsonCursor t v u -> Maybe Count   subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) -jsonCursorPos :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Position+jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)   where ik  = interests k         bpk = balancedParens k

@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns           #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE InstanceSigs           #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE ScopedTypeVariables    #-}++module HaskellWorks.Data.Json.Succinct.PartialIndex where++import           Control.Arrow+import qualified Data.ByteString                                            as BS+import qualified Data.List                                                  as L+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Json.CharLike+import           HaskellWorks.Data.Json.Succinct+import           HaskellWorks.Data.Positioning+import qualified HaskellWorks.Data.Succinct.BalancedParens                  as BP+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.TreeCursor+import           HaskellWorks.Data.Vector.VectorLike++data JsonPartialIndex+  = JsonPartialIndexString BS.ByteString+  | JsonPartialIndexNumber BS.ByteString+  | JsonPartialIndexObject [(BS.ByteString, JsonPartialIndex)]+  | JsonPartialIndexArray [JsonPartialIndex]+  | JsonPartialIndexBool Bool+  | JsonPartialIndexNull+  | JsonPartialIndexError String+  deriving (Eq, Show)++class JsonPartialIndexAt a where+  jsonPartialIndexAt :: a -> JsonPartialIndex++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where+  jsonPartialIndexAt k = case vUncons remainder of+    Just (!c, _) | isLeadingDigit2 c  -> JsonPartialIndexNumber  remainder+    Just (!c, _) | isQuotDbl c        -> JsonPartialIndexString  remainder+    Just (!c, _) | isChar_t c         -> JsonPartialIndexBool    True+    Just (!c, _) | isChar_f c         -> JsonPartialIndexBool    False+    Just (!c, _) | isChar_n c         -> JsonPartialIndexNull+    Just (!c, _) | isBraceLeft c      -> JsonPartialIndexObject (mapValuesFrom   (firstChild k))+    Just (!c, _) | isBracketLeft c    -> JsonPartialIndexArray  (arrayValuesFrom (firstChild k))+    Just _                            -> JsonPartialIndexError "Invalid Json Type"+    Nothing                           -> JsonPartialIndexError "End of data"+    where ik                = interests k+          bpk               = balancedParens k+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          remainder         = vDrop (toCount p) (cursorText k)+          arrayValuesFrom :: Maybe (JsonCursor BS.ByteString v w) -> [JsonPartialIndex]+          arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling))+          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField+          pairwise (a:b:rs) = (a, b) : pairwise rs+          pairwise _        = []+          asField (a, b)    = case a of+                                JsonPartialIndexString s -> [(s, b)]+                                _                 -> []

@@ -0,0 +1,60 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE ExplicitForAll             #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Json.CorpusSpec(spec) where++import           Control.Monad+import qualified Data.ByteString                                            as BS+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.FromBitTextByteString+import           HaskellWorks.Data.Json.Succinct.Cursor                     as C+import           HaskellWorks.Data.Succinct.BalancedParens.Simple+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           HaskellWorks.Data.Bits++import           HaskellWorks.Data.FromByteString++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Corpus" $ do+  it "Corpus 5000B loads properly" $ do+    inJsonBS                    <- BS.readFile "corpus/5000B.json"+    inInterestBitsBS            <- BS.readFile "corpus/5000B.ib"+    inInterestBalancedParensBS  <- BS.readFile "corpus/5000B.bp"+    let inInterestBits            = fromBitTextByteString inInterestBitsBS+    let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS+    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+    let text                    = cursorText      cursor+    let ib                      = interests       cursor+    let SimpleBalancedParens bp = balancedParens  cursor+    text `shouldBe` inJsonBS+    ib `shouldBe` BitShown inInterestBits+    bp `shouldBe` inInterestBalancedParens+  it "issue-0001 loads properly" $ do+    inJsonBS                    <- BS.readFile "corpus/issue-0001.json"+    inInterestBitsBS            <- BS.readFile "corpus/issue-0001.ib"+    inInterestBalancedParensBS  <- BS.readFile "corpus/issue-0001.bp"+    let inInterestBits            = fromBitTextByteString inInterestBitsBS+    let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS+    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+    let text                    = cursorText      cursor+    let ib                      = interests       cursor+    let SimpleBalancedParens bp = balancedParens  cursor+    text `shouldBe` inJsonBS+    ib `shouldBe` BitShown inInterestBits+    bp `shouldBe` inInterestBalancedParens

@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec(spec) where++import qualified Data.ByteString                                    as BS+import           Data.Conduit+import           Data.String+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Conduit.List+import           HaskellWorks.Data.Json.Conduit+import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import           Test.Hspec++{-# ANN module ("HLint: Ignore Redundant do"        :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec" $ do+  it "Blanking JSON should not contain strange characters 1" $ do+    let blankedJson = BlankedJson ["[ [],", "[]]"]+    let bp = BitShown $ BS.concat (runListConduit blankedJsonToBalancedParens2 (getBlankedJson blankedJson))+    bp `shouldBe` fromString "11111111 11111111 00000000 11111111 00000000 00000000"+  it "Blanking JSON should not contain strange characters 2" $ do+    let blankedJson = BlankedJson ["[ [],", "[]]"]+    let bp = BitShown $ BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson blankedJson))+    bp `shouldBe` fromString "11010000"