packages feed

hw-json-standard-cursor (empty) → 0.1.0.0

raw patch · 42 files changed

+2177/−0 lines, 42 filesdep +arraydep +attoparsecdep +basesetup-changed

Dependencies added: array, attoparsec, base, bits-extra, bytestring, criterion, directory, dlist, generic-lens, hedgehog, hspec, hw-balancedparens, hw-bits, hw-hspec-hedgehog, hw-json-simd, hw-json-standard-cursor, hw-mquery, hw-prim, hw-rankselect, hw-rankselect-base, lens, mmap, optparse-applicative, semigroups, text, transformers, vector, word8

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++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 Author name here 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.
+ README.md view
@@ -0,0 +1,157 @@+# hw-json+[![master](https://circleci.com/gh/haskell-works/hw-json/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-json/tree/master)++`hw-json` is a succinct JSON parsing library.++It uses succinct data-structures to allow traversal of large JSON strings with minimal memory overhead.++For an example, see [`app/Main.hs`](../master/app/Main.hs)++## Prerequisites++* `cabal` version `2.2` or later++## Memory benchmark++### Parsing large Json files in Scala with Argonaut++```text+      S0U       EU           OU       MU     CCSU CMD+--------- --------- ----------- -------- -------- ---------------------------------------------------------------+      0.0  80,526.3    76,163.6 72,338.6 13,058.6 sbt console+      0.0 536,660.4    76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._+      0.0 552,389.1    76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json"+      0.0 634,066.5    76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int])+      0.0 644,552.3    76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json")+      0.0 655,038.1    76,163.6 72,338.6 13,058.6 is.read(array)+294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array)+285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json)+                    ***********+```++### Parsing large Json files in Haskell with Aeson++```haskell+-- CMD                                                     -- Mem (MB)+---------------------------------------------------------- -- --------+import Control.DeepSeq                                     --       94+import Data.Aeson                                          --      100+import qualified Data.ByteString.Lazy as BSL               --      104+bs <- BSL.readFile "../corpus/bench/hospitalisation.json"  --      105+let !x = deepseq bs bs                                     --      146+let !y = decode json78m :: Maybe Value                     --      669+```++### Parsing large Json files in Haskell with hw-json++```haskell+-- CMD                                                                -- Mem (MB)+--------------------------------------------------------------------- -- --------+import Foreign                                                        --       93+import Control.Monad                                                  --       95+import Data.Word                                                      --       96+import HaskellWorks.Data.BalancedParens.Simple                        --       97+import HaskellWorks.Data.Bits.BitShown                                --       98+import HaskellWorks.Data.FromForeignRegion                            --       99+import HaskellWorks.Data.Json.Backend.Standard.Cursor                 --      106+import System.IO.MMap                                                 --      109+import qualified Data.ByteString                              as BS   --      110+import qualified Data.Vector.Storable                         as DVS  --      111+import qualified HaskellWorks.Data.ByteString                 as BS   --      112+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST --      114+bs <- BS.mmap "../corpus/bench/hospitalisation.json"                  --      115+let !cursor = FAST.makeCursor bs                                      --      203+```++## Examples++### Navigation example++```haskell+import Control.Monad+import Data.String+import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Internal.Token.Types+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.CsPoppy+import System.IO.MMap++import qualified Data.ByteString                                as BS+import qualified Data.Vector.Storable                           as DVS+import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor as C+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast   as FAST+import qualified HaskellWorks.Data.TreeCursor                   as TC++let fc = TC.firstChild+let ns = TC.nextSibling+let pn = TC.parent+let ss = TC.subtreeSize+let cursor = FAST.makeCursor "[null, {\"field\": 1}]"+cursor+fc cursor+(fc >=> ns) cursor+```++### Querying example++```haskell+import Control.Monad+import Data.Function+import Data.List+import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Load.Partial+import HaskellWorks.Data.Json.Backend.Standard.Load.Raw+import HaskellWorks.Data.Json.PartialValue+import HaskellWorks.Data.MQuery+import HaskellWorks.Data.MQuery.Micro+import HaskellWorks.Data.MQuery.Row++import qualified Data.DList as DL++!cursor <- loadPartial "../corpus/bench/78mb.json"+!cursor <- loadCursorWithIndex "../corpus/bench/78mb.json"+!cursor <- loadCursor "../corpus/bench/78mb.json"+!cursor <- loadCursorWithCsPoppyIndex "../corpus/bench/78mb.json"+let !json = jsonPartialJsonValueAt cursor+let q = MQuery (DL.singleton json)++putPretty $ q >>= item & limit 10+putPretty $ q >>= item & page 10 1+putPretty $ q >>= item >>= hasKV "founded_year" (JsonPartialNumber 2005) & limit 10+putPretty $ q >>= item >>= entry+putPretty $ q >>= item >>= entry >>= named "name" & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code")+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code") & onList (uniq . sort)+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum++putPretty $ q >>= item & limit 10+putPretty $ q >>= item & page 10 1+putPretty $ q >>= item >>= entry+putPretty $ q >>= item >>= entry >>= named "name" & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString)+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & onList (uniq . sort)+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10+putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum+```++## References++* [Semi-Indexing Semi-Structured Data in Tiny Space](http://www.di.unipi.it/~ottavian/files/semi_index_cikm.pdf)+* [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8)+* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf)++## Special mentions++* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App/Commands.hs view
@@ -0,0 +1,13 @@+module App.Commands where++import App.Commands.CreateIndex+import Data.Semigroup           ((<>))+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+  <>  commandGroup "Commands:"+  <>  cmdCreateIndex
+ app/App/Commands/CreateIndex.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.CreateIndex+  ( cmdCreateIndex+  ) where++import Control.Lens+import Control.Monad+import Data.Generics.Product.Any+import Data.Maybe+import Data.Semigroup            ((<>))+import Data.Word+import Foreign+import Options.Applicative       hiding (columns)++import qualified App.Commands.Types                                                 as Z+import qualified Data.ByteString                                                    as BS+import qualified Data.ByteString.Internal                                           as BSI+import qualified Data.ByteString.Lazy                                               as LBS+import qualified HaskellWorks.Data.ByteString                                       as BS+import qualified HaskellWorks.Data.ByteString.Lazy                                  as LBS+import qualified HaskellWorks.Data.Json.Simd.Index.Standard                         as STSI+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank              as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex          as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.SemiIndex                   as STSI+import qualified System.Exit                                                        as IO+import qualified System.IO                                                          as IO+import qualified System.IO.MMap                                                     as IO++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++runCreateIndex :: Z.CreateIndexOptions -> IO ()+runCreateIndex opts = do+  let filePath = opts ^. the @"filePath"+  let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx")+  let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx")+  case opts ^. the @"method" of+    "original" -> do+      (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing+      let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+      let blankedJson = J.blankJson [bs]+      let ibs = LBS.fromChunks (J.blankedJsonToInterestBits blankedJson)+      let bps = J.toBalancedParens64 (J.BlankedJson blankedJson)+      LBS.writeFile outputIbFile ibs+      LBS.writeFile outputBpFile (LBS.toLazyByteString bps)+    "alternate" -> do+      (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing+      let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+      let STSI.SemiIndex ib bp = STSI.buildSemiIndex bs+      BS.writeFile outputIbFile (BS.toByteString ib)+      BS.writeFile outputBpFile (BS.toByteString bp)+    "tabular" -> do+      lbs <- LBS.readFile filePath+      let siChunks = STSI.toIbBpBuilders (STSI.buildFromByteString3 (BS.resegmentPadded 64 (LBS.toChunks lbs)))+      IO.withFile outputIbFile IO.WriteMode $ \hIb ->+        IO.withFile outputBpFile IO.WriteMode $ \hBp ->+          forM_ siChunks $ \(STSI.SiChunk ib bp) -> do+            LBS.hPut hIb (LBS.toLazyByteString ib)+            LBS.hPut hBp (LBS.toLazyByteString bp)+    "simd" -> do+      IO.withFile filePath IO.ReadMode $ \hIn -> do+        contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn+        case STSI.makeStandardJsonIbBps contents of+          Right chunks -> do+            IO.withFile outputIbFile IO.WriteMode $ \hIb -> do+              IO.withFile outputBpFile IO.WriteMode $ \hBp -> do+                forM_ chunks $ \(ibBs, bpBs) -> do+                  BS.hPut hIb ibBs+                  BS.hPut hBp bpBs+          Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create index: " <> show msg+    "sum" -> do+      lbs <- LBS.resegmentPadded 64 <$> LBS.readFile filePath+      IO.putStrLn $ "Sum: " <> show (sum (BS.foldl (\a b -> a + fromIntegral b) (0 :: Word64) <$> LBS.toChunks lbs))+    unknown -> do+      IO.hPutStrLn IO.stderr $ "Unknown method " <> show unknown+      IO.exitFailure++optsCreateIndex :: Parser Z.CreateIndexOptions+optsCreateIndex = Z.CreateIndexOptions+  <$> strOption+        (   long "input"+        <>  short 'i'+        <>  help "Input JSON file"+        <>  metavar "STRING"+        )+  <*> strOption+        (   long "method"+        <>  short 'm'+        <>  value "original"+        <>  help "Method for creating index"+        <>  metavar "STRING"+        )+  <*> optional+        ( strOption+          (   long "output-ib-file"+          <>  help "Filename for output ib index"+          <>  metavar "STRING"+          )+        )+  <*> optional+        ( strOption+          (   long "output-bp-file"+          <>  help "Filename for output bp index"+          <>  metavar "STRING"+          )+        )++cmdCreateIndex :: Mod CommandFields (IO ())+cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex
+ app/App/Commands/Types.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Types+  ( CountOptions(..)+  , CreateIndexOptions(..)+  , DemoOptions(..)+  ) where++import Data.Text    (Text)+import GHC.Generics++data CreateIndexOptions = CreateIndexOptions+  { filePath     :: FilePath+  , method       :: String+  , outputIbFile :: Maybe FilePath+  , outputBpFile :: Maybe FilePath+  } deriving (Eq, Show, Generic)++data DemoOptions = DemoOptions+  { filePath :: FilePath+  , method   :: FilePath+  } deriving (Eq, Show, Generic)++data CountOptions = CountOptions+  { inputFile  :: FilePath+  , ibIndex    :: FilePath+  , bpIndex    :: FilePath+  , expression :: Text+  } deriving (Eq, Show, Generic)
+ app/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import App.Commands+import Control.Monad+import Data.Semigroup      ((<>))+import Options.Applicative++main :: IO ()+main = join $ customExecParser+  (prefs $ showHelpOnEmpty <> showHelpOnError)+  (info (commands <**> helper) idm)
+ bench/Main.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Monad+import Criterion.Main+import Data.List+import Data.Semigroup                                            ((<>))+import Data.Word+import Foreign+import HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank+import HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex+import System.IO.MMap++import qualified Data.ByteString                             as BS+import qualified Data.ByteString.Internal                    as BSI+import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW+import qualified System.Directory                            as IO++setupEnvJson :: FilePath -> IO BS.ByteString+setupEnvJson filepath = do+  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing+  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+  return bs++jsonToInterestBits3 :: [BS.ByteString] -> [BS.ByteString]+jsonToInterestBits3 = blankedJsonToInterestBits . blankJson++makeBenchBlankJson :: IO [Benchmark]+makeBenchBlankJson = do+  entries <- IO.listDirectory "corpus/bench"+  let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries+  benchmarks <- forM files $ \file -> return+    [ env (setupEnvJson file) $ \bs -> bgroup file+      [ bench "Run blankJson" (whnf (BS.concat . blankJson) [bs])+      ]+    ]++  return (join benchmarks)++makeBenchJsonToInterestBits :: IO [Benchmark]+makeBenchJsonToInterestBits = do+  entries <- IO.listDirectory "corpus/bench"+  let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries+  benchmarks <- forM files $ \file -> return+    [ env (setupEnvJson file) $ \bs -> bgroup file+      [ bench "Run blankJson" (whnf (BS.concat . jsonToInterestBits3) [bs])+      ]+    ]++  return (join benchmarks)++makeBenchMakeCursor :: IO [Benchmark]+makeBenchMakeCursor = do+  entries <- IO.listDirectory "corpus/bench"+  let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries+  benchmarks <- forM files $ \file -> return+    [ env (setupEnvJson file) $ \bs -> bgroup file+      [ bench "Run slow make cursor" (whnf SLOW.fromByteString bs)+      , bench "Run fast make cursor" (whnf FAST.fromByteString bs)+      ]+    ]++  return (join benchmarks)++main :: IO ()+main = do+  benchmarks <- fmap mconcat $ sequence $ mempty+    <> [makeBenchBlankJson]+    <> [makeBenchJsonToInterestBits]+    <> [makeBenchMakeCursor]+  defaultMain benchmarks
+ corpus/5000B.json view
@@ -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}}]}]
+ corpus/5000B.json.bp.idx view
@@ -0,0 +1,1 @@+111011010010101010101010101010101010101010101010101010101010101010101010101010101010110100101010101011011110100100111010010011101001000010111010101001101010100010111010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010000101110110101010001101101010100011011010101000110110101010001101101010100011011010101000000
+ corpus/5000B.json.ib.idx view
@@ -0,0 +1,1 @@+10101000000010100000000100000000000000000000000000000100000000100000000000100000000000001000000010000000000000000001000000000000000000000000000000000000000000000100000000000000001000000000000000000000000001000000000000100000000000000000000000000000010000000000000000010000000000000000000000000000000000010000000000000000000010000000000000000001000000000000000001000000100000000000000000000000100010000000000000000100000100000000000000000100010000000000000001000100000000000000000001001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000000001000100000000000000000100000000000000000000100000000000000001000000000000000100000000000000010000000000000000000000000000001000000000000001010000000001000000000000000010000000000000010000000000000000000000000000000100000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001010000000000000000000101010100001000001000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000001010100001000000100000000000000000000000000000000000000000000000000000000000000001000000000000101010000000010000000000000000000100000000000001000000000000000000101000000001000000000000000000000000000000000000001000000000000010000000000000000000000000000000000000000001000000000000000001010100000000000100000010000000001000000000000000000000000000000000000000000000000000001000000000010100000000000000100000000001000000000000010000000001000000000000010000000000000000000001010000000000010000001000000000100000000000000000000000000000000000010000000000101000000000000001000000100000000000001000000000010000000000000100000000000000000010100000000000100000010000000001000000000000000000000000010000000000101000000000000001000000100000000000001000000001000000000000010000000000000000101000000000001000000100000000010000000000000000000000000000000000000000010000000000101000000000000001000000001000000000000010000000001000000000000010000000000000000000101000000000001000000100000000010000000010000000000101000000000000001000000000001000000000000010000000000010000000000000100000000000000000000000010100000000000100000010000000001000000000000000100000000001010000000000000010000001000000000000010000001000000000000010000000000000010100000000000100000010000000001000000001000000000010100000000000000100000010000000000000100000000010000000000000100000000000000000101000000000001000000100000000010000000000000000000000000000000001000000000010100000000000000100000001000000000000010000000000001000000000000010000000000000000000001010000000000010000010000000001000000100000000001010000000000000010000000100000000000001000000001000000000000010000000000000000010100000000000100000100000000010000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000000000000001000000000010100000000000000100000010000000000000100000000100000000000001000000000000000010100000000000100000100000000010000000000000000000000000000010000000000101000000000000001000000000100000000000001000000001000000000000010000000000000000000101000000000001000001000000000100000000000000010000000000101000000000000001000000001000000000000010000000000010000000000000100000000000000000000010100000000000100000100000000010000000000000000000001000000000010100000000000000100000001000000000000010000000100000000000001000000000000000010100000000000100000100000000010000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000001000000000010100000000000000100000000100000000000001000000000100000000000001000000000000000000000100000000000000001010100000000000000101000000001000000001000000000000010000000000001010000000000000010100000000100000000001000000000000010000000000000010100000000000000101000000001000000000000010000000000000100000000000000000101000000000000001010000000010000000000000000000001000000000000010000000000010100000000000000101000000001000000000100000000000001000000000000010100000000000000101000001000010000100000
+ corpus/issue-0001.json view
@@ -0,0 +1,1 @@+[ { "total_money_raised" : "$39.8M", "funding_rounds" : [], "investments" : [], "acquisition" : { "price_amount" : 30000000, "price_currency_code" : "USD", "term_code" : "cash_and_stock", "source_url" : "http://allthingsd.com/20131216/viggle-tries-to-bulk-up-its-social-tv-business-by-buying-wetpaint/?mod=atdtweet", "source_description" : " Viggle Tries to Bulk Up Its Social TV Business by Buying Wetpaint", "acquired_year" : 2013, "acquired_month" : 12, "acquired_day" : 16, "acquiring_company" : { "name" : "Viggle", "permalink" : "viggle" } }, "acquisitions" : [], "offices" : [ { "description" : "", "address1" : "710 - 2nd Avenue", "address2" : "Suite 1100", "zip_code" : "98104", "city" : "Seattle", "state_code" : "WA", "country_code" : "USA", "latitude" : 47.603122, "longitude" : -122.333253 }, { "description" : "", "address1" : "270 Lafayette Street", "address2" : "Suite 505", "zip_code" : "10012", "city" : "New York", "state_code" : "NY", "country_code" : "USA", "latitude" : 40.7237306, "longitude" : -73.9964312 } ], "milestones" : [ { "id" : 5869, "description" : "Wetpaint named in Lead411's Hottest Seattle Companies list", "stoned_year" : 2010, "stoned_month" : 6, "stoned_day" : 8, "source_url" : "http://www.lead411.com/seattle-companies.html", "source_text" : null, "source_description" : "LEAD411 LAUNCHES \"HOTTEST SEATTLE COMPANIES\" AWARDS", "stoneable_type" : "Company", "stoned_value" : null, "stoned_value_type" : null, "stoned_acquirer" : null, "stoneable" : { "name" : "Wetpaint", "permalink" : "wetpaint" } }, { "id" : 8702, "description" : "Site-Builder Wetpaint Makes One For Itself, Using the Demand Media Playbook", "stoned_year" : 2010, "stoned_month" : 9, "stoned_day" : 6, "source_url" : "http://mediamemo.allthingsd.com/20100906/site-builder-wetpaint-makes-one-for-itself-using-the-demand-media-playbook/", "source_text" : null, "source_description" : "All Things D", "stoneable_type" : "Company", "stoned_value" : null, "stoned_value_type" : null, "stoned_acquirer" : null, "stoneable" : { "name" : "Wetpaint", "permalink" : "wetpaint" } } ], "video_embeds" : [], "screenshots" : [ { "available_sizes" : [ [ [ 150, 86 ], "assets/images/resized/0016/0929/160929v2-max-150x150.png" ], [ [ 250, 143 ], "assets/images/resized/0016/0929/160929v2-max-250x250.png" ], [ [ 450, 258 ], "assets/images/resized/0016/0929/160929v2-max-450x450.png" ] ], "attribution" : null } ], "external_links" : [ { "external_url" : "http://www.geekwire.com/2011/rewind-ben-elowitz-wetpaint-ceo-building-type-media-company", "title" : "GeekWire interview: Rewind - Ben Elowitz, Wetpaint CEO, on building a new type of media company" }, { "external_url" : "http://techcrunch.com/2012/06/17/search-and-social-how-two-will-soon-become-one/", "title" : "Guest post by CEO Ben Elowitz in TechCrunch" }, { "external_url" : "http://allthingsd.com/20120516/what-to-expect-when-facebook-is-expecting-five-predictions-for-facebooks-first-public-year/", "title" : "Guest post by CEO Ben Elowitz in AllThingsD" }, { "external_url" : "http://adage.com/article/digitalnext/facebook-biggest-player-advertising-s-540-billion-world/235708/", "title" : "Guest post by CEO Ben Elowitz in AdAge" }, { "external_url" : "http://www.businessinsider.com/facebook-captures-14-percent-of-our-online-attention-but-only-4-percent-of-ad-spending-online-2012-6", "title" : "Guest post by CEO Ben Elowitz in Business Insider" }, { "external_url" : "http://allfacebook.com/wetpaint-media-data_b75963", "title" : "AllFacebook coverage of Wetpaint" }, { "external_url" : "http://adage.com/article/digital/celeb-site-wetpaint-shows-media-profit-facebook/237828/", "title" : "Profile of Wetpaint in Ad Age" }, { "external_url" : "http://allthingsd.com/20121018/how-to-boost-your-facebook-traffic-tips-and-tricks-from-wetpaint/", "title" : "Interview with Wetpaint CEO Ben Elowitz in All Things D" }, { "external_url" : "http://www.xconomy.com/seattle/2012/10/19/wetpaint-starts-licensing-its-facebook-based-media-distribution-tech/", "title" : "Profile of Wetpaint in Xconomy" } ]}, {}]
+ corpus/issue-0001.json.bp.idx view
@@ -0,0 +1,1 @@+111010101010101011010101010101010101010101010101010110101010001010101110101010101010101010101010101010101001101010101010101010101010101010101010001011101010101010101010101010101010101010101010101010101101010100011010101010101010101010101010101010101010101010101011010101000010101011101111010010011101001001110100100010100010111010101001101010100110101010011010101001101010100110101010011010101001101010100110101010000100
+ corpus/issue-0001.json.ib.idx view
@@ -0,0 +1,1 @@+1010100000000000000000000001000000000100000000000000000010001000000000000000100010000000000000001010000000000000000100000000010000000000000000000000010000001000000000000010000000000000000010000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000000000000100000000000000000000000000000000000000000000000000000000000000000000010000000000000000010000010000000000000000001000100000000000000001000100000000000000000000010100000000100000000010000000000000100000000000001000000000000000010001000000000001010100000000000000010001000000000000100000000000000000001000000000000100000000000001000000000000100000000100000000100000000001000000000000001000001000000000000000010000001000000000000100000000001000000000000010000000000000010100000000000000010001000000000000100000000000000000000000100000000000010000000000001000000000000100000000100000000100000000000100000000000000100000100000000000000001000000100000000000010000000000010000000000000100000000000000001000000000000001010100000010000010000000000000001000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000010010000000000000010010000000000000010000000000000000000000000000000000000000000000001000000000000000100000100000000000000000000001000000000000000000000000000000000000000000000000000000001000000000000000000100000000001000000000000000010000010000000000000000000001000001000000000000000000010000010000000000000101000000001000000000001000000000000010000000000000001010000001000001000000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000010010000000000000010010000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000000000010000000000000001000000000000000000100000000001000000000000000010000010000000000000000000001000001000000000000000000010000010000000000000101000000001000000000001000000000000010000000000000000010000000000000000100010000000000000001010100000000000000000001010101000010000010000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000000001000000000000000100000000010000000000000000001010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000010000000000000000000000000000000000000000000000000000000000001010000000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000001000000000000000000000000000000
+ corpus/issue-0001.md view
@@ -0,0 +1,9 @@+In this issue, there is a missing open close at the end of the JSON document.++Erroneous balance parens calculated:++    |<---------------------- last 64-bits ------------------------>|+    011010101001101010100110101010000100+    0110101010011010101001101010100000000000000000000000000000000000+                                     ^+                                     +---- missing bit
+ hw-json-standard-cursor.cabal view
@@ -0,0 +1,183 @@+cabal-version:  2.2++name:           hw-json-standard-cursor+version:        0.1.0.0+synopsis:       Memory efficient JSON parser+description:    Memory efficient JSON parser. Please see README.md+category:       Data+homepage:       http://github.com/haskell-works/hw-json-standard-cursor#readme+bug-reports:    https://github.com/haskell-works/hw-json-standard-cursor/issues+author:         John Ky+maintainer:     newhoggy@gmail.com+copyright:      2016 - 2019 John Ky+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    corpus/5000B.json+    corpus/5000B.json.bp.idx+    corpus/5000B.json.ib.idx+    corpus/issue-0001.json+    corpus/issue-0001.json.bp.idx+    corpus/issue-0001.json.ib.idx+    corpus/issue-0001.md++source-repository head+  type: git+  location: https://github.com/haskell-works/hw-json-standard-cursor++flag bmi2+  description:  Enable bmi2 instruction set+  manual:       False+  default:      False++flag sse42+  description:  Enable sse4.2 instruction set+  manual:       False+  default:      False++common base                 { build-depends: base                 >= 4          && < 5      }++common ansi-wl-pprint       { build-depends: ansi-wl-pprint       >= 0.6.8.2    && < 0.7    }+common array                { build-depends: array                >= 0.5        && < 0.6    }+common attoparsec           { build-depends: attoparsec           >= 0.13       && < 0.14   }+common bits-extra           { build-depends: bits-extra           >= 0.0.1.3    && < 0.1    }+common bytestring           { build-depends: bytestring           >= 0.10.6     && < 0.11   }+common criterion            { build-depends: criterion            >= 1.4        && < 1.6    }+common directory            { build-depends: directory            >= 1.3        && < 1.4    }+common dlist                { build-depends: dlist                >= 0.8        && < 0.9    }+common generic-lens         { build-depends: generic-lens         >= 1.1.0.0    && < 1.2    }+common hedgehog             { build-depends: hedgehog             >= 0.6        && < 1.1    }+common hspec                { build-depends: hspec                >= 2.4        && < 3      }+common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.3.0.0    && < 0.4    }+common hw-bits              { build-depends: hw-bits              >= 0.7.0.5    && < 0.8    }+common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1.0.4    && < 0.2    }+common hw-json-simd         { build-depends: hw-json-simd         >= 0.1.0.2    && < 0.2    }+common hw-mquery            { build-depends: hw-mquery            >= 0.2.0.0    && < 0.3    }+common hw-parser            { build-depends: hw-parser            >= 0.1        && < 0.2    }+common hw-prim              { build-depends: hw-prim              >= 0.6.2.28   && < 0.7    }+common hw-rankselect        { build-depends: hw-rankselect        >= 0.13       && < 0.14   }+common hw-rankselect-base   { build-depends: hw-rankselect-base   >= 0.3.2.1    && < 0.4    }+common hw-simd              { build-depends: hw-simd              >= 0.1.1.2    && < 0.2    }+common lens                 { build-depends: lens                 >= 4          && < 5      }+common mmap                 { build-depends: mmap                 >= 0.5        && < 0.6    }+common optparse-applicative { build-depends: optparse-applicative >= 0.14       && < 0.15   }+common text                 { build-depends: text                 >= 1.2        && < 1.3    }+common transformers         { build-depends: transformers         >= 0.4        && < 0.6    }+common vector               { build-depends: vector               >= 0.12       && < 0.13   }+common word8                { build-depends: word8                >= 0.1        && < 0.2    }++common semigroups   { if impl(ghc <  8    ) { build-depends: semigroups     >= 0.16     && < 0.19 } }++common config+  default-language:   Haskell2010+  ghc-options:        -Wall -O2 -msse4.2+  if flag(sse42)+    ghc-options: -msse4.2+  if flag(bmi2) && impl(ghc >= 8.4.1)+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED++library+  import:   base, config+          , array+          , bits-extra+          , bytestring+          , hw-balancedparens+          , hw-bits+          , hw-prim+          , hw-rankselect+          , hw-rankselect-base+          , mmap+          , vector+          , word8+  hs-source-dirs:       src+  other-modules:        Paths_hw_json_standard_cursor+  autogen-modules:      Paths_hw_json_standard_cursor+  exposed-modules:      HaskellWorks.Data.Json.Standard.Cursor+                        HaskellWorks.Data.Json.Standard.Cursor.Fast+                        HaskellWorks.Data.Json.Standard.Cursor.Generic+                        HaskellWorks.Data.Json.Standard.Cursor.Index+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.IbBp+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.StateMachine+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.ToInterestBits64+                        HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8+                        HaskellWorks.Data.Json.Standard.Cursor.Load.Cursor+                        HaskellWorks.Data.Json.Standard.Cursor.Load.Raw+                        HaskellWorks.Data.Json.Standard.Cursor.SemiIndex+                        HaskellWorks.Data.Json.Standard.Cursor.Slow+                        HaskellWorks.Data.Json.Standard.Cursor.Specific+                        HaskellWorks.Data.Json.Standard.Cursor.Type++executable hw-json-standard-cursor+  import:   base, config+          , bytestring+          , dlist+          , generic-lens+          , hw-balancedparens+          , hw-json-simd+          , hw-mquery+          , hw-prim+          , hw-rankselect+          , hw-rankselect-base+          , lens+          , mmap+          , optparse-applicative+          , semigroups+          , text+          , vector+  main-is:            Main.hs+  hs-source-dirs:     app+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  build-depends:      hw-json-standard-cursor+  other-modules:+      App.Commands+      App.Commands.CreateIndex+      App.Commands.Types++test-suite hw-json-standard-cursor-test+  import:   base, config+          , attoparsec+          , bytestring+          , hedgehog+          , hspec+          , hw-balancedparens+          , hw-bits+          , hw-hspec-hedgehog+          , hw-prim+          , hw-rankselect+          , hw-rankselect-base+          , transformers+          , vector+  type:               exitcode-stdio-1.0+  main-is:            Spec.hs+  build-depends:      hw-json-standard-cursor+  hs-source-dirs:     test+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  build-tools:        hspec-discover+  other-modules:+      HaskellWorks.Data.Json.Standard.CorpusSpec+      HaskellWorks.Data.Json.Standard.Cursor.BalancedParensSpec+      HaskellWorks.Data.Json.Standard.Cursor.InterestBitsSpec+      HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankSpec+      HaskellWorks.Data.Json.Standard.Cursor.TypeSpec+      HaskellWorks.Data.Json.Standard.CursorSpec+      HaskellWorks.Data.Json.Standard.GenCursorTest++benchmark bench+  import:   base, config+          , bytestring+          , criterion+          , directory+          , mmap+          , semigroups+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     bench+  build-depends:      hw-json-standard-cursor+  other-modules:      Paths_hw_json_standard_cursor
+ src/HaskellWorks/Data/Json/Standard/Cursor.hs view
@@ -0,0 +1,3 @@+module HaskellWorks.Data.Json.Standard.Cursor+  (+  ) where
+ src/HaskellWorks/Data/Json/Standard/Cursor/Fast.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Standard.Cursor.Fast+  ( Cursor+  , fromByteString+  , fromForeignRegion+  , fromString+  ) where++import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Standard.Cursor.Specific+import HaskellWorks.Data.RankSelect.CsPoppy++import qualified Data.ByteString                                      as BS+import qualified Data.ByteString.Char8                                as BSC+import qualified Data.ByteString.Internal                             as BSI+import qualified Data.Vector.Storable                                 as DVS+import qualified HaskellWorks.Data.BalancedParens.RangeMin            as RM+import qualified HaskellWorks.Data.FromForeignRegion                  as F+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.IbBp as J++data Fast++instance SpecificCursor Fast where+  type CursorOf Fast = Cursor++type Cursor = GenericCursor BS.ByteString CsPoppy (RM.RangeMin (DVS.Vector Word64))++fromByteString :: BS.ByteString -> Cursor+fromByteString bs = GenericCursor+  { cursorText      = bs+  , interests       = makeCsPoppy ib+  , balancedParens  = RM.mkRangeMin bp+  , cursorRank      = 1+  }+  where J.IbBp ib bp = J.toIbBp bs++fromForeignRegion :: F.ForeignRegion -> Cursor+fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++fromString :: String -> Cursor+fromString = fromByteString . BSC.pack
+ src/HaskellWorks/Data/Json/Standard/Cursor/Generic.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}++module HaskellWorks.Data.Json.Standard.Cursor.Generic+  ( GenericCursor(..)+  , jsonCursorPos+  ) where++import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.TreeCursor+import Prelude                                   hiding (drop)++import qualified HaskellWorks.Data.BalancedParens as BP++data GenericCursor t v w = GenericCursor+  { cursorText     :: !t+  , interests      :: !v+  , balancedParens :: !w+  , cursorRank     :: !Count+  }+  deriving (Eq, Show)++instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where+  firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k)++  parent :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  depth :: GenericCursor t v u -> Maybe Count+  depth k = BP.depth (balancedParens k) (cursorRank k)++  subtreeSize :: GenericCursor t v u -> Maybe Count+  subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+  where ik  = interests k+        bpk = balancedParens k
+ src/HaskellWorks/Data/Json/Standard/Cursor/Index.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Standard.Cursor.Index+  ( indexJson+  ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Standard.Cursor.Generic++import qualified Data.ByteString                             as BS+import qualified Data.Vector.Storable                        as DVS+import qualified HaskellWorks.Data.ByteString                as BS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW++indexJson :: String -> IO ()+indexJson filename = do+  bs <- BS.mmap filename+  -- We use the SLOW reference implementation because we are writing to a file and will never query.+  let GenericCursor _ !ib (SimpleBalancedParens !bp) _ = SLOW.fromByteString bs+  let wib = DVS.unsafeCast ib :: DVS.Vector Word8+  let wbp = DVS.unsafeCast bp :: DVS.Vector Word8+  BS.writeFile (filename ++ ".ib.idx") (BS.toByteString wib)+  BS.writeFile (filename ++ ".bp.idx") (BS.toByteString wbp)
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/Blank.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank+  ( blankJson+  ) where++import Data.ByteString                                       (ByteString)+import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8+import Prelude                                               as P++import qualified Data.ByteString as BS++data BlankState+  = Escaped+  | InJson+  | InString+  | InNumber+  | InIdent++blankJson :: [BS.ByteString] -> [BS.ByteString]+blankJson = blankJson' InJson++blankJson' :: BlankState -> [BS.ByteString] -> [BS.ByteString]+blankJson' lastState as = case as of+  (bs:bss) ->+      let (!cs, Just (!nextState, _)) = BS.unfoldrN (BS.length bs) blankByteString (lastState, bs) in+      cs:blankJson' nextState bss+  [] -> []+  where+    blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))+    blankByteString (InJson, bs) = case BS.uncons bs of+      Just (!c, !cs) | isLeadingDigit c -> Just (_1          , (InNumber , cs))+      Just (!c, !cs) | c == _quotedbl   -> Just (_parenleft  , (InString , cs))+      Just (!c, !cs) | isAlphabetic c   -> Just (c           , (InIdent  , cs))+      Just (!c, !cs)                    -> Just (c           , (InJson   , cs))+      Nothing                           -> Nothing+    blankByteString (InString, bs) = case BS.uncons bs of+      Just (!c, !cs) | c == _backslash -> Just (_space      , (Escaped  , cs))+      Just (!c, !cs) | c == _quotedbl  -> Just (_parenright , (InJson   , cs))+      Just (_ , !cs)                   -> Just (_space      , (InString , cs))+      Nothing                          -> Nothing+    blankByteString (Escaped, bs) = case BS.uncons bs of+      Just (_, !cs) -> Just (_space, (InString, cs))+      Nothing       -> Nothing+    blankByteString (InNumber, bs) = case BS.uncons bs of+      Just (!c, !cs) | isTrailingDigit c -> Just (_0          , (InNumber , cs))+      Just (!c, !cs) | c == _quotedbl    -> Just (_parenleft  , (InString , cs))+      Just (!c, !cs) | isAlphabetic c    -> Just (c           , (InIdent  , cs))+      Just (!c, !cs)                     -> Just (c           , (InJson   , cs))+      Nothing                            -> Nothing+    blankByteString (InIdent, bs) = case BS.uncons bs of+      Just (!c, !cs) | isAlphabetic c   -> Just (_underscore , (InIdent  , cs))+      Just (!c, !cs) | isLeadingDigit c -> Just (_1          , (InNumber , cs))+      Just (!c, !cs) | c == _quotedbl   -> Just (_parenleft  , (InString , cs))+      Just (!c, !cs)                    -> Just (c           , (InJson   , cs))+      Nothing                           -> Nothing
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/BlankedJson.hs view
@@ -0,0 +1,24 @@++module HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson+  ( BlankedJson(..)+  , ToBlankedJson(..)+  , toBlankedJsonTyped+  ) where++import HaskellWorks.Data.ByteString+import HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank++import qualified Data.ByteString as BS++newtype BlankedJson = BlankedJson+  { unBlankedJson :: [BS.ByteString]+  } deriving (Eq, Show)++class ToBlankedJson a where+  toBlankedJson :: a -> [BS.ByteString]++instance ToBlankedJson BS.ByteString where+  toBlankedJson bs = blankJson (chunkedBy 4096 bs)++toBlankedJsonTyped :: ToBlankedJson a => a -> BlankedJson+toBlankedJsonTyped = BlankedJson . toBlankedJson
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/IbBp.hs view
@@ -0,0 +1,24 @@+module HaskellWorks.Data.Json.Standard.Cursor.Internal.IbBp where++import Data.Word++import qualified Data.ByteString                                                    as BS+import qualified Data.Vector.Storable                                               as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToInterestBits64   as J++data IbBp = IbBp+  { ib :: DVS.Vector Word64+  , bp :: DVS.Vector Word64+  }++class ToIbBp a where+  toIbBp :: a -> IbBp++instance ToIbBp BS.ByteString where+  toIbBp bs = IbBp+    { ib = J.toInterestBits64 blankedJson+    , bp = J.toBalancedParens64 blankedJson+    }+    where blankedJson = J.toBlankedJsonTyped bs
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/MakeIndex.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex+  ( blankedJsonToInterestBits+  , byteStringToBits+  , blankedJsonToBalancedParens+  , compressWordAsBit+  , interestingWord8s+  ) where++import Control.Monad+import Data.Array.Unboxed             ((!))+import Data.ByteString                (ByteString)+import Data.Int+import Data.Word+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import Prelude                        as P++import qualified Data.Array.Unboxed as A+import qualified Data.Bits          as BITS+import qualified Data.ByteString    as BS++interestingWord8s :: A.UArray Word8 Word8+interestingWord8s = A.array (0, 255) [+  (w, if w == _bracketleft || w == _braceleft || w == _parenleft || w == _t || w == _f || w == _n || w == _1+    then 1+    else 0)+  | w <- [0 .. 255]]++blankedJsonToInterestBits :: [BS.ByteString] -> [BS.ByteString]+blankedJsonToInterestBits = blankedJsonToInterestBits' ""++padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString+padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs)+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen cs = case BS.uncons cs of+          Just (c, ds) -> Just (c, ds)+          Nothing      -> Just (w, BS.empty)++blankedJsonToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]+blankedJsonToInterestBits' rs as = case as of+  (bs:bss) ->+      let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs in+      let lencs = BS.length cs in+      let q = lencs + 7 `quot` 8 in+      let (ds, es) = BS.splitAt (q * 8) cs in+      let (fs, _) = BS.unfoldrN q gen ds in+      fs:blankedJsonToInterestBits' es bss+  [] -> []+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen ds = if BS.length ds == 0+          then Nothing+          else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 ds))+                    , BS.drop 8 ds+                    )++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 :: [BS.ByteString] -> [BS.ByteString]+compressWordAsBit = compressWordAsBit' BS.empty++compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]+compressWordAsBit' aBS as = case as of+  (bBS:bBSs) ->+    let (cBS, dBS) = repartitionMod8 aBS bBS in+    let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS in+    cs:compressWordAsBit' dBS bBSs+  [] -> do+    let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS+    [cs]+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen xs = if BS.length xs == 0+          then Nothing+          else Just ( BS.foldr (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (padRight 0 8 (BS.take 8 xs))+                    , BS.drop 8 xs+                    )++blankedJsonToBalancedParens :: [BS.ByteString] -> [BS.ByteString]+blankedJsonToBalancedParens as = case as of+  (bs:bss) ->+    let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs) in+    cs:blankedJsonToBalancedParens bss+  [] -> []+  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)+            MiniT  -> Just (0xFF, (Nothing    , cs))+            MiniF  -> Just (0x00, (Nothing    , cs))+            MiniTF -> Just (0xFF, (Just False , cs))+          Nothing   -> Nothing++data MiniBP = MiniN | MiniT | MiniF | MiniTF++balancedParensOf :: Word8 -> MiniBP+balancedParensOf c = case c of+    d | d == _braceleft    -> MiniT+    d | d == _braceright   -> MiniF+    d | d == _bracketleft  -> MiniT+    d | d == _bracketright -> MiniF+    d | d == _parenleft    -> MiniT+    d | d == _parenright   -> MiniF+    d | d == _t            -> MiniTF+    d | d == _f            -> MiniTF+    d | d == _1            -> MiniTF+    d | d == _n            -> MiniTF+    _                      -> MiniN++yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool]+yieldBitsOfWord8 w =+  (((w .&. BITS.bit 0) /= 0):) .+  (((w .&. BITS.bit 1) /= 0):) .+  (((w .&. BITS.bit 2) /= 0):) .+  (((w .&. BITS.bit 3) /= 0):) .+  (((w .&. BITS.bit 4) /= 0):) .+  (((w .&. BITS.bit 5) /= 0):) .+  (((w .&. BITS.bit 6) /= 0):) .+  (((w .&. BITS.bit 7) /= 0):)++yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool]+yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) id++byteStringToBits :: [BS.ByteString] -> [Bool] -> [Bool]+byteStringToBits as = case as of+  (bs:bss) -> yieldBitsofWord8s (BS.unpack bs) . byteStringToBits bss+  []       -> id
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/StateMachine.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE BinaryLiterals             #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.StateMachine+  ( lookupPhiTable+  , lookupTransitionTable+  , phiTable+  , phiTableSimd+  , transitionTable+  , transitionTableSimd+  , IntState(..)+  , State(..)+  ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise++import qualified Data.Vector                                           as DV+import qualified Data.Vector.Storable                                  as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 as W8++{-# ANN module ("HLint: ignore Redundant guard"  :: String) #-}++newtype IntState = IntState Int deriving (Eq, Ord, Show, Num)++data State = InJson | InString | InEscape | InValue deriving (Eq, Enum, Bounded, Show)++phiTable :: DV.Vector (DVS.Vector Word8)+phiTable = DV.constructN 5 gos+  where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8+        gos v = DVS.constructN 256 go+          where vi = DV.length v+                go :: DVS.Vector Word8 -> Word8+                go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum vi)))+                  where ui = DVS.length u+{-# NOINLINE phiTable #-}++phiTable2 :: DVS.Vector Word8+phiTable2 = DVS.constructN (4 * fromIntegral iLen) go+  where iLen = 256 :: Int+        go :: DVS.Vector Word8 -> Word8+        go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj))))+          where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen+{-# NOINLINE phiTable2 #-}++lookupPhiTable :: IntState -> Word8 -> Word8+lookupPhiTable (IntState s) w = DVS.unsafeIndex phiTable2 (s * 256 + fromIntegral w)+{-# INLINE lookupPhiTable #-}++phiTableSimd :: DVS.Vector Word32+phiTableSimd = DVS.constructN 256 go+  where go :: DVS.Vector Word32 -> Word32+        go v =  (snd (stateMachine vi InJson  ) .<.  0) .|.+                (snd (stateMachine vi InString) .<.  8) .|.+                (snd (stateMachine vi InEscape) .<. 16) .|.+                (snd (stateMachine vi InValue ) .<. 24)+          where vi = fromIntegral (DVS.length v)+{-# NOINLINE phiTableSimd #-}++transitionTable :: DV.Vector (DVS.Vector Word8)+transitionTable = DV.constructN 5 gos+  where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8+        gos v = DVS.constructN 256 go+          where vi = DV.length v+                go :: DVS.Vector Word8 -> Word8+                go u = fromIntegral (fromEnum (fst (stateMachine ui (toEnum vi))))+                  where ui = fromIntegral (DVS.length u)+{-# NOINLINE transitionTable #-}++transitionTable2 :: DVS.Vector Word8+transitionTable2 = DVS.constructN (4 * fromIntegral iLen) go+  where iLen = 256 :: Int+        go :: DVS.Vector Word8 -> Word8+        go u = fromIntegral (fromEnum (fst (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj)))))+          where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen+{-# NOINLINE transitionTable2 #-}++lookupTransitionTable :: IntState -> Word8 -> IntState+lookupTransitionTable (IntState s) w = fromIntegral (DVS.unsafeIndex transitionTable2 (s * 256 + fromIntegral w))+{-# INLINE lookupTransitionTable #-}++transitionTableSimd :: DVS.Vector Word64+transitionTableSimd = DVS.constructN 256 go+  where go :: DVS.Vector Word64 -> Word64+        go v =  fromIntegral (fromEnum (fst (stateMachine vi InJson  ))) .|.+                fromIntegral (fromEnum (fst (stateMachine vi InString))) .|.+                fromIntegral (fromEnum (fst (stateMachine vi InEscape))) .|.+                fromIntegral (fromEnum (fst (stateMachine vi InValue )))+          where vi = fromIntegral (DVS.length v)+{-# NOINLINE transitionTableSimd #-}++stateMachine :: Word8 -> State -> (State, Word32)+stateMachine c InJson   | W8.isOpen c         = (InJson  , 0b110)+stateMachine c InJson   | W8.isClose c        = (InJson  , 0b001)+stateMachine c InJson   | W8.isDelim c        = (InJson  , 0b000)+stateMachine c InJson   | W8.isValueChar c    = (InValue , 0b111)+stateMachine c InJson   | W8.isDoubleQuote c  = (InString, 0b111)+stateMachine _ InJson   | otherwise           = (InJson  , 0b000)+stateMachine c InString | W8.isDoubleQuote c  = (InJson  , 0b000)+stateMachine c InString | W8.isBackSlash c    = (InEscape, 0b000)+stateMachine _ InString | otherwise           = (InString, 0b000)+stateMachine _ InEscape | otherwise           = (InString, 0b000)+stateMachine c InValue  | W8.isOpen c         = (InJson  , 0b110)+stateMachine c InValue  | W8.isClose c        = (InJson  , 0b001)+stateMachine c InValue  | W8.isDelim c        = (InJson  , 0b000)+stateMachine c InValue  | W8.isValueChar c    = (InValue , 0b000)+stateMachine _ InValue  | otherwise           = (InJson  , 0b000)+{-# INLINE stateMachine #-}
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/ToBalancedParens64.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64+  ( ToBalancedParens64(..)+  ) where++import Control.Applicative+import Data.Word+import HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex++import qualified Data.ByteString.Lazy                                        as LBS+import qualified Data.Vector.Storable                                        as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson as J++genBitWordsForever :: LBS.ByteString -> Maybe (Word8, LBS.ByteString)+genBitWordsForever bs = LBS.uncons bs <|> Just (0, bs)+{-# INLINE genBitWordsForever #-}++class ToBalancedParens64 a where+  toBalancedParens64 :: a -> DVS.Vector Word64++instance ToBalancedParens64 J.BlankedJson where+  toBalancedParens64 (J.BlankedJson bj) = DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)+    where bpBS    = LBS.fromChunks (compressWordAsBit (blankedJsonToBalancedParens bj))+          newLen  = fromIntegral ((LBS.length bpBS + 7) `div` 8 * 8)
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/ToInterestBits64.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.ToInterestBits64+  ( ToInterestBits64(..)+  ) where++import Control.Applicative+import Data.ByteString.Internal+import Data.Word+import HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex++import qualified Data.ByteString                                             as BS+import qualified Data.Vector.Storable                                        as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson as J++class ToInterestBits64 a where+  toInterestBits64 :: a -> DVS.Vector Word64++instance ToInterestBits64 J.BlankedJson where+  toInterestBits64 bj = DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)+    where interestBS    = blankedJsonBssToInterestBitsBs (J.unBlankedJson bj)+          newLen        = (BS.length interestBS + 7) `div` 8 * 8++blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString+blankedJsonBssToInterestBitsBs bss = BS.concat $ blankedJsonToInterestBits bss++genInterestForever :: ByteString -> Maybe (Word8, ByteString)+genInterestForever bs = BS.uncons bs <|> Just (0, bs)
+ src/HaskellWorks/Data/Json/Standard/Cursor/Internal/Word8.hs view
@@ -0,0 +1,72 @@+module HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 where++import Data.Word+import Data.Word8 hiding (isDigit)++import qualified Data.Char as C++isLeadingDigit :: Word8 -> Bool+isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9)++isTrailingDigit :: Word8 -> Bool+isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e++isAlphabetic :: Word8 -> Bool+isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)++isDigit :: Word8 -> Bool+isDigit w = w >= _0 && w <= _9++wIsJsonNumberDigit :: Word8 -> Bool+wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen++doubleQuote :: Word8+doubleQuote = fromIntegral (C.ord '"')++backSlash :: Word8+backSlash = fromIntegral (C.ord '\\')++openBrace :: Word8+openBrace = fromIntegral (C.ord '{')++closeBrace :: Word8+closeBrace = fromIntegral (C.ord '}')++openBracket :: Word8+openBracket = fromIntegral (C.ord '[')++closeBracket :: Word8+closeBracket = fromIntegral (C.ord ']')++comma :: Word8+comma = fromIntegral (C.ord ',')++colon :: Word8+colon = fromIntegral (C.ord ':')++isPeriod :: Word8 -> Bool+isPeriod w = w == 46++isMinus :: Word8 -> Bool+isMinus w = w == 45++isPlus :: Word8 -> Bool+isPlus w = w == 43++isValueChar :: Word8 -> Bool+isValueChar c = isAlphabetic c || isDigit c || isPeriod c || isMinus c || isPlus c++isOpen :: Word8 -> Bool+isOpen c = c == openBracket || c == openBrace++isClose :: Word8 -> Bool+isClose c = c == closeBracket || c == closeBrace++isDelim :: Word8 -> Bool+isDelim c = c == comma || c == colon++isDoubleQuote :: Word8 -> Bool+isDoubleQuote c = c == doubleQuote++isBackSlash :: Word8 -> Bool+isBackSlash c = c == backSlash
+ src/HaskellWorks/Data/Json/Standard/Cursor/Load/Cursor.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Standard.Cursor.Load.Cursor+  ( loadCursor+  , loadCursorWithIndex+  , loadCursorWithCsPoppyIndex+  , loadCursorWithCsPoppyIndex2+  ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Standard.Cursor.Load.Raw+import HaskellWorks.Data.RankSelect.CsPoppy++import qualified Data.ByteString.Internal                    as BSI+import qualified Data.Vector.Storable                        as DVS+import qualified HaskellWorks.Data.ByteString                as BS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST++loadCursor :: String -> IO FAST.Cursor+loadCursor path = do+  bs <- BS.mmap path+  let !cursor = FAST.fromByteString bs+  return cursor++loadCursorWithIndex :: String -> IO (GenericCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = GenericCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1+  return cursor++loadCursorWithCsPoppyIndex :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithCsPoppyIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1+  return cursor++loadCursorWithCsPoppyIndex2 :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy))+loadCursorWithCsPoppyIndex2 filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens (makeCsPoppy jsonBp)) 1+                :: GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy)+  return cursor
+ src/HaskellWorks/Data/Json/Standard/Cursor/Load/Raw.hs view
@@ -0,0 +1,20 @@+module HaskellWorks.Data.Json.Standard.Cursor.Load.Raw+  ( loadRawWithIndex+  ) where++import Data.Word+import HaskellWorks.Data.FromForeignRegion+import System.IO.MMap++import qualified Data.ByteString      as BS+import qualified Data.Vector.Storable as DVS++loadRawWithIndex :: String -> IO (BS.ByteString, DVS.Vector Word64, DVS.Vector Word64)+loadRawWithIndex filename = do+  jsonFr    <- mmapFileForeignPtr filename ReadOnly Nothing+  jsonIbFr  <- mmapFileForeignPtr (filename ++ ".ib.idx") ReadOnly Nothing+  jsonBpFr  <- mmapFileForeignPtr (filename ++ ".bp.idx") ReadOnly Nothing+  let jsonBS  = fromForeignRegion jsonFr    :: BS.ByteString+  let jsonIb  = fromForeignRegion jsonIbFr  :: DVS.Vector Word64+  let jsonBp  = fromForeignRegion jsonBpFr  :: DVS.Vector Word64+  return (jsonBS, jsonIb, jsonBp)
+ src/HaskellWorks/Data/Json/Standard/Cursor/SemiIndex.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveTraversable   #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Json.Standard.Cursor.SemiIndex+  ( semiIndexBuilder+  , SemiIndex(..)+  , PreSiChunk(..)+  , SiChunk(..)+  , buildSemiIndex+  , State(..)+  , buildFromByteString2+  , buildFromByteString3+  , toIbBpBuilders+  ) where++import Control.Monad.ST+import Data.Bits.Pdep+import Data.Bits.Pext+import Data.Word+import Foreign.Storable                                             (Storable (..))+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Json.Standard.Cursor.Internal.StateMachine (IntState (..), State (..))+import HaskellWorks.Data.Vector.AsVector64++import qualified Data.ByteString                                                    as BS+import qualified Data.ByteString.Builder                                            as B+import qualified Data.ByteString.Lazy                                               as LBS+import qualified Data.ByteString.Unsafe                                             as BSU+import qualified Data.Vector.Storable                                               as DVS+import qualified Data.Vector.Storable.Mutable                                       as DVSM+import qualified HaskellWorks.Data.Bits.Writer.Storable                             as W+import qualified HaskellWorks.Data.ByteString                                       as BS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank              as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex          as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.StateMachine       as SM+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8              as W8++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++data PreSiChunk v = PreSiChunk+  { preSiChunkIb   :: !v -- interest bits+  , preSiChunkBpOp :: !v -- balanced parens interest bits+  , preSiChunkBpCl :: !v -- balanced parens open close+  } deriving (Functor, Traversable, Foldable)++data SiChunk v = SiChunk+  { siChunkIb :: !v -- interest bits+  , siChunkBp :: !v -- balanced parens open close+  } deriving (Functor, Traversable, Foldable)++data SemiIndex v = SemiIndex+  { semiIndexIb :: !v+  , semiIndexBp :: !v+  } deriving (Functor, Traversable, Foldable)++semiIndexBuilder :: LBS.ByteString -> SemiIndex B.Builder+semiIndexBuilder lbs = SemiIndex (B.lazyByteString ibs) (B.byteString (BS.toByteString bps))+  where blankedJson = J.blankJson (LBS.toChunks lbs)+        ibs = LBS.fromChunks (J.blankedJsonToInterestBits blankedJson)+        bps = J.toBalancedParens64 (J.BlankedJson blankedJson)+{-# INLINE semiIndexBuilder #-}++buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64)+buildSemiIndex bs = DVS.createT $ do+  let len = (BS.length bs + 7) `div` 8+  mib <- W.newWriter len+  mbp <- W.newWriter (len * 2)+  buildFromByteString mib mbp bs 0 InJson+{-# INLINE buildSemiIndex #-}++buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> State -> ST s (SemiIndex (DVS.MVector s Word64))+buildFromByteString ib bp bs i = go+  where go state = if i < BS.length bs+          then do+            let c = BSU.unsafeIndex bs i+            case state of+              InJson -> if+                | c == W8.openBracket || c == W8.openBrace -> do+                  W.unsafeWriteBit ib 1+                  W.unsafeWriteBit bp 1+                  buildFromByteString ib bp bs (i + 1) InJson+                | c == W8.closeBracket || c == W8.closeBrace -> do+                  W.unsafeWriteBit bp 0+                  W.unsafeWriteBit ib 0+                  buildFromByteString ib bp bs (i + 1) InJson+                | c == W8.comma || c == W8.colon -> do+                  W.unsafeWriteBit ib 0+                  buildFromByteString ib bp bs (i + 1) InJson+                | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do+                  W.unsafeWriteBit ib 1+                  W.unsafeWriteBit bp 1+                  W.unsafeWriteBit bp 0+                  buildFromByteString ib bp bs (i + 1) InValue+                | c == W8.doubleQuote -> do+                  W.unsafeWriteBit ib 1+                  W.unsafeWriteBit bp 1+                  W.unsafeWriteBit bp 0+                  buildFromByteString ib bp bs (i + 1) InString+                | otherwise -> do+                  W.unsafeWriteBit ib 0+                  buildFromByteString ib bp bs (i + 1) InJson+              InString -> do+                W.unsafeWriteBit ib 0+                let newContext = if+                      | c == W8.doubleQuote -> InJson+                      | c == W8.backSlash   -> InEscape+                      | otherwise           -> InString+                buildFromByteString ib bp bs (i + 1) newContext+              InEscape -> do+                W.unsafeWriteBit ib 0+                buildFromByteString ib bp bs (i + 1) InString+              InValue -> if+                | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do+                  W.unsafeWriteBit ib 0+                  buildFromByteString ib bp bs (i + 1) InValue+                | otherwise -> go InJson+          else do+            ibv <- W.written ib+            bpv <- W.written bp+            return (SemiIndex ibv bpv)+{-# INLINE buildFromByteString #-}++constructSI :: forall a s. Storable a => Int -> (Int -> s -> (s, a)) -> s -> (s, DVS.Vector a)+constructSI n f state = DVS.createT $ do+  mv <- DVSM.unsafeNew n+  state' <- go 0 state mv+  return (state', mv)+  where go :: Int -> s -> DVSM.MVector t a -> ST t s+        go i s mv = if i < DVSM.length mv+          then do+            let (s', a) = f i s+            DVSM.unsafeWrite mv i a+            go (i + 1) s' mv+          else return s+{-# INLINE constructSI #-}++buildFromByteString2 :: [BS.ByteString] -> [DVS.Vector Word64]+buildFromByteString2 = go (IntState (fromEnum InJson))+  where go :: IntState -> [BS.ByteString] -> [DVS.Vector Word64]+        go s (bs:bss) = v:go s' bss+          where (s', v) = constructSI (BS.length bs `div` 16) f s -- TODO adjust length+                f :: Int -> IntState -> (IntState, Word64)+                f i s'' = let j = i * 16 in transition16 s''+                  (BSU.unsafeIndex bs  j      )+                  (BSU.unsafeIndex bs (j +  1))+                  (BSU.unsafeIndex bs (j +  2))+                  (BSU.unsafeIndex bs (j +  3))+                  (BSU.unsafeIndex bs (j +  4))+                  (BSU.unsafeIndex bs (j +  5))+                  (BSU.unsafeIndex bs (j +  6))+                  (BSU.unsafeIndex bs (j +  7))+                  (BSU.unsafeIndex bs (j +  8))+                  (BSU.unsafeIndex bs (j +  9))+                  (BSU.unsafeIndex bs (j + 10))+                  (BSU.unsafeIndex bs (j + 11))+                  (BSU.unsafeIndex bs (j + 12))+                  (BSU.unsafeIndex bs (j + 13))+                  (BSU.unsafeIndex bs (j + 14))+                  (BSU.unsafeIndex bs (j + 15))+        go _ [] = []+{-# INLINE buildFromByteString2 #-}++transition16 :: IntState+  -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8+  -> (IntState, Word64)+transition16 s  a b c d  e f g h  i j k l  m n o p = (sp, w)+  where (sa, wa) = transition1 s  a+        (sb, wb) = transition1 sa b+        (sc, wc) = transition1 sb c+        (sd, wd) = transition1 sc d+        (se, we) = transition1 sd e+        (sf, wf) = transition1 se f+        (sg, wg) = transition1 sf g+        (sh, wh) = transition1 sg h+        (si, wi) = transition1 sh i+        (sj, wj) = transition1 si j+        (sk, wk) = transition1 sj k+        (sl, wl) = transition1 sk l+        (sm, wm) = transition1 sl m+        (sn, wn) = transition1 sm n+        (so, wo) = transition1 sn o+        (sp, wp) = transition1 so p+        w = (fromIntegral wa       ) .|.+            (fromIntegral wb .<.  4) .|.+            (fromIntegral wc .<.  8) .|.+            (fromIntegral wd .<. 12) .|.+            (fromIntegral we .<. 16) .|.+            (fromIntegral wf .<. 20) .|.+            (fromIntegral wg .<. 24) .|.+            (fromIntegral wh .<. 28) .|.+            (fromIntegral wi .<. 32) .|.+            (fromIntegral wj .<. 36) .|.+            (fromIntegral wk .<. 40) .|.+            (fromIntegral wl .<. 44) .|.+            (fromIntegral wm .<. 48) .|.+            (fromIntegral wn .<. 52) .|.+            (fromIntegral wo .<. 56) .|.+            (fromIntegral wp .<. 60)+{-# INLINE transition16 #-}++transition1 :: IntState -> Word8 -> (IntState, Word64)+transition1 s a = (s', w)+  where s' =                SM.lookupTransitionTable s (fromIntegral a)+        w  = fromIntegral $ SM.lookupPhiTable        s (fromIntegral a)+{-# INLINE transition1 #-}++buildFromByteString3 :: [BS.ByteString] -> [PreSiChunk (DVS.Vector Word64)]+buildFromByteString3 bss = makePreSiChunk <$> buildFromByteString2 bss+  where makePreSiChunk :: DVS.Vector Word64 -> PreSiChunk (DVS.Vector Word64)+        makePreSiChunk v = PreSiChunk (makeIb v) (makeBpOp v) (makeBpCl v)+        makeIb :: DVS.Vector Word64 -> DVS.Vector Word64+        makeIb v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go+          where go :: DVS.Vector Word16 -> Word16+                go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x4444444444444444)+        makeBpOp :: DVS.Vector Word64 -> DVS.Vector Word64+        makeBpOp v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go+          where go :: DVS.Vector Word16 -> Word16+                go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x2222222222222222)+        makeBpCl v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go+          where go :: DVS.Vector Word16 -> Word16+                go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x1111111111111111)++toIbBpBuilders :: [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)]+toIbBpBuilders = go 0 0+  where go :: Word64 -> Word64 -> [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)]+        go b n (PreSiChunk ib bpOp bpCl:cs) = SiChunk ib bp: go b' n' cs+          where ((b', n'), bp) = mkBp b n (DVS.unsafeCast bpOp) (DVS.unsafeCast bpCl)+        go b _ [] = [SiChunk DVS.empty (DVS.singleton b)]+        mkBp :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> ((Word64, Word64), DVS.Vector Word64)+        mkBp b n bpOp bpCl = DVS.createT $ do+          mv <- DVSM.unsafeNew (DVS.length bpOp)+          mkBpGo b n bpOp bpCl mv 0 0+        mkBpGo :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> DVS.MVector s Word64 -> Int -> Int -> ST s ((Word64, Word64), DVS.MVector s Word64)+        mkBpGo b n bpOp bpCl mv vi mvi = if vi < DVS.length bpOp+          then do+            let op = DVS.unsafeIndex bpOp vi+            let cl = DVS.unsafeIndex bpCl vi+            let (slo, mlo) = compress op cl -- slo: source lo, mlo: mask lo+            let wb = pext slo mlo+            let wn = popCount1 mlo+            let tb = (wb .<. n) .|. b+            let tn = n + wn+            if tn < 64+              then do+                mkBpGo tb tn bpOp bpCl mv (vi + 1) mvi+              else do+                DVSM.unsafeWrite mv mvi tb+                let ub = wb .>. (64 - n)+                let un = tn - 64+                mkBpGo ub un bpOp bpCl mv (vi + 1) (mvi + 1)+          else return ((b, n), DVSM.take mvi mv)+        compress :: Word32 -> Word32 -> (Word64, Word64)+        compress op cl = (sw, mw)+          where iop = pdep (fromIntegral op :: Word64) 0x5555555555555555 -- interleaved open+                icl = pdep (fromIntegral cl :: Word64) 0xaaaaaaaaaaaaaaaa -- interleaved close+                ioc = iop .|. icl                                         -- interleaved open/close+                sw  = pext iop ioc+                pc  = popCount1 ioc+                mw  = (1 .<. pc) - 1
+ src/HaskellWorks/Data/Json/Standard/Cursor/Slow.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Standard.Cursor.Slow+  ( Cursor+  , fromByteString+  , fromForeignRegion+  , fromString+  ) where++import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Standard.Cursor.Specific++import qualified Data.ByteString                                      as BS+import qualified Data.ByteString.Char8                                as BSC+import qualified Data.ByteString.Internal                             as BSI+import qualified Data.Vector.Storable                                 as DVS+import qualified HaskellWorks.Data.BalancedParens                     as BP+import qualified HaskellWorks.Data.FromForeignRegion                  as F+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.IbBp as J++data Slow++instance SpecificCursor Slow where+  type CursorOf Slow = Cursor++type Cursor = GenericCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))++fromByteString :: BS.ByteString -> Cursor+fromByteString bs = GenericCursor+    { cursorText      = bs+    , interests       = ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where J.IbBp ib bp = J.toIbBp bs++fromForeignRegion :: F.ForeignRegion -> Cursor+fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++fromString :: String -> Cursor+fromString = fromByteString . BSC.pack
+ src/HaskellWorks/Data/Json/Standard/Cursor/Specific.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Standard.Cursor.Specific+  ( SpecificCursor(..)+  , jsonCursorPos+  ) where++import HaskellWorks.Data.Json.Standard.Cursor.Generic++class SpecificCursor w where+  type CursorOf w
+ src/HaskellWorks/Data/Json/Standard/Cursor/Type.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Standard.Cursor.Type+  ( JsonType(..)+  , JsonTypeAt(..)+  ) where++import Data.Char+import Data.String+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude                                               hiding (drop)++import qualified Data.ByteString                  as BS+import qualified HaskellWorks.Data.BalancedParens as BP++{-# ANN module ("HLint: Reduce duplication" :: String) #-}++data JsonType+  = JsonTypeArray+  | JsonTypeBool+  | JsonTypeNull+  | JsonTypeNumber+  | JsonTypeObject+  | JsonTypeString+  deriving (Eq, Show)++class JsonTypeAt a where+  jsonTypeAtPosition :: Position -> a -> Maybe JsonType+  jsonTypeAt :: a -> Maybe JsonType++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor String v w) where+  jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of+    c:_ | fromIntegral (ord c) == _bracketleft      -> Just JsonTypeArray+    c:_ | fromIntegral (ord c) == _f                -> Just JsonTypeBool+    c:_ | fromIntegral (ord c) == _t                -> Just JsonTypeBool+    c:_ | fromIntegral (ord c) == _n                -> Just JsonTypeNull+    c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber+    c:_ | fromIntegral (ord c) == _braceleft        -> Just JsonTypeObject+    c:_ | fromIntegral (ord c) == _quotedbl         -> Just JsonTypeString+    _                                               -> Nothing++  jsonTypeAt k = jsonTypeAtPosition p k+    where p   = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          ik  = interests k+          bpk = balancedParens k++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor BS.ByteString v w) where+  jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of+    Just (c, _) | c == _bracketleft    -> Just JsonTypeArray+    Just (c, _) | c == _f              -> Just JsonTypeBool+    Just (c, _) | c == _t              -> Just JsonTypeBool+    Just (c, _) | c == _n              -> Just JsonTypeNull+    Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber+    Just (c, _) | c == _braceleft      -> Just JsonTypeObject+    Just (c, _) | c == _quotedbl       -> Just JsonTypeString+    _                                  -> Nothing++  jsonTypeAt k = jsonTypeAtPosition p k+    where p   = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          ik  = interests k+          bpk = balancedParens k
+ test/HaskellWorks/Data/Json/Standard/CorpusSpec.hs view
@@ -0,0 +1,57 @@+{-# 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.Standard.CorpusSpec(spec) where++import Control.Monad.IO.Class+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString                             as BS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Corpus" $ do+  it "Corpus 5000B loads properly" $ requireTest $ do+    inJsonBS                    <- liftIO $ BS.readFile "corpus/5000B.json"+    inInterestBitsBS            <- liftIO $ BS.readFile "corpus/5000B.json.ib.idx"+    inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/5000B.json.bp.idx"+    let inInterestBits            = fromBitTextByteString inInterestBitsBS+    let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS+    let !cursor = SLOW.fromByteString inJsonBS+    let text                    = cursorText      cursor+    let ib                      = interests       cursor+    let SimpleBalancedParens bp = balancedParens  cursor+    text === inJsonBS+    ib === inInterestBits+    bp === inInterestBalancedParens+  it "issue-0001 loads properly" $ requireTest $ do+    inJsonBS                    <- liftIO $ BS.readFile "corpus/issue-0001.json"+    inInterestBitsBS            <- liftIO $ BS.readFile "corpus/issue-0001.json.ib.idx"+    inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/issue-0001.json.bp.idx"+    let inInterestBits            = fromBitTextByteString inInterestBitsBS+    let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS+    let !cursor = SLOW.fromByteString inJsonBS+    let text                    = cursorText      cursor+    let ib                      = interests       cursor+    let SimpleBalancedParens bp = balancedParens  cursor+    text === inJsonBS+    ib === inInterestBits+    bp === inInterestBalancedParens
+ test/HaskellWorks/Data/Json/Standard/Cursor/BalancedParensSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Standard.Cursor.BalancedParensSpec+  ( spec+  ) where++import Data.String+import Data.Word+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString                                             as BS+import qualified Data.Vector.Storable                                        as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.SemiIndex            as SI++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++balancedParensOf2 :: BS.ByteString -> DVS.Vector Word64+balancedParensOf2 bs = let SI.SemiIndex _ bp = SI.buildSemiIndex bs in bp++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Cursor.InterestBitsSpec" $ do+  it "Evaluating interest bits 2" $ requireTest $ do+    bitShow (balancedParensOf2 ""           ) === ""+    bitShow (balancedParensOf2 "  \n \r \t ") === ""+    bitShow (balancedParensOf2 "1234 "      ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "1.1 "       ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "-1.1e-1 "   ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "false "     ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "true "      ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "\"\\\"\" "  ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "{ "         ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "} "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "[ "         ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 "] "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 ": "         ) === ""+    bitShow (balancedParensOf2 ", "         ) === ""+    bitShow (balancedParensOf2 "{{}}"       ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (balancedParensOf2 " { { } } "  ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+  it "Blanking JSON should not contain strange characters 1" $ requireTest $ do+    let blankedJson = J.BlankedJson ["[ [],", "[]]"]+    let bp = BitShown $ BS.concat (blankedJsonToBalancedParens (J.unBlankedJson blankedJson))+    bp === fromString "11111111 11111111 00000000 11111111 00000000 00000000"+  it "Blanking JSON should not contain strange characters 2" $ requireTest $ do+    let blankedJson = J.BlankedJson ["[ [],", "[]]"]+    let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens) (J.unBlankedJson blankedJson))+    bp === fromString "11010000"
+ test/HaskellWorks/Data/Json/Standard/Cursor/InterestBitsSpec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+++module HaskellWorks.Data.Json.Standard.Cursor.InterestBitsSpec(spec) where++import Data.String+import Data.Word+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString                                                  as BS+import qualified Data.Vector.Storable                                             as DVS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson      as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToInterestBits64 as J+import qualified HaskellWorks.Data.Json.Standard.Cursor.SemiIndex                 as SI++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++interestBitsOf :: BS.ByteString -> DVS.Vector Word64+interestBitsOf bs = J.toInterestBits64 (J.toBlankedJsonTyped bs)++interestBitsOf2 :: BS.ByteString -> DVS.Vector Word64+interestBitsOf2 bs = let SI.SemiIndex ib _ = SI.buildSemiIndex bs in ib++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Cursor.InterestBitsSpec" $ do+  it "Evaluating interest bits" $ requireTest $ do+    BitShown (interestBitsOf ""           ) === fromString ""+    BitShown (interestBitsOf "  \n \r \t ") === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "1234 "      ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "1.1 "       ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "-1.1e-2 "   ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "false "     ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "true "      ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "\"hello\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "\"\\\"\" "  ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "{ "         ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "} "         ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "[ "         ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "] "         ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf ": "         ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf ", "         ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf "{{}}"       ) === fromString "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    BitShown (interestBitsOf " { { } } "  ) === fromString "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+  it "Evaluating interest bits 2" $ requireTest $ do+    bitShow (interestBitsOf2 ""           ) === ""+    bitShow (interestBitsOf2 "  \n \r \t ") === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "1234 "      ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "1.1 "       ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "-1.1 "      ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "-1.1e-2 "   ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "false "     ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "true "      ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "\"\\\"\" "  ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "{ "         ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "} "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "[ "         ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "] "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 ": "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 ", "         ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 "{{}}"       ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+    bitShow (interestBitsOf2 " { { } } "  ) === "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"
+ test/HaskellWorks/Data/Json/Standard/Cursor/Internal/BlankSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankSpec (spec) where++import HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString as BS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec+whenBlankedJsonShouldBe original expected = do+  it (show original ++ " when blanked json should be " ++ show expected) $ requireTest $ do+    BS.concat (blankJson [original]) === expected++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Internal.BlankSpec" $ do+  describe "Can blank json" $ do+    "\"\""                                `whenBlankedJsonShouldBe` "()"+    "\"\\\\\""                            `whenBlankedJsonShouldBe` "(  )"+    "\"\\\\\\\""                          `whenBlankedJsonShouldBe` "(    "+    "\" \\\\\\\""                         `whenBlankedJsonShouldBe` "(     "+    "\" \\n\\\\\""                        `whenBlankedJsonShouldBe` "(     )"+    ""                                    `whenBlankedJsonShouldBe` ""+    "\"\""                                `whenBlankedJsonShouldBe` "()"+    "\" \""                               `whenBlankedJsonShouldBe` "( )"+    "\" a \""                             `whenBlankedJsonShouldBe` "(   )"+    " \"a \" x"                           `whenBlankedJsonShouldBe` " (  ) x"+    " \"\"\"\" "                          `whenBlankedJsonShouldBe` " ()() "+    " [][] "                              `whenBlankedJsonShouldBe` " [][] "+    " {}{} "                              `whenBlankedJsonShouldBe` " {}{} "+    " \"a\"b\"c\"d"                       `whenBlankedJsonShouldBe` " ( )b( )d"+    ""                                    `whenBlankedJsonShouldBe` ""+    "1"                                   `whenBlankedJsonShouldBe` "1"+    "11"                                  `whenBlankedJsonShouldBe` "10"+    "00"                                  `whenBlankedJsonShouldBe` "10"+    "00"                                  `whenBlankedJsonShouldBe` "10"+    "-0.12e+34"                           `whenBlankedJsonShouldBe` "100000000"+    "10.12E-34 "                          `whenBlankedJsonShouldBe` "100000000 "+    "10.12E-34 12"                        `whenBlankedJsonShouldBe` "100000000 10"+    " 10.12E-34 -1"                       `whenBlankedJsonShouldBe` " 100000000 10"+    ""                                    `whenBlankedJsonShouldBe` ""+    "a"                                   `whenBlankedJsonShouldBe` "a"+    "z"                                   `whenBlankedJsonShouldBe` "z"+    " Aaa "                               `whenBlankedJsonShouldBe` " A__ "+    " Za def "                            `whenBlankedJsonShouldBe` " Z_ d__ "+    ""                                    `whenBlankedJsonShouldBe` ""+    " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { (  ): 100, [(), t___], n___}"
+ test/HaskellWorks/Data/Json/Standard/Cursor/TypeSpec.hs view
@@ -0,0 +1,110 @@+{-# 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.Standard.Cursor.TypeSpec (spec) where++import Control.Monad+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Standard.Cursor.Type+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString                             as BS+import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW+import qualified HaskellWorks.Data.TreeCursor                as TC++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do+  genSpec "DVS.Vector Word64" SLOW.fromString+  genSpec "CsPoppy"           FAST.fromString++genSpec :: forall t u.+  ( Eq                t+  , Show              t+  , Select1           t+  , Eq                u+  , Show              u+  , Rank0             u+  , Rank1             u+  , BalancedParens    u+  , TestBit           u)+  => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith ()+genSpec t makeCursor = do+  describe ("Json cursor of type " ++ t) $ do+    let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))+    forJson "{}" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeObject+    forJson " {}" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeObject+    forJson "1234" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeNumber+    forJson "\"Hello\"" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeString+    forJson "[]" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeArray+    forJson "true" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeBool+    forJson "false" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeBool+    forJson "null" $ \cursor -> do+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeNull+    forJson "[null]" $ \cursor -> do+      it "should have correct type"       $ requireTest $ (fc >=> jsonTypeAt) cursor === Just JsonTypeNull+    forJson "[null, {\"field\": 1}]" $ \cursor -> do+      it "cursor can navigate to second child of array" $ requireTest $ do+        (fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject+      it "cursor can navigate to first child of object at second child of array" $ requireTest $ do+        (fc >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString+      it "cursor can navigate to first child of object at second child of array" $ requireTest $ do+        (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeNumber+    describe "For empty json array" $ do+      let cursor = makeCursor "[null]"+      it "can navigate down and forwards" $ requireTest $ do+        (                     jsonTypeAt) cursor === Just JsonTypeArray+        (fc               >=> jsonTypeAt) cursor === Just JsonTypeNull+        (fc >=> ns        >=> jsonTypeAt) cursor === Nothing+        (fc >=> ns >=> ns >=> jsonTypeAt) cursor === Nothing+    describe "For sample Json" $ do+      let cursor = makeCursor "{ \+                    \    \"widget\": { \+                    \        \"debug\": \"on\", \+                    \        \"window\": { \+                    \            \"name\": \"main_window\", \+                    \            \"dimensions\": [500, 600.01e-02, true, false, null] \+                    \        } \+                    \    } \+                    \}" :: GenericCursor BS.ByteString t u+      it "can navigate down and forwards" $ requireTest $ do+        (                                                                      jsonTypeAt) cursor === Just JsonTypeObject+        (fc                                                                >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns                                                         >=> jsonTypeAt) cursor === Just JsonTypeObject+        (fc >=> ns >=> fc                                                  >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns                                           >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> jsonTypeAt) cursor === Just JsonTypeObject+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> jsonTypeAt) cursor === Just JsonTypeString+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeArray
+ test/HaskellWorks/Data/Json/Standard/CursorSpec.hs view
@@ -0,0 +1,27 @@+{-# 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.Standard.CursorSpec(spec) where++import HaskellWorks.Data.Json.Standard.GenCursorTest+import Test.Hspec++import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST+import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do+  genTest "DVS.Vector Word64" SLOW.fromString+  genTest "CsPoppy"           FAST.fromString
+ test/HaskellWorks/Data/Json/Standard/GenCursorTest.hs view
@@ -0,0 +1,121 @@+{-# 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.Standard.GenCursorTest(genTest) where++import Control.Monad+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.Bits.BitWise+-- import HaskellWorks.Data.Json.Internal.Index+-- import HaskellWorks.Data.Json.Internal.Standard.Cursor.Token+-- import HaskellWorks.Data.Json.Internal.Token+import HaskellWorks.Data.Json.Standard.Cursor.Generic+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString              as BS+import qualified HaskellWorks.Data.TreeCursor as TC++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling+pn = TC.parent+ss = TC.subtreeSize++strAt :: forall t u.+  ( Eq                t+  , Show              t+  , Select1           t+  , Eq                u+  , Show              u+  , Rank0             u+  , Rank1             u+  , BalancedParens    u+  , TestBit           u)+  => Int+  -> GenericCursor BS.ByteString t u+  -> Maybe BS.ByteString+strAt n k = if balancedParens k .?. lastPositionOf (cursorRank k)+  then Just (BS.take n (BS.drop (fromIntegral (toCount (jsonCursorPos k))) (cursorText k)))+  else Nothing++genTest :: forall t u.+  ( Eq                t+  , Show              t+  , Select1           t+  , Eq                u+  , Show              u+  , Rank0             u+  , Rank1             u+  , BalancedParens    u+  , TestBit           u)+  => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith ()+genTest t mkCursor = do+  describe ("Json cursor of type " ++ t) $ do+    describe "For empty json array" $ do+      let cursor = mkCursor "[null]"+      it "can navigate down and forwards" $ requireTest $ do+        strAt 1 cursor === Just "["+    describe "For sample Json" $ do+      let cursor = mkCursor "\+            \{ \+            \    \"widget\": { \+            \        \"debug\": \"on\", \+            \        \"window\": { \+            \            \"name\": \"main_window\", \+            \            \"dimensions\": [500, 600.01e-02, true, false, null] \+            \        } \+            \    } \+            \}"+      it "can navigate up" $ requireTest $ do+        (                                                                      pn) cursor === Nothing+        (fc                                                                >=> pn) cursor ===                                    Just cursor+        (fc >=> ns                                                         >=> pn) cursor ===                                    Just cursor+        (fc >=> ns >=> fc                                                  >=> pn) cursor === (fc >=> ns                            ) cursor+        (fc >=> ns >=> fc >=> ns                                           >=> pn) cursor === (fc >=> ns                            ) cursor+        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> pn) cursor === (fc >=> ns                            ) cursor+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> pn) cursor === (fc >=> ns                            ) cursor+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+      it "can get subtree size" $ requireTest $ do+        (                                                                      ss) cursor === Just 16+        (fc                                                                >=> ss) cursor === Just 1+        (fc >=> ns                                                         >=> ss) cursor === Just 14+        (fc >=> ns >=> fc                                                  >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns                                           >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> ss) cursor === Just 10+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> ss) cursor === Just 1+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6+      it "can get token at cursor" $ requireTest $ do+        (                                                                      strAt  1) cursor === Just "{"+        (fc                                                                >=> strAt  8) cursor === Just "\"widget\""+        (fc >=> ns                                                         >=> strAt  1) cursor === Just "{"+        (fc >=> ns >=> fc                                                  >=> strAt  7) cursor === Just "\"debug\""+        (fc >=> ns >=> fc >=> ns                                           >=> strAt  4) cursor === Just "\"on\""+        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> strAt  8) cursor === Just "\"window\""+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> strAt  1) cursor === Just "{"+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> strAt  6) cursor === Just "\"name\""+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> strAt 13) cursor === Just "\"main_window\""+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> strAt 12) cursor === Just "\"dimensions\""+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> strAt  1) cursor === Just "["
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}