hw-json 0.9.0.1 → 1.0.0.0

raw patch · 69 files changed

+2651/−1689 lines, 69 filesdep +bits-extradep +hedgehogdep +hw-hspec-hedgehogdep −containersdep ~hspecdep ~hw-bitsdep ~hw-mqueryPVP ok

version bump matches the API change (PVP)

Dependencies added: bits-extra, hedgehog, hw-hspec-hedgehog, hw-json-simd, hw-simd, transformers

Dependencies removed: containers

Dependency ranges changed: hspec, hw-bits, hw-mquery, hw-prim, hw-rankselect, hw-rankselect-base

API changes (from Hackage documentation)

Files

• README.md +12/−10
• app/App/Commands.hs +2/−0
• app/App/Commands/CreateIndex.hs +108/−21
• app/App/Commands/Demo.hs +75/−11
• app/App/Commands/Types.hs +9/−4
• app/App/IO.hs +0/−12
• bench/Main.hs +12/−16
• hw-json.cabal +147/−123
• src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs +89/−0
• src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs +38/−0
• src/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs +80/−0
• src/HaskellWorks/Data/Json/Backend/Simple/Value.hs +43/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs +175/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs +38/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Index.hs +20/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs +53/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs +54/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Load/Raw.hs +20/−0
• src/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs +269/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs +36/−0
• src/HaskellWorks/Data/Json/Cursor.hs +0/−88
• src/HaskellWorks/Data/Json/Internal/Backend/Simple/IbBp.hs +10/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Simple/ToIbBp.hs +12/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs +56/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs +134/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/StateMachine.hs +109/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs +28/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs +31/−0
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs +165/−0
• src/HaskellWorks/Data/Json/Internal/Blank.hs +0/−56
• src/HaskellWorks/Data/Json/Internal/BlankedJson.hs +0/−24
• src/HaskellWorks/Data/Json/Internal/CharLike.hs +1/−1
• src/HaskellWorks/Data/Json/Internal/Cursor/Token.hs +0/−24
• src/HaskellWorks/Data/Json/Internal/Doc.hs +11/−0
• src/HaskellWorks/Data/Json/Internal/IbBp.hs +0/−24
• src/HaskellWorks/Data/Json/Internal/Index.hs +4/−44
• src/HaskellWorks/Data/Json/Internal/MakeIndex.hs +0/−134
• src/HaskellWorks/Data/Json/Internal/PartialIndex.hs +1/−47
• src/HaskellWorks/Data/Json/Internal/Slurp.hs +50/−0
• src/HaskellWorks/Data/Json/Internal/ToBalancedParens64.hs +0/−28
• src/HaskellWorks/Data/Json/Internal/ToInterestBits64.hs +0/−31
• src/HaskellWorks/Data/Json/Internal/Token.hs +1/−1
• src/HaskellWorks/Data/Json/Internal/Token/Tokenize.hs +0/−165
• src/HaskellWorks/Data/Json/Internal/Value.hs +0/−1
• src/HaskellWorks/Data/Json/Internal/Word64.hs +29/−0
• src/HaskellWorks/Data/Json/Internal/Word8.hs +72/−0
• src/HaskellWorks/Data/Json/Internal/Words.hs +0/−16
• src/HaskellWorks/Data/Json/LightJson.hs +11/−184
• src/HaskellWorks/Data/Json/Load.hs +0/−127
• src/HaskellWorks/Data/Json/LoadCursor.hs +0/−109
• src/HaskellWorks/Data/Json/PartialValue.hs +6/−21
• src/HaskellWorks/Data/Json/Query.hs +74/−0
• src/HaskellWorks/Data/Json/Type.hs +1/−45
• test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs +85/−0
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs +41/−0
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs +62/−0
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs +33/−0
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs +103/−0
• test/HaskellWorks/Data/Json/CorpusSpec.hs +22/−21
• test/HaskellWorks/Data/Json/Internal/BlankSpec.hs +5/−3
• test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs +9/−7
• test/HaskellWorks/Data/Json/Succinct/Cursor/InterestBitsSpec.hs +0/−39
• test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +0/−113
• test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +36/−34
• test/HaskellWorks/Data/Json/TypeSpec.hs +47/−51
• test/HaskellWorks/Data/Json/ValueSpec.hs +50/−54

@@ -121,16 +121,18 @@ ### Querying example  ```-import           Control.Monad+import Control.Monad+import Data.Function+import Data.List+import HaskellWorks.Data.Json.Backend.Standard.Load+import HaskellWorks.Data.Json.LoadCursor+import HaskellWorks.Data.Json.PartialValue+import HaskellWorks.Data.MQuery+import HaskellWorks.Data.MQuery.Micro+import HaskellWorks.Data.MQuery.Row+import HaskellWorks.Diagnostics+ import qualified Data.DList as DL-import           Data.Function-import           Data.List-import           HaskellWorks.Data.Json.LoadCursor-import           HaskellWorks.Data.Micro-import           HaskellWorks.Data.MQuery-import           HaskellWorks.Data.Json.PartialValue-import           HaskellWorks.Data.Row-import           HaskellWorks.Diagnostics ```  ```@@ -207,7 +209,7 @@ import HaskellWorks.Data.Positioning import qualified Data.Vector.Storable as DVS import HaskellWorks.Data.IndexedSeq-(jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex "firehose.json"+(jsonBS, jsonIb, jsonBp) <- loadRawWithIndex "firehose.json" let bp1 = SimpleBalancedParens jsonBp let bp2 = SimpleBalancedParens (makePoppy512 jsonBp) let bp3 = makePoppy512 jsonBp

@@ -1,6 +1,7 @@ module App.Commands where  import App.Commands.CreateIndex+import App.Commands.Demo import Data.Semigroup           ((<>)) import Options.Applicative @@ -11,3 +12,4 @@ commandsGeneral = subparser $ mempty   <>  commandGroup "Commands:"   <>  cmdCreateIndex+  <>  cmdDemo

@@ -7,37 +7,96 @@  import App.Commands.Types import Control.Lens+import Control.Monad+import Data.Maybe import Data.Semigroup      ((<>)) import Data.Word import Foreign import Options.Applicative hiding (columns) -import qualified App.Lens                                           as L-import qualified Data.ByteString.Builder                            as B-import qualified Data.ByteString.Internal                           as BSI-import qualified Data.ByteString.Lazy                               as LBS-import qualified Data.Vector.Storable                               as DVS-import qualified HaskellWorks.Data.Json.Internal.Blank              as J-import qualified HaskellWorks.Data.Json.Internal.BlankedJson        as J-import qualified HaskellWorks.Data.Json.Internal.MakeIndex          as J-import qualified HaskellWorks.Data.Json.Internal.ToBalancedParens64 as J-import qualified System.IO                                          as IO-import qualified System.IO.MMap                                     as IO+import qualified App.Lens                                                            as L+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.Backend.Simple.SemiIndex                     as SISI+import qualified HaskellWorks.Data.Json.Backend.Standard.SemiIndex                   as STSI+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.Blank              as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex          as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.Simd.Index.Standard                          as STSI+import qualified System.Exit                                                         as IO+import qualified System.IO                                                           as IO+import qualified System.IO.MMap                                                      as IO -runCreateIndex :: CreateIndexOptions -> IO ()-runCreateIndex opts = do+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++runCreateIndexStandard :: CreateIndexOptions -> IO ()+runCreateIndexStandard opts = do   let filePath = opts ^. L.filePath+  let outputIbFile = opts ^. L.outputIbFile & fromMaybe (filePath <> ".ib.idx")+  let outputBpFile = opts ^. L.outputBpFile & fromMaybe (filePath <> ".bp.idx")+  case opts ^. L.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++runCreateIndexSimple :: CreateIndexOptions -> IO ()+runCreateIndexSimple opts = do+  let filePath = opts ^. L.filePath+  let outputIbFile = opts ^. L.outputIbFile & fromMaybe (filePath <> ".ib.idx")+  let outputBpFile = opts ^. L.outputBpFile & fromMaybe (filePath <> ".bp.idx")   (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)-  let vb = DVS.foldl (\b a -> b <> B.word64LE a) mempty bps-  LBS.writeFile (filePath <> ".ib.idx") ibs-  h <- IO.openFile (filePath <> ".bp.idx") IO.WriteMode-  B.hPutBuilder h vb-  IO.hClose h+  let SISI.SemiIndex _ ibs bps = SISI.buildSemiIndex bs+  LBS.writeFile outputIbFile (LBS.toLazyByteString ibs)+  LBS.writeFile outputBpFile (LBS.toLazyByteString bps) +runCreateIndex :: CreateIndexOptions -> IO ()+runCreateIndex opts = case opts ^. L.backend of+  "standard" -> runCreateIndexStandard  opts+  "simple"   -> runCreateIndexSimple    opts+  unknown    -> IO.hPutStrLn IO.stderr $ "Unknown backend " <> show unknown+ optsCreateIndex :: Parser CreateIndexOptions optsCreateIndex = CreateIndexOptions   <$> strOption@@ -45,6 +104,34 @@         <>  short 'i'         <>  help "Input JSON file"         <>  metavar "STRING"+        )+  <*> strOption+        (   long "backend"+        <>  short 'b'+        <>  value "standard"+        <>  help "Backend for creating index"+        <>  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 ())

@@ -9,24 +9,81 @@ import App.Commands.Types import Control.Lens import Control.Monad-import Data.Semigroup                    ((<>))+import Control.Monad.ST+import Data.Semigroup                                      ((<>))+import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor import HaskellWorks.Data.Json.LightJson-import HaskellWorks.Data.Json.LoadCursor-import HaskellWorks.Data.Micro+import HaskellWorks.Data.Json.Query import HaskellWorks.Data.MQuery-import Options.Applicative               hiding (columns)+import HaskellWorks.Data.MQuery.Micro+import HaskellWorks.Data.RankSelect.CsPoppy+import HaskellWorks.Data.Vector.AsVector8+import Options.Applicative                                 hiding (columns) -import qualified App.Lens   as L-import qualified Data.DList as DL+import qualified App.Lens                                   as L+import qualified Data.ByteString                            as BS+import qualified Data.ByteString.Internal                   as BSI+import qualified Data.ByteString.Lazy                       as LBS+import qualified Data.DList                                 as DL+import qualified Data.Vector.Storable                       as DVS+import qualified Data.Vector.Storable.Mutable               as DVSM+import qualified HaskellWorks.Data.ByteString.Lazy          as LBS+import qualified HaskellWorks.Data.Json.Simd.Index.Standard as S+import qualified Options.Applicative                        as OA+import qualified System.IO                                  as IO+import qualified System.IO.MMap                             as IO +constructUnzipN :: Int -> [(BS.ByteString, BS.ByteString)] -> (DVS.Vector Word64, DVS.Vector Word64)+constructUnzipN nBytes xs = (DVS.unsafeCast ibv, DVS.unsafeCast bpv)+  where [ibv, bpv] = DVS.createT $ do+          let nW64s     = (nBytes + 7) `div` 8+          let capacity  = nW64s * 8+          ibmv <- DVSM.new capacity+          bpmv <- DVSM.new capacity+          (ibmvRemaining, bpmvRemaining) <- go ibmv bpmv xs+          return+            [ DVSM.take (((DVSM.length ibmv - ibmvRemaining) `div` 8) * 8) ibmv+            , DVSM.take (((DVSM.length bpmv - bpmvRemaining) `div` 8) * 8) bpmv+            ]+        go :: DVSM.MVector s Word8 -> DVSM.MVector s Word8 -> [(BS.ByteString, BS.ByteString)] -> ST s (Int, Int)+        go ibmv bpmv ((ib, bp):ys) = do+          DVS.copy (DVSM.take (BS.length ib) ibmv) (asVector8 ib)+          DVS.copy (DVSM.take (BS.length bp) bpmv) (asVector8 bp)+          go (DVSM.drop (BS.length ib) ibmv) (DVSM.drop (BS.length bp) bpmv) ys+        go ibmv bpmv [] = do+          DVSM.set (DVSM.take 8 ibmv) 0+          DVSM.set (DVSM.take 8 bpmv) 0+          return (DVSM.length (DVSM.drop 8 ibmv), DVSM.length (DVSM.drop 8 bpmv))+ runDemo :: DemoOptions -> IO () runDemo opts = do-  !cursor <- loadJsonWithCsPoppyIndex (opts ^. L.filePath)-  let !json = lightJsonAt cursor-  let q = MQuery (DL.singleton json)+  let filePath = opts ^. L.filePath+  case opts ^. L.method of+    "original" -> do+      !cursor <- loadCursor (opts ^. L.filePath)+      let !json = lightJsonAt cursor+      let q = MQuery (DL.singleton json) -  putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & count+      putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count+    "simd" -> do+      (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing+      let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+      case S.makeStandardJsonIbBps (LBS.resegmentPadded 512 (LBS.fromStrict bs)) of+        Right ibBps -> do+          let (!ib, !bp) = constructUnzipN size ibBps+          let !cursor = JsonCursor bs (makeCsPoppy ib) (SimpleBalancedParens bp) 1+          let !json = lightJsonAt cursor+          let q = MQuery (DL.singleton json) +          putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count+        Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create semi-index: " <> show msg+    m -> IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show m++ optsDemo :: Parser DemoOptions optsDemo = DemoOptions   <$> strOption@@ -35,6 +92,13 @@         <>  help "Input DSV file"         <>  metavar "STRING"         )+  <*> strOption+        (   long "method"+        <>  short 'm'+        <>  help "Method (original|simd)"+        <>  metavar "STRING"+        <>  OA.value "original"+        )  cmdDemo :: Mod CommandFields (IO ())-cmdDemo = command "create-index"  $ flip info idm $ runDemo <$> optsDemo+cmdDemo = command "demo"  $ flip info idm $ runDemo <$> optsDemo

@@ -3,10 +3,15 @@   , DemoOptions(..)   ) where -newtype CreateIndexOptions = CreateIndexOptions-  { _createIndexOptionsFilePath  :: FilePath+data CreateIndexOptions = CreateIndexOptions+  { _createIndexOptionsFilePath     :: FilePath+  , _createIndexOptionsBackend      :: String+  , _createIndexOptionsMethod       :: String+  , _createIndexOptionsOutputIbFile :: Maybe FilePath+  , _createIndexOptionsOutputBpFile :: Maybe FilePath   } deriving (Eq, Show) -newtype DemoOptions = DemoOptions-  { _demoOptionsFilePath  :: FilePath+data DemoOptions = DemoOptions+  { _demoOptionsFilePath :: FilePath+  , _demoOptionsMethod   :: FilePath   } deriving (Eq, Show)

@@ -1,12 +0,0 @@-module App.IO where--import qualified Data.ByteString.Lazy as LBS-import qualified System.IO            as IO--readInputFile :: FilePath -> IO LBS.ByteString-readInputFile "-"      = LBS.hGetContents IO.stdin-readInputFile filePath = LBS.readFile filePath--writeOutputFile :: FilePath -> LBS.ByteString -> IO ()-writeOutputFile "-"      bs = LBS.hPut IO.stdout bs-writeOutputFile filePath bs = LBS.writeFile filePath bs

@@ -8,17 +8,15 @@ import Data.List import Data.Word import Foreign-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.Blank-import HaskellWorks.Data.Json.Internal.MakeIndex+import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank+import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex import System.IO.MMap -import qualified Data.ByteString          as BS-import qualified Data.ByteString.Internal as BSI-import qualified Data.Vector.Storable     as DVS-import qualified System.Directory         as IO+import qualified Data.ByteString                              as BS+import qualified Data.ByteString.Internal                     as BSI+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW+import qualified System.Directory                             as IO  setupEnvJson :: FilePath -> IO BS.ByteString setupEnvJson filepath = do@@ -26,9 +24,6 @@   let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size   return bs -loadJson :: BS.ByteString -> JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))-loadJson bs = fromByteString bs :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))- jsonToInterestBits3 :: [BS.ByteString] -> [BS.ByteString] jsonToInterestBits3 = blankedJsonToInterestBits . blankJson @@ -56,13 +51,14 @@    return (join benchmarks) -makeBenchLoadJson :: IO [Benchmark]-makeBenchLoadJson = do+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 blankJson" (whnf loadJson bs)+      [ bench "Run slow make cursor" (whnf SLOW.makeCursor bs)+      , bench "Run fast make cursor" (whnf FAST.makeCursor bs)       ]     ] @@ -73,6 +69,6 @@   benchmarks <- mconcat <$> sequence     [ makeBenchBlankJson     , makeBenchJsonToInterestBits-    , makeBenchLoadJson+    , makeBenchMakeCursor     ]   defaultMain benchmarks

@@ -1,9 +1,7 @@--- This file has been generated from package.yaml by hpack version 0.18.1.------ see: https://github.com/sol/hpack+cabal-version:  2.2  name:           hw-json-version:        0.9.0.1+version:        1.0.0.0 synopsis:       Memory efficient JSON parser description:    Memory efficient JSON parser. Please see README.md category:       Data@@ -11,13 +9,12 @@ bug-reports:    https://github.com/haskell-works/hw-json/issues author:         John Ky maintainer:     newhoggy@gmail.com-copyright:      2016 John Ky-license:        BSD3+copyright:      2016 - 2019 John Ky+license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10- extra-source-files:+    README.md     corpus/5000B.bp     corpus/5000B.ib     corpus/5000B.json@@ -25,7 +22,6 @@     corpus/issue-0001.ib     corpus/issue-0001.json     corpus/issue-0001.md-    README.md  source-repository head   type: git@@ -41,160 +37,188 @@   manual: False   default: False -library-  hs-source-dirs:-      src-  ghc-options: -Wall -O2 -msse4.2-  build-depends:-      base                >= 4          && < 5-    , bytestring          >= 0.10.6     && < 0.11-    , hw-balancedparens   >= 0.2.0.1    && < 0.3-    , hw-bits             >= 0.7.0.2    && < 0.8-    , hw-prim             >= 0.6.2.0    && < 0.7-    , hw-rankselect       >= 0.10       && < 0.13-    , hw-rankselect-base  >= 0.3        && < 0.4-    , mmap                >= 0.5        && < 0.6-    , vector              >= 0.12       && < 0.13-    , array             >= 0.5        && < 0.6-    , ansi-wl-pprint    >= 0.6.8.2    && < 0.7-    , attoparsec        >= 0.13       && < 0.14-    , containers        >= 0.5        && < 0.7-    , dlist             >= 0.8        && < 0.9-    , hw-mquery         >= 0.1        && < 0.2-    , hw-parser         >= 0.1        && < 0.2-    , text              >= 1.2        && < 1.3-    , word8             >= 0.1        && < 0.2-  if (flag(sse42))+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      && < 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 hedgehog             { build-depends: hedgehog             >= 0.5        && < 0.7    }+common hspec                { build-depends: hspec                >= 2.4        && < 3      }+common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.2.0.1    && < 0.3    }+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.1    && < 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.21   && < 0.7    }+common hw-rankselect        { build-depends: hw-rankselect        >= 0.12.0.4   && < 0.13   }+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+  if flag(sse42)     ghc-options: -mbmi2-  if (flag(bmi2)) && (impl(ghc >=8.4.1))+  if flag(bmi2) && impl(ghc >= 8.4.1)     ghc-options: -mbmi2 -msse4.2     cpp-options: -DBMI2_ENABLED++library+  import:   base, config+          , ansi-wl-pprint+          , array+          , attoparsec+          , bits-extra+          , bytestring+          , dlist+          , hw-balancedparens+          , hw-bits+          , hw-mquery+          , hw-parser+          , hw-prim+          , hw-rankselect+          , hw-rankselect-base+          , hw-simd+          , mmap+          , semigroups+          , text+          , vector+          , word8+  hs-source-dirs: src+  ghc-options: -O2 -msse4.2+   exposed-modules:       HaskellWorks.Data.Json-      HaskellWorks.Data.Json.Cursor+      HaskellWorks.Data.Json.Backend.Simple.Cursor+      HaskellWorks.Data.Json.Backend.Simple.Fast+      HaskellWorks.Data.Json.Backend.Simple.SemiIndex+      HaskellWorks.Data.Json.Backend.Simple.Value+      HaskellWorks.Data.Json.Backend.Standard.Cursor+      HaskellWorks.Data.Json.Backend.Standard.Fast+      HaskellWorks.Data.Json.Backend.Standard.Index+      HaskellWorks.Data.Json.Backend.Standard.Load.Cursor+      HaskellWorks.Data.Json.Backend.Standard.Load.Partial+      HaskellWorks.Data.Json.Backend.Standard.Load.Raw+      HaskellWorks.Data.Json.Backend.Standard.SemiIndex+      HaskellWorks.Data.Json.Backend.Standard.Slow       HaskellWorks.Data.Json.DecodeError       HaskellWorks.Data.Json.FromValue-      HaskellWorks.Data.Json.Internal.Blank-      HaskellWorks.Data.Json.Internal.BlankedJson+      HaskellWorks.Data.Json.Internal.Backend.Standard.Blank+      HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson+      HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token+      HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp+      HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex+      HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine+      HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64+      HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64+      HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize+      HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp+      HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp       HaskellWorks.Data.Json.Internal.CharLike-      HaskellWorks.Data.Json.Internal.Cursor.Token-      HaskellWorks.Data.Json.Internal.IbBp+      HaskellWorks.Data.Json.Internal.Doc       HaskellWorks.Data.Json.Internal.Index-      HaskellWorks.Data.Json.Internal.MakeIndex       HaskellWorks.Data.Json.Internal.PartialIndex-      HaskellWorks.Data.Json.Internal.ToBalancedParens64-      HaskellWorks.Data.Json.Internal.ToInterestBits64+      HaskellWorks.Data.Json.Internal.Slurp       HaskellWorks.Data.Json.Internal.Token-      HaskellWorks.Data.Json.Internal.Token.Tokenize       HaskellWorks.Data.Json.Internal.Token.Types       HaskellWorks.Data.Json.Internal.Value-      HaskellWorks.Data.Json.Internal.Words+      HaskellWorks.Data.Json.Internal.Word64+      HaskellWorks.Data.Json.Internal.Word8       HaskellWorks.Data.Json.LightJson-      HaskellWorks.Data.Json.Load-      HaskellWorks.Data.Json.LoadCursor       HaskellWorks.Data.Json.PartialValue+      HaskellWorks.Data.Json.Query       HaskellWorks.Data.Json.Type       HaskellWorks.Data.Json.Value   other-modules:       Paths_hw_json-  default-language: Haskell2010+  autogen-modules:+      Paths_hw_json  executable hw-json+  import:   base, config+          , bytestring+          , dlist+          , hw-balancedparens+          , hw-json-simd+          , hw-mquery+          , hw-prim+          , hw-rankselect+          , hw-rankselect-base+          , lens+          , mmap+          , optparse-applicative+          , semigroups+          , vector   main-is: Main.hs-  hs-source-dirs:-      app-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2-  build-depends:-      base                >= 4          && < 5-    , bytestring          >= 0.10.6     && < 0.11-    , hw-balancedparens   >= 0.2.0.1    && < 0.3-    , hw-bits             >= 0.7.0.2    && < 0.8-    , hw-prim             >= 0.6.2.0    && < 0.7-    , hw-rankselect       >= 0.10       && < 0.13-    , hw-rankselect-base  >= 0.3        && < 0.4-    , mmap                >= 0.5        && < 0.6-    , vector              >= 0.12       && < 0.13-    , criterion             >= 1.4        && < 1.6-    , dlist                 >= 0.8        && < 0.9-    , hw-json-    , hw-mquery             >= 0.1        && < 0.2-    , lens                  >= 4          && < 5-    , optparse-applicative  >= 0.14       && < 0.15-  if (flag(sse42))-    ghc-options: -mbmi2-  if (flag(bmi2)) && (impl(ghc >=8.4.1))-    ghc-options: -mbmi2 -msse4.2-    cpp-options: -DBMI2_ENABLED-  if (impl(ghc < 8))-    build-depends:-        semigroups          >= 0.16       && < 0.19   other-modules:       App.Commands       App.Commands.CreateIndex       App.Commands.Demo       App.Commands.Types-      App.IO       App.Lens-  default-language: Haskell2010+  hs-source-dirs: app+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2+  build-depends:  hw-json  test-suite hw-json-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-  hs-source-dirs:-      test-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      base                >= 4          && < 5-    , bytestring          >= 0.10.6     && < 0.11-    , hw-balancedparens   >= 0.2.0.1    && < 0.3-    , hw-bits             >= 0.7.0.2    && < 0.8-    , hw-prim             >= 0.6.2.0    && < 0.7-    , hw-rankselect       >= 0.10       && < 0.13-    , hw-rankselect-base  >= 0.3        && < 0.4-    , mmap                >= 0.5        && < 0.6-    , vector              >= 0.12       && < 0.13-    , attoparsec        >= 0.13       && < 0.14-    , containers        >= 0.5        && < 0.7-    , hspec             >= 2.5        && < 2.6-    , hw-json-  if (flag(sse42))-    ghc-options: -mbmi2-  if (flag(bmi2)) && (impl(ghc >=8.4.1))-    ghc-options: -mbmi2 -msse4.2-    cpp-options: -DBMI2_ENABLED+  build-depends: hw-json+  hs-source-dirs: test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N   other-modules:+      HaskellWorks.Data.Json.Backend.Simple.CursorSpec+      HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec+      HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.InterestBitsSpec+      HaskellWorks.Data.Json.Backend.Standard.Succinct.CursorSpec+      HaskellWorks.Data.Json.Backend.Standard.Succinct.GenCursorTest       HaskellWorks.Data.Json.CorpusSpec       HaskellWorks.Data.Json.Internal.BlankSpec       HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec-      HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec-      HaskellWorks.Data.Json.Succinct.CursorSpec       HaskellWorks.Data.Json.Token.TokenizeSpec       HaskellWorks.Data.Json.TypeSpec       HaskellWorks.Data.Json.ValueSpec-  default-language: Haskell2010+      Paths_hw_json+  build-tools: hspec-discover  benchmark bench+  import:   base, config+          , bytestring+          , criterion+          , directory+          , mmap+          , semigroups   type: exitcode-stdio-1.0   main-is: Main.hs-  hs-source-dirs:-      bench-  ghc-options: -Wall -O2 -msse4.2-  build-depends:-      base                >= 4          && < 5-    , bytestring          >= 0.10.6     && < 0.11-    , hw-balancedparens   >= 0.2.0.1    && < 0.3-    , hw-bits             >= 0.7.0.2    && < 0.8-    , hw-prim             >= 0.6.2.0    && < 0.7-    , hw-rankselect       >= 0.10       && < 0.13-    , hw-rankselect-base  >= 0.3        && < 0.4-    , mmap                >= 0.5        && < 0.6-    , vector              >= 0.12       && < 0.13-    , criterion         >= 1.4        && < 1.6-    , directory         >= 1.3        && < 1.4-    , hw-json-  if (flag(sse42))-    ghc-options: -mbmi2-  if (flag(bmi2)) && (impl(ghc >=8.4.1))-    ghc-options: -mbmi2 -msse4.2-    cpp-options: -DBMI2_ENABLED-  default-language: Haskell2010+  hs-source-dirs: bench+  ghc-options: -O2 -msse4.2+  build-depends: hw-json+  other-modules: Paths_hw_json

@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}++module HaskellWorks.Data.Json.Backend.Simple.Cursor+  ( JsonCursor(..)+  , jsonCursorPos+  ) where++import Data.String+import Data.Word+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.FromForeignRegion+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.RankSelect.Poppy512+import HaskellWorks.Data.TreeCursor+import Prelude                                   hiding (drop)++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 Foreign.ForeignPtr                              as F+import qualified HaskellWorks.Data.BalancedParens                as BP+import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as SI++data JsonCursor t v w = JsonCursor+  { cursorText     :: !t+  , interests      :: !v+  , balancedParens :: !w+  , cursorRank     :: !Count+  }+  deriving (Eq, Show)++instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromByteString bs = JsonCursor+    { cursorText      = bs+    , interests       = ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs++instance FromByteString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromByteString bs = JsonCursor+    { cursorText      = bs+    , interests       = makePoppy512 ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs++instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size)++instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromString = fromByteString . BSC.pack++instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where+  firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k)++  parent :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  depth :: JsonCursor t v u -> Maybe Count+  depth k = BP.depth (balancedParens k) (cursorRank k)++  subtreeSize :: JsonCursor t v u -> Maybe Count+  subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+  where ik  = interests k+        bpk = balancedParens k

@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HaskellWorks.Data.Json.Backend.Simple.Fast+  ( makeCursor+  ) where++import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Backend.Simple.Cursor+import HaskellWorks.Data.RankSelect.Poppy512++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.Json.Internal.Backend.Simple.IbBp   as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp as J++class MakeCursor a where+  makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))++instance MakeCursor BS.ByteString where+  makeCursor bs = JsonCursor+    { cursorText      = bs+    , interests       = makePoppy512 ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where J.IbBp ib bp = J.toIbBp bs++instance MakeCursor String where+  makeCursor = makeCursor . BSC.pack++instance MakeCursor ForeignRegion where+  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)

@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE InstanceSigs      #-}+{-# LANGUAGE MultiWayIf        #-}++module HaskellWorks.Data.Json.Backend.Simple.SemiIndex+  ( buildSemiIndex+  , SemiIndex(..)+  ) where++import Control.Monad.ST+import Data.Word++import qualified Data.ByteString                        as BS+import qualified Data.ByteString.Unsafe                 as BSU+import qualified Data.Vector.Storable                   as DVS+import qualified HaskellWorks.Data.Bits.Writer.Storable as W+import qualified HaskellWorks.Data.Json.Internal.Word8  as W8++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++data Context = InJson | InString | InEscape deriving (Eq, Show)++data SemiIndex v = SemiIndex+  { semiIndexContext :: !Context+  , semiIndexIb      :: !v+  , semiIndexBp      :: !v+  } deriving (Functor, Traversable, Foldable)++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 -> Context -> ST s (SemiIndex (DVS.MVector s Word64))+buildFromByteString ib bp bs i context = if i < BS.length bs+  then do+    let c = BSU.unsafeIndex bs i+    case context of+      InJson -> if+        | c == W8.openBracket || c == W8.openBrace -> do+          W.unsafeWriteBit bp 1+          W.unsafeWriteBit bp 1+          W.unsafeWriteBit ib 1+          buildFromByteString ib bp bs (i + 1) InJson+        | c == W8.closeBracket || c == W8.closeBrace -> do+          W.unsafeWriteBit bp 0+          W.unsafeWriteBit bp 0+          W.unsafeWriteBit ib 1+          buildFromByteString ib bp bs (i + 1) InJson+        | c == W8.comma || c == W8.colon -> do+          W.unsafeWriteBit bp 0+          W.unsafeWriteBit bp 1+          W.unsafeWriteBit ib 1+          buildFromByteString ib bp bs (i + 1) InJson+        | c == W8.doubleQuote -> do+          W.unsafeWriteBit ib 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+  else do+    ibv <- W.written ib+    bpv <- W.written bp+    return (SemiIndex context ibv bpv)+{-# INLINE buildFromByteString #-}

@@ -0,0 +1,43 @@+module HaskellWorks.Data.Json.Backend.Simple.Value where++import Data.Maybe+import Data.Word+import HaskellWorks.Data.Json.Backend.Simple.Cursor+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.Poppy512++import qualified Data.ByteString                  as BS+import qualified Data.Vector.Storable             as DVS+import qualified HaskellWorks.Data.BalancedParens as BP++data JsonValue+  = JsonValues JsonValues+  | JsonNull+  | JsonNumber Double+  | JsonString String+  | JsonBoolean Bool+  deriving (Eq, Show)++data JsonValues+  = JsonArray  [JsonValue]+  | JsonObject [(String, JsonValue)]+  deriving (Eq, Show)++snippetPos :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> (Count, Count)+snippetPos k = (kpa, kpz)+  where kpa   = select1 kib kta + km+        kpz   = select1 kib ktz - km+        kib   = interests k+        kbp   = balancedParens k+        kra   = cursorRank k+        krz   = fromMaybe maxBound (BP.findClose kbp kra)+        ksa   = kra + 1+        ksz   = krz + 1+        kta   = ksa `div` 2+        ktz   = ksz `div` 2+        km    = ksa `mod` 2++snippet :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> BS.ByteString+snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt)+  where kt    = cursorText k

@@ -0,0 +1,175 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}++module HaskellWorks.Data.Json.Backend.Standard.Cursor+  ( JsonCursor(..)+  , jsonCursorPos+  ) where++import Control.Arrow+import Control.Monad+import Data.Char+import Data.String+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.DecodeError+import HaskellWorks.Data.Json.Internal.CharLike+import HaskellWorks.Data.Json.Internal.Index+import HaskellWorks.Data.Json.Internal.PartialIndex+import HaskellWorks.Data.Json.Internal.Slurp+import HaskellWorks.Data.Json.Internal.Word8+import HaskellWorks.Data.Json.LightJson+import HaskellWorks.Data.Json.PartialValue+import HaskellWorks.Data.Json.Type+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 HaskellWorks.Data.Uncons+import Prelude                                      hiding (drop)++import qualified Data.ByteString                  as BS+import qualified Data.List                        as L+import qualified HaskellWorks.Data.BalancedParens as BP++data JsonCursor t v w = JsonCursor+  { cursorText     :: !t+  , interests      :: !v+  , balancedParens :: !w+  , cursorRank     :: !Count+  }+  deriving (Eq, Show)++instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where+  firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k)++  parent :: JsonCursor t v u -> Maybe (JsonCursor t v u)+  parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  depth :: JsonCursor t v u -> Maybe Count+  depth k = BP.depth (balancedParens k) (cursorRank k)++  subtreeSize :: JsonCursor t v u -> Maybe Count+  subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+  where ik  = interests k+        bpk = balancedParens k++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JsonCursor BS.ByteString v w) where+  lightJsonAt k = case uncons remainder of+    Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber  (slurpNumber remainder)+    Just (!c, _) | isQuotDbl c       -> LightJsonString  (slurpString remainder)+    Just (!c, _) | isChar_t c        -> LightJsonBool    True+    Just (!c, _) | isChar_f c        -> LightJsonBool    False+    Just (!c, _) | isChar_n c        -> LightJsonNull+    Just (!c, _) | isBraceLeft c     -> LightJsonObject (mapValuesFrom   (firstChild k))+    Just (!c, _) | isBracketLeft c   -> LightJsonArray  (arrayValuesFrom (firstChild k))+    Just _                           -> LightJsonError "Invalid Json Type"+    Nothing                          -> LightJsonError "End of data"+    where ik                = interests k+          bpk               = balancedParens k+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          remainder         = drop (toCount p) (cursorText k)+          arrayValuesFrom   = L.unfoldr (fmap (id &&& nextSibling))+          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField+          pairwise (a:b:rs) = (a, b) : pairwise rs+          pairwise _        = []+          asField (a, b)    = case lightJsonAt a of+                                LightJsonString s -> [(s, b)]+                                _                 -> []++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (JsonCursor 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 (JsonCursor 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++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where+  jsonPartialIndexAt k = case uncons remainder of+    Just (!c, _) | isLeadingDigit2 c -> JsonPartialIndexNumber  remainder+    Just (!c, _) | isQuotDbl c       -> JsonPartialIndexString  remainder+    Just (!c, _) | isChar_t c        -> JsonPartialIndexBool    True+    Just (!c, _) | isChar_f c        -> JsonPartialIndexBool    False+    Just (!c, _) | isChar_n c        -> JsonPartialIndexNull+    Just (!c, _) | isBraceLeft c     -> JsonPartialIndexObject (mapValuesFrom   (firstChild k))+    Just (!c, _) | isBracketLeft c   -> JsonPartialIndexArray  (arrayValuesFrom (firstChild k))+    Just _                           -> JsonPartialIndexError "Invalid Json Type"+    Nothing                          -> JsonPartialIndexError "End of data"+    where ik                = interests k+          bpk               = balancedParens k+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          remainder         = drop (toCount p) (cursorText k)+          arrayValuesFrom :: Maybe (JsonCursor BS.ByteString v w) -> [JsonPartialIndex]+          arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling))+          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField+          pairwise (a:b:rs) = (a, b) : pairwise rs+          pairwise _        = []+          asField (a, b)    = case a of+                                JsonPartialIndexString s -> [(s, b)]+                                _                        -> []++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where+  jsonIndexAt k = case uncons remainder of+    Just (!c, _) | isLeadingDigit2 c -> Right (JsonIndexNumber  remainder)+    Just (!c, _) | isQuotDbl c       -> Right (JsonIndexString  remainder)+    Just (!c, _) | isChar_t c        -> Right (JsonIndexBool    True)+    Just (!c, _) | isChar_f c        -> Right (JsonIndexBool    False)+    Just (!c, _) | isChar_n c        -> Right  JsonIndexNull+    Just (!c, _) | isBraceLeft c     -> JsonIndexObject <$> mapValuesFrom   (firstChild k)+    Just (!c, _) | isBracketLeft c   -> JsonIndexArray  <$> arrayValuesFrom (firstChild k)+    Just _                           -> Left (DecodeError "Invalid Json Type")+    Nothing                          -> Left (DecodeError "End of data"      )+    where ik                = interests k+          bpk               = balancedParens k+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          remainder         = drop (toCount p) (cursorText k)+          arrayValuesFrom j = sequence (L.unfoldr (fmap (jsonIndexAt &&& nextSibling)) j)+          mapValuesFrom j   = (pairwise >=> asField) <$> arrayValuesFrom j+          pairwise (a:b:rs) = (a, b) : pairwise rs+          pairwise _        = []+          asField (a, b)    = case a of+                                JsonIndexString s -> [(s, b)]+                                _                 -> []++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (JsonCursor BS.ByteString v w) where+  jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt++

@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HaskellWorks.Data.Json.Backend.Standard.Fast+  ( makeCursor+  ) where++import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.RankSelect.Poppy512++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.Json.Internal.Backend.Standard.IbBp as J++class MakeCursor a where+  makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))++instance MakeCursor BS.ByteString where+  makeCursor bs = JsonCursor+    { cursorText      = bs+    , interests       = makePoppy512 ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where J.IbBp ib bp = J.toIbBp bs++instance MakeCursor String where+  makeCursor = makeCursor . BSC.pack++instance MakeCursor ForeignRegion where+  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)+

@@ -0,0 +1,20 @@+module HaskellWorks.Data.Json.Backend.Standard.Index+  ( indexJson+  ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Backend.Standard.Cursor++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.Backend.Standard.Load.Cursor as L++indexJson :: String -> IO ()+indexJson filename = do+  JsonCursor _ ib (SimpleBalancedParens bp) _ <- L.loadCursor filename+  let wib = DVS.unsafeCast ib :: DVS.Vector Word8+  let wbp = DVS.unsafeCast bp :: DVS.Vector Word8+  BS.writeFile (filename ++ ".ib") (BS.toByteString wib)+  BS.writeFile (filename ++ ".bp") (BS.toByteString wbp)

@@ -0,0 +1,53 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Backend.Standard.Load.Cursor+  ( loadCursor+  , loadCursorWithIndex+  , loadCursorWithPoppy512Index+  , loadCursorWithCsPoppyIndex+  , loadCursorWithPoppy512Index2+  ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Load.Raw+import HaskellWorks.Data.RankSelect.CsPoppy+import HaskellWorks.Data.RankSelect.Poppy512++import qualified Data.ByteString                              as BS+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.Backend.Standard.Slow as SLOW++loadCursor :: String -> IO (JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+loadCursor path = do+  bs <- BS.mmap path+  let !cursor = SLOW.makeCursor bs+  return cursor++loadCursorWithIndex :: String -> IO (JsonCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1+  return cursor++loadCursorWithPoppy512Index :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithPoppy512Index filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1+  return cursor++loadCursorWithCsPoppyIndex :: String -> IO (JsonCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithCsPoppyIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1+  return cursor++loadCursorWithPoppy512Index2 :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512))+loadCursorWithPoppy512Index2 filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1+                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)+  return cursor

@@ -0,0 +1,54 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Json.Backend.Standard.Load.Partial+  ( loadPartial+  , loadPartialWithCsPoppyIndex+  , loadPartialWithIndex+  , loadPartialWithPoppy512Index+  , loadPartialWithPoppy512Index2+  ) where++import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Load.Raw+import HaskellWorks.Data.Json.Internal.PartialIndex+import HaskellWorks.Data.Json.PartialValue+import HaskellWorks.Data.RankSelect.CsPoppy+import HaskellWorks.Data.RankSelect.Poppy512++import qualified Data.ByteString.Internal as BSI++loadPartialWithIndex :: String -> IO JsonPartialValue+loadPartialWithIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1+  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)+  return jsonResult++loadPartialWithPoppy512Index :: String -> IO JsonPartialValue+loadPartialWithPoppy512Index filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1+  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)+  return jsonResult++loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue+loadPartialWithCsPoppyIndex filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1+  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)+  return jsonResult++loadPartialWithPoppy512Index2 :: String -> IO JsonPartialValue+loadPartialWithPoppy512Index2 filename = do+  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename+  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1+                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)+  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)+  return jsonResult++loadPartial :: String -> IO JsonPartialValue+loadPartial = loadPartialWithCsPoppyIndex

@@ -0,0 +1,20 @@+module HaskellWorks.Data.Json.Backend.Standard.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") ReadOnly Nothing+  jsonBpFr  <- mmapFileForeignPtr (filename ++ ".bp") 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)

@@ -0,0 +1,269 @@+{-# LANGUAGE BinaryLiterals      #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveTraversable   #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Json.Backend.Standard.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.Internal.Backend.Standard.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.Internal.Backend.Standard.Blank              as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex          as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine       as SM+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.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

@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HaskellWorks.Data.Json.Backend.Standard.Slow+  ( makeCursor+  ) where++import Data.Word+import Foreign.ForeignPtr+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Backend.Standard.Cursor++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.Json.Internal.Backend.Standard.IbBp as J++class MakeCursor a where+  makeCursor :: a -> JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))++instance MakeCursor BS.ByteString where+  makeCursor bs = JsonCursor+    { cursorText      = bs+    , interests       = ib+    , balancedParens  = BP.SimpleBalancedParens bp+    , cursorRank      = 1+    }+    where J.IbBp ib bp = J.toIbBp bs++instance MakeCursor String where+  makeCursor = makeCursor . BSC.pack++instance MakeCursor ForeignRegion where+  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)

@@ -1,88 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}--module HaskellWorks.Data.Json.Cursor-  ( JsonCursor(..)-  , jsonCursorPos-  ) where--import Data.ByteString.Internal                  as BSI-import Data.String-import Data.Word-import Foreign.ForeignPtr-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.FromForeignRegion-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.RankSelect.Poppy512-import HaskellWorks.Data.TreeCursor--import qualified Data.ByteString                      as BS-import qualified Data.ByteString.Char8                as BSC-import qualified Data.Vector.Storable                 as DVS-import qualified HaskellWorks.Data.BalancedParens     as BP-import qualified HaskellWorks.Data.Json.Internal.IbBp as J--data JsonCursor t v w = JsonCursor-  { cursorText     :: !t-  , interests      :: !v-  , balancedParens :: !w-  , cursorRank     :: !Count-  }-  deriving (Eq, Show)--instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromByteString bs = JsonCursor-    { cursorText      = bs-    , interests       = ib-    , balancedParens  = BP.SimpleBalancedParens bp-    , cursorRank      = 1-    }-    where J.IbBp ib bp = J.toIbBp bs--instance FromByteString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromByteString bs = JsonCursor-    { cursorText      = bs-    , interests       = makePoppy512 ib-    , balancedParens  = BP.SimpleBalancedParens bp-    , cursorRank      = 1-    }-    where J.IbBp ib bp = J.toIbBp bs--instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromString = fromByteString . BSC.pack--instance IsString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromString = fromByteString . BSC.pack--instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)--instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where-  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)--instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where-  firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u)-  firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq--  nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u)-  nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k)--  parent :: JsonCursor t v u -> Maybe (JsonCursor t v u)-  parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq--  depth :: JsonCursor t v u -> Maybe Count-  depth k = BP.depth (balancedParens k) (cursorRank k)--  subtreeSize :: JsonCursor t v u -> Maybe Count-  subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)--jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position-jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)-  where ik  = interests k-        bpk = balancedParens k

@@ -0,0 +1,10 @@+module HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp where++import Data.Word++import qualified Data.Vector.Storable as DVS++data IbBp = IbBp+  { ib :: DVS.Vector Word64+  , bp :: DVS.Vector Word64+  }

@@ -0,0 +1,12 @@+module HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp where++import qualified Data.ByteString                                     as BS+import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex     as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp as Z++class ToIbBp a where+  toIbBp :: a -> Z.IbBp++instance ToIbBp BS.ByteString where+  toIbBp bs = Z.IbBp ib bp+    where J.SemiIndex _ ib bp = J.buildSemiIndex bs

@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.Blank+  ( blankJson+  ) where++import Data.ByteString                       as BS+import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Internal.Word8+import Prelude                               as P++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, _)) = 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

@@ -0,0 +1,24 @@++module HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson+  ( BlankedJson(..)+  , ToBlankedJson(..)+  , toBlankedJsonTyped+  ) where++import HaskellWorks.Data.ByteString+import HaskellWorks.Data.Json.Internal.Backend.Standard.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

@@ -0,0 +1,24 @@++module HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token+  ( jsonTokenAt+  ) where++import Data.ByteString.Internal                                        as BSI+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude                                                         hiding (drop)++import qualified Data.Attoparsec.ByteString.Char8 as ABC++jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe (JsonToken String Double)+jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k)+  then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of+    ABC.Fail    {}  -> error "Failed to parse token in cursor"+    ABC.Partial _   -> error "Failed to parse token in cursor"+    ABC.Done    _ r -> Just r+  else Nothing

@@ -0,0 +1,24 @@+module HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp where++import Data.Word++import qualified Data.ByteString                                                     as BS+import qualified Data.Vector.Storable                                                as DVS+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson        as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.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

@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.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

@@ -0,0 +1,109 @@+{-# LANGUAGE BinaryLiterals             #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.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.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 #-}

@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64+  ( ToBalancedParens64(..)+  ) where++import Control.Applicative+import Data.Word+import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex++import qualified Data.ByteString.Lazy                                         as LBS+import qualified Data.Vector.Storable                                         as DVS+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.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)

@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64+  ( ToInterestBits64(..)+  ) where++import Control.Applicative+import Data.ByteString.Internal+import Data.Word+import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex++import qualified Data.ByteString                                              as BS+import qualified Data.Vector.Storable                                         as DVS+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.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)

@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeSynonymInstances  #-}++module HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize+    ( IsChar(..)+    , JsonToken(..)+    , ParseJson(..)+    ) where++import Control.Applicative+import Data.Bits+import Data.Char+import Data.Word+import Data.Word8+import HaskellWorks.Data.Char.IsChar+import HaskellWorks.Data.Json.Internal.Token.Types+import HaskellWorks.Data.Parser                    ((<?>))++import qualified Data.Attoparsec.ByteString.Char8 as BC+import qualified Data.Attoparsec.Combinator       as AC+import qualified Data.Attoparsec.Types            as T+import qualified Data.ByteString                  as BS+import qualified HaskellWorks.Data.Parser         as P++hexDigitNumeric :: P.Parser t u => T.Parser t Int+hexDigitNumeric = do+  c <- P.satisfyChar (\c -> '0' <= c && c <= '9')+  return $ ord c - ord '0'++hexDigitAlphaLower :: P.Parser t u => T.Parser t Int+hexDigitAlphaLower = do+  c <- P.satisfyChar (\c -> 'a' <= c && c <= 'z')+  return $ ord c - ord 'a' + 10++hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int+hexDigitAlphaUpper = do+  c <- P.satisfyChar (\c -> 'A' <= c && c <= 'Z')+  return $ ord c - ord 'A' + 10++hexDigit :: P.Parser t u => T.Parser t Int+hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper++class ParseJson t s d where+  parseJsonTokenString :: T.Parser t (JsonToken s d)+  parseJsonToken :: T.Parser t (JsonToken s d)+  parseJsonTokenBraceL :: T.Parser t (JsonToken s d)+  parseJsonTokenBraceR :: T.Parser t (JsonToken s d)+  parseJsonTokenBracketL :: T.Parser t (JsonToken s d)+  parseJsonTokenBracketR :: T.Parser t (JsonToken s d)+  parseJsonTokenComma :: T.Parser t (JsonToken s d)+  parseJsonTokenColon :: T.Parser t (JsonToken s d)+  parseJsonTokenWhitespace :: T.Parser t (JsonToken s d)+  parseJsonTokenNull :: T.Parser t (JsonToken s d)+  parseJsonTokenBoolean :: T.Parser t (JsonToken s d)+  parseJsonTokenDouble :: T.Parser t (JsonToken s d)++  parseJsonToken =+    parseJsonTokenString     <|>+    parseJsonTokenBraceL     <|>+    parseJsonTokenBraceR     <|>+    parseJsonTokenBracketL   <|>+    parseJsonTokenBracketR   <|>+    parseJsonTokenComma      <|>+    parseJsonTokenColon      <|>+    parseJsonTokenWhitespace <|>+    parseJsonTokenNull       <|>+    parseJsonTokenBoolean    <|>+    parseJsonTokenDouble++instance ParseJson BS.ByteString String Double where+  parseJsonTokenBraceL    = P.string "{" >> return JsonTokenBraceL+  parseJsonTokenBraceR    = P.string "}" >> return JsonTokenBraceR+  parseJsonTokenBracketL  = P.string "[" >> return JsonTokenBracketL+  parseJsonTokenBracketR  = P.string "]" >> return JsonTokenBracketR+  parseJsonTokenComma     = P.string "," >> return JsonTokenComma+  parseJsonTokenColon     = P.string ":" >> return JsonTokenColon+  parseJsonTokenNull      = P.string "null" >> return JsonTokenNull+  parseJsonTokenDouble    = JsonTokenNumber <$> P.rational++  parseJsonTokenString = do+    _ <- P.string "\""+    value <- many (verbatimChar <|> escapedChar <|> escapedCode)+    _ <- P.string "\""+    return $ JsonTokenString value+    where+      verbatimChar  = P.satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"+      escapedChar   = do+        _ <- P.string "\\"+        (   P.char '"'  >> return '"'  ) <|>+          ( P.char 'b'  >> return '\b' ) <|>+          ( P.char 'n'  >> return '\n' ) <|>+          ( P.char 'f'  >> return '\f' ) <|>+          ( P.char 'r'  >> return '\r' ) <|>+          ( P.char 't'  >> return '\t' ) <|>+          ( P.char '\\' >> return '\\' ) <|>+          ( P.char '\'' >> return '\'' ) <|>+          ( P.char '/'  >> return '/'  )+      escapedCode   = do+        _ <- P.string "\\u"+        a <- hexDigit+        b <- hexDigit+        c <- hexDigit+        d <- hexDigit+        return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d++  parseJsonTokenWhitespace = do+    _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"]+    return JsonTokenWhitespace++  parseJsonTokenBoolean = true <|> false+    where true  = P.string "true"   >> return (JsonTokenBoolean True)+          false = P.string "false"  >> return (JsonTokenBoolean False)++instance ParseJson BS.ByteString BS.ByteString Double where+  parseJsonTokenBraceL    = P.string "{" >> return JsonTokenBraceL+  parseJsonTokenBraceR    = P.string "}" >> return JsonTokenBraceR+  parseJsonTokenBracketL  = P.string "[" >> return JsonTokenBracketL+  parseJsonTokenBracketR  = P.string "]" >> return JsonTokenBracketR+  parseJsonTokenComma     = P.string "," >> return JsonTokenComma+  parseJsonTokenColon     = P.string ":" >> return JsonTokenColon+  parseJsonTokenNull      = P.string "null" >> return JsonTokenNull+  parseJsonTokenDouble    = JsonTokenNumber <$> P.rational++  parseJsonTokenString = do+    _ <- P.string "\""+    value <- many (verbatimChar <|> escapedChar <|> escapedCode)+    _ <- P.string "\""+    return $ JsonTokenString $ BS.pack value+    where+      word :: Word8 -> T.Parser BS.ByteString Word8+      word w = P.satisfy (== w)+      verbatimChar :: T.Parser BS.ByteString Word8+      verbatimChar  = P.satisfy (\w -> w /= _quotedbl && w /= _backslash) -- <?> "invalid string character"+      escapedChar :: T.Parser BS.ByteString Word8+      escapedChar   = do+        _ <- P.string "\\"+        (   word _quotedbl    >> return _quotedbl       ) <|>+          ( word _b           >> return 0x08            ) <|>+          ( word _n           >> return _lf             ) <|>+          ( word _f           >> return _np             ) <|>+          ( word _r           >> return _cr             ) <|>+          ( word _t           >> return _tab            ) <|>+          ( word _backslash   >> return _backslash      ) <|>+          ( word _quotesingle >> return _quotesingle    ) <|>+          ( word _slash       >> return _slash          )+      escapedCode :: T.Parser BS.ByteString Word8+      escapedCode   = do+        _ <- P.string "\\u"+        a <- hexDigit+        b <- hexDigit+        c <- hexDigit+        d <- hexDigit+        return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d++  parseJsonTokenWhitespace = do+    _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"]+    return JsonTokenWhitespace++  parseJsonTokenBoolean = true <|> false+    where+      true  = P.string "true"   >> return (JsonTokenBoolean True)+      false = P.string "false"  >> return (JsonTokenBoolean False)

@@ -1,56 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module HaskellWorks.Data.Json.Internal.Blank-  ( blankJson-  ) where--import Data.ByteString                       as BS-import Data.Word-import Data.Word8-import HaskellWorks.Data.Json.Internal.Words-import Prelude                               as P--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, _)) = 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

@@ -1,24 +0,0 @@--module HaskellWorks.Data.Json.Internal.BlankedJson-  ( BlankedJson(..)-  , ToBlankedJson(..)-  , toBlankedJsonTyped-  ) where--import HaskellWorks.Data.ByteString-import HaskellWorks.Data.Json.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

@@ -2,7 +2,7 @@  import Data.Word import Data.Word8-import HaskellWorks.Data.Json.Internal.Words+import HaskellWorks.Data.Json.Internal.Word8  class JsonCharLike c where   isLeadingDigit2 :: c -> Bool

@@ -1,24 +0,0 @@--module HaskellWorks.Data.Json.Internal.Cursor.Token-  ( jsonTokenAt-  ) where--import Data.ByteString.Internal                       as BSI-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.Token.Tokenize-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import Prelude                                        hiding (drop)--import qualified Data.Attoparsec.ByteString.Char8 as ABC--jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe (JsonToken String Double)-jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k)-  then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of-    ABC.Fail    {}  -> error "Failed to parse token in cursor"-    ABC.Partial _   -> error "Failed to parse token in cursor"-    ABC.Done    _ r -> Just r-  else Nothing

@@ -0,0 +1,11 @@+module HaskellWorks.Data.Json.Internal.Doc+  ( hEncloseSep+  ) where++import Text.PrettyPrint.ANSI.Leijen++hEncloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc+hEncloseSep l r s ds = case ds of+  []  -> l <> r+  [d] -> l <> d <> r+  _   -> hcat (zipWith (<>) (l : repeat s) ds) <> r

@@ -1,24 +0,0 @@-module HaskellWorks.Data.Json.Internal.IbBp where--import Data.Word--import qualified Data.ByteString                                    as BS-import qualified Data.Vector.Storable                               as DVS-import qualified HaskellWorks.Data.Json.Internal.BlankedJson        as J-import qualified HaskellWorks.Data.Json.Internal.ToBalancedParens64 as J-import qualified HaskellWorks.Data.Json.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

@@ -1,29 +1,12 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}  module HaskellWorks.Data.Json.Internal.Index where -import Control.Arrow-import Control.Monad-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Cursor import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Internal.CharLike-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 HaskellWorks.Data.Uncons-import Prelude                                   hiding (drop)+import Prelude                            hiding (drop) -import qualified Data.ByteString                  as BS-import qualified Data.List                        as L-import qualified HaskellWorks.Data.BalancedParens as BP+import qualified Data.ByteString as BS  data JsonIndex   = JsonIndexString BS.ByteString@@ -36,26 +19,3 @@  class JsonIndexAt a where   jsonIndexAt :: a -> Either DecodeError JsonIndex--instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where-  jsonIndexAt k = case uncons remainder of-    Just (!c, _) | isLeadingDigit2 c  -> Right (JsonIndexNumber  remainder)-    Just (!c, _) | isQuotDbl c        -> Right (JsonIndexString  remainder)-    Just (!c, _) | isChar_t c         -> Right (JsonIndexBool    True)-    Just (!c, _) | isChar_f c         -> Right (JsonIndexBool    False)-    Just (!c, _) | isChar_n c         -> Right  JsonIndexNull-    Just (!c, _) | isBraceLeft c      -> JsonIndexObject <$> mapValuesFrom   (firstChild k)-    Just (!c, _) | isBracketLeft c    -> JsonIndexArray  <$> arrayValuesFrom (firstChild k)-    Just _       -> Left (DecodeError "Invalid Json Type")-    Nothing      -> Left (DecodeError "End of data"      )-    where ik                = interests k-          bpk               = balancedParens k-          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))-          remainder         = drop (toCount p) (cursorText k)-          arrayValuesFrom j = sequence (L.unfoldr (fmap (jsonIndexAt &&& nextSibling)) j)-          mapValuesFrom j   = (pairwise >=> asField) <$> arrayValuesFrom j-          pairwise (a:b:rs) = (a, b) : pairwise rs-          pairwise _        = []-          asField (a, b)    = case a of-                                JsonIndexString s -> [(s, b)]-                                _                 -> []

@@ -1,134 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}--module HaskellWorks.Data.Json.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

@@ -1,28 +1,6 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}- module HaskellWorks.Data.Json.Internal.PartialIndex where -import Control.Arrow-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.CharLike-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 HaskellWorks.Data.Uncons-import Prelude                                   hiding (drop)--import qualified Data.ByteString                  as BS-import qualified Data.List                        as L-import qualified HaskellWorks.Data.BalancedParens as BP+import qualified Data.ByteString as BS  data JsonPartialIndex   = JsonPartialIndexString BS.ByteString@@ -36,27 +14,3 @@  class JsonPartialIndexAt a where   jsonPartialIndexAt :: a -> JsonPartialIndex--instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where-  jsonPartialIndexAt k = case uncons remainder of-    Just (!c, _) | isLeadingDigit2 c  -> JsonPartialIndexNumber  remainder-    Just (!c, _) | isQuotDbl c        -> JsonPartialIndexString  remainder-    Just (!c, _) | isChar_t c         -> JsonPartialIndexBool    True-    Just (!c, _) | isChar_f c         -> JsonPartialIndexBool    False-    Just (!c, _) | isChar_n c         -> JsonPartialIndexNull-    Just (!c, _) | isBraceLeft c      -> JsonPartialIndexObject (mapValuesFrom   (firstChild k))-    Just (!c, _) | isBracketLeft c    -> JsonPartialIndexArray  (arrayValuesFrom (firstChild k))-    Just _       -> JsonPartialIndexError "Invalid Json Type"-    Nothing      -> JsonPartialIndexError "End of data"-    where ik                = interests k-          bpk               = balancedParens k-          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))-          remainder         = drop (toCount p) (cursorText k)-          arrayValuesFrom :: Maybe (JsonCursor BS.ByteString v w) -> [JsonPartialIndex]-          arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling))-          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField-          pairwise (a:b:rs) = (a, b) : pairwise rs-          pairwise _        = []-          asField (a, b)    = case a of-                                JsonPartialIndexString s -> [(s, b)]-                                _                        -> []

@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Internal.Slurp where++import Data.String+import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Internal.Word8+import Prelude                               hiding (drop)++import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.List             as L++data JsonState+  = Escaped+  | InJson+  | InString+  | InNumber+  | InIdent++slurpString :: BS.ByteString -> String+slurpString bs = L.unfoldr genString (InJson, BSC.unpack bs)+  where genString :: (JsonState, String) -> Maybe (Char, (JsonState, String))+        genString (InJson, ds) = case ds of+          (e:es) | e == '"' -> genString  (InString , es)+          (_:es)            -> genString  (InJson   , es)+          _                 -> Nothing+        genString (InString, ds) = case ds of+          (e:es) | e == '\\' -> genString  (Escaped  , es)+          (e:_ ) | e == '"'  -> Nothing+          (e:es)             -> Just (e,   (InString , es))+          _                  -> Nothing+        genString (Escaped, ds) = case ds of+          (_:es) -> Just ('.', (InString , es))+          _      -> Nothing+        genString (_, _) = Nothing++slurpNumber :: BS.ByteString -> BS.ByteString+slurpNumber bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genNumber (InJson, bs) in cs+    where genNumber :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString))+          genNumber (InJson, cs) = case BS.uncons cs of+            Just (!d, !ds) | isLeadingDigit d -> Just (d           , (InNumber , ds))+            Just (!d, !ds)                    -> Just (d           , (InJson   , ds))+            Nothing                           -> Nothing+          genNumber (InNumber, cs) = case BS.uncons cs of+            Just (!d, !ds) | isTrailingDigit d -> Just (d           , (InNumber , ds))+            Just (!d, !ds) | d == _quotedbl    -> Just (_parenleft  , (InString , ds))+            _                                  -> Nothing+          genNumber (_, _) = Nothing

@@ -1,28 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Internal.ToBalancedParens64-  ( ToBalancedParens64(..)-  ) where--import Control.Applicative-import Data.Word-import HaskellWorks.Data.Json.Internal.MakeIndex--import qualified Data.ByteString.Lazy                        as LBS-import qualified Data.Vector.Storable                        as DVS-import qualified HaskellWorks.Data.Json.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)

@@ -1,31 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Internal.ToInterestBits64-  ( ToInterestBits64(..)-  ) where--import Control.Applicative-import Data.ByteString.Internal-import Data.Word-import HaskellWorks.Data.Json.Internal.MakeIndex--import qualified Data.ByteString                             as BS-import qualified Data.Vector.Storable                        as DVS-import qualified HaskellWorks.Data.Json.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)

@@ -2,4 +2,4 @@   ( module X   ) where -import HaskellWorks.Data.Json.Internal.Token.Tokenize as X+import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize as X

@@ -1,165 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeSynonymInstances  #-}--module HaskellWorks.Data.Json.Internal.Token.Tokenize-    ( IsChar(..)-    , JsonToken(..)-    , ParseJson(..)-    ) where--import Control.Applicative-import Data.Bits-import Data.Char-import Data.Word-import Data.Word8-import HaskellWorks.Data.Char.IsChar-import HaskellWorks.Data.Json.Internal.Token.Types-import HaskellWorks.Data.Parser                    ((<?>))--import qualified Data.Attoparsec.ByteString.Char8 as BC-import qualified Data.Attoparsec.Combinator       as AC-import qualified Data.Attoparsec.Types            as T-import qualified Data.ByteString                  as BS-import qualified HaskellWorks.Data.Parser         as P--hexDigitNumeric :: P.Parser t u => T.Parser t Int-hexDigitNumeric = do-  c <- P.satisfyChar (\c -> '0' <= c && c <= '9')-  return $ ord c - ord '0'--hexDigitAlphaLower :: P.Parser t u => T.Parser t Int-hexDigitAlphaLower = do-  c <- P.satisfyChar (\c -> 'a' <= c && c <= 'z')-  return $ ord c - ord 'a' + 10--hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int-hexDigitAlphaUpper = do-  c <- P.satisfyChar (\c -> 'A' <= c && c <= 'Z')-  return $ ord c - ord 'A' + 10--hexDigit :: P.Parser t u => T.Parser t Int-hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper--class ParseJson t s d where-  parseJsonTokenString :: T.Parser t (JsonToken s d)-  parseJsonToken :: T.Parser t (JsonToken s d)-  parseJsonTokenBraceL :: T.Parser t (JsonToken s d)-  parseJsonTokenBraceR :: T.Parser t (JsonToken s d)-  parseJsonTokenBracketL :: T.Parser t (JsonToken s d)-  parseJsonTokenBracketR :: T.Parser t (JsonToken s d)-  parseJsonTokenComma :: T.Parser t (JsonToken s d)-  parseJsonTokenColon :: T.Parser t (JsonToken s d)-  parseJsonTokenWhitespace :: T.Parser t (JsonToken s d)-  parseJsonTokenNull :: T.Parser t (JsonToken s d)-  parseJsonTokenBoolean :: T.Parser t (JsonToken s d)-  parseJsonTokenDouble :: T.Parser t (JsonToken s d)--  parseJsonToken =-    parseJsonTokenString     <|>-    parseJsonTokenBraceL     <|>-    parseJsonTokenBraceR     <|>-    parseJsonTokenBracketL   <|>-    parseJsonTokenBracketR   <|>-    parseJsonTokenComma      <|>-    parseJsonTokenColon      <|>-    parseJsonTokenWhitespace <|>-    parseJsonTokenNull       <|>-    parseJsonTokenBoolean    <|>-    parseJsonTokenDouble--instance ParseJson BS.ByteString String Double where-  parseJsonTokenBraceL    = P.string "{" >> return JsonTokenBraceL-  parseJsonTokenBraceR    = P.string "}" >> return JsonTokenBraceR-  parseJsonTokenBracketL  = P.string "[" >> return JsonTokenBracketL-  parseJsonTokenBracketR  = P.string "]" >> return JsonTokenBracketR-  parseJsonTokenComma     = P.string "," >> return JsonTokenComma-  parseJsonTokenColon     = P.string ":" >> return JsonTokenColon-  parseJsonTokenNull      = P.string "null" >> return JsonTokenNull-  parseJsonTokenDouble    = JsonTokenNumber <$> P.rational--  parseJsonTokenString = do-    _ <- P.string "\""-    value <- many (verbatimChar <|> escapedChar <|> escapedCode)-    _ <- P.string "\""-    return $ JsonTokenString value-    where-      verbatimChar  = P.satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"-      escapedChar   = do-        _ <- P.string "\\"-        (   P.char '"'  >> return '"'  ) <|>-          ( P.char 'b'  >> return '\b' ) <|>-          ( P.char 'n'  >> return '\n' ) <|>-          ( P.char 'f'  >> return '\f' ) <|>-          ( P.char 'r'  >> return '\r' ) <|>-          ( P.char 't'  >> return '\t' ) <|>-          ( P.char '\\' >> return '\\' ) <|>-          ( P.char '\'' >> return '\'' ) <|>-          ( P.char '/'  >> return '/'  )-      escapedCode   = do-        _ <- P.string "\\u"-        a <- hexDigit-        b <- hexDigit-        c <- hexDigit-        d <- hexDigit-        return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d--  parseJsonTokenWhitespace = do-    _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"]-    return JsonTokenWhitespace--  parseJsonTokenBoolean = true <|> false-    where true  = P.string "true"   >> return (JsonTokenBoolean True)-          false = P.string "false"  >> return (JsonTokenBoolean False)--instance ParseJson BS.ByteString BS.ByteString Double where-  parseJsonTokenBraceL    = P.string "{" >> return JsonTokenBraceL-  parseJsonTokenBraceR    = P.string "}" >> return JsonTokenBraceR-  parseJsonTokenBracketL  = P.string "[" >> return JsonTokenBracketL-  parseJsonTokenBracketR  = P.string "]" >> return JsonTokenBracketR-  parseJsonTokenComma     = P.string "," >> return JsonTokenComma-  parseJsonTokenColon     = P.string ":" >> return JsonTokenColon-  parseJsonTokenNull      = P.string "null" >> return JsonTokenNull-  parseJsonTokenDouble    = JsonTokenNumber <$> P.rational--  parseJsonTokenString = do-    _ <- P.string "\""-    value <- many (verbatimChar <|> escapedChar <|> escapedCode)-    _ <- P.string "\""-    return $ JsonTokenString $ BS.pack value-    where-      word :: Word8 -> T.Parser BS.ByteString Word8-      word w = P.satisfy (== w)-      verbatimChar :: T.Parser BS.ByteString Word8-      verbatimChar  = P.satisfy (\w -> w /= _quotedbl && w /= _backslash) -- <?> "invalid string character"-      escapedChar :: T.Parser BS.ByteString Word8-      escapedChar   = do-        _ <- P.string "\\"-        (   word _quotedbl    >> return _quotedbl       ) <|>-          ( word _b           >> return 0x08            ) <|>-          ( word _n           >> return _lf             ) <|>-          ( word _f           >> return _np             ) <|>-          ( word _r           >> return _cr             ) <|>-          ( word _t           >> return _tab            ) <|>-          ( word _backslash   >> return _backslash      ) <|>-          ( word _quotesingle >> return _quotesingle    ) <|>-          ( word _slash       >> return _slash          )-      escapedCode :: T.Parser BS.ByteString Word8-      escapedCode   = do-        _ <- P.string "\\u"-        a <- hexDigit-        b <- hexDigit-        c <- hexDigit-        d <- hexDigit-        return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d--  parseJsonTokenWhitespace = do-    _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"]-    return JsonTokenWhitespace--  parseJsonTokenBoolean = true <|> false-    where-      true  = P.string "true"   >> return (JsonTokenBoolean True)-      false = P.string "false"  >> return (JsonTokenBoolean False)

@@ -4,7 +4,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TupleSections         #-}  module HaskellWorks.Data.Json.Internal.Value where 

@@ -0,0 +1,29 @@+module HaskellWorks.Data.Json.Internal.Word64 where++import Data.Word++import qualified HaskellWorks.Data.Json.Internal.Word8 as W8++doubleQuote :: Word64+doubleQuote = 0x0101010101010101 * fromIntegral W8.doubleQuote++backSlack :: Word64+backSlack = 0x0101010101010101 * fromIntegral W8.backSlash++openBrace :: Word64+openBrace = 0x0101010101010101 * fromIntegral W8.openBrace++closeBrace :: Word64+closeBrace = 0x0101010101010101 * fromIntegral W8.closeBrace++openBracket :: Word64+openBracket = 0x0101010101010101 * fromIntegral W8.openBracket++closeBracket :: Word64+closeBracket = 0x0101010101010101 * fromIntegral W8.closeBracket++comma :: Word64+comma = 0x0101010101010101 * fromIntegral W8.comma++colon :: Word64+colon = 0x0101010101010101 * fromIntegral W8.colon

@@ -0,0 +1,72 @@+module HaskellWorks.Data.Json.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

@@ -1,16 +0,0 @@-module HaskellWorks.Data.Json.Internal.Words where--import Data.Word-import Data.Word8--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)--wIsJsonNumberDigit :: Word8 -> Bool-wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns          #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE InstanceSigs          #-}@@ -10,34 +9,17 @@  import Control.Arrow import Data.String-import Data.Word-import Data.Word8-import HaskellWorks.Data.AtLeastSize-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Entry-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.CharLike-import HaskellWorks.Data.Json.Internal.Words-import HaskellWorks.Data.Micro-import HaskellWorks.Data.Mini+import HaskellWorks.Data.Json.Internal.Doc import HaskellWorks.Data.MQuery-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.Row-import HaskellWorks.Data.TreeCursor-import HaskellWorks.Data.Uncons-import Prelude                                   hiding (drop)+import HaskellWorks.Data.MQuery.AtLeastSize+import HaskellWorks.Data.MQuery.Entry+import HaskellWorks.Data.MQuery.Micro+import HaskellWorks.Data.MQuery.Mini+import HaskellWorks.Data.MQuery.Row+import Prelude                              hiding (drop) import Text.PrettyPrint.ANSI.Leijen -import qualified Data.Attoparsec.ByteString.Char8 as ABC-import qualified Data.ByteString                  as BS-import qualified Data.ByteString.Char8            as BSC-import qualified Data.DList                       as DL-import qualified Data.List                        as L-import qualified HaskellWorks.Data.BalancedParens as BP+import qualified Data.ByteString as BS  data LightJson c   = LightJsonString String@@ -56,111 +38,14 @@   (==)  LightJsonNull       LightJsonNull      = True   (==)  _                   _                  = False --- instance Ord (LightJson c) where---   compare (LightJsonString a) (LightJsonString b)  = a `compare` b---   compare (LightJsonNumber a) (LightJsonNumber b)  = a `compare` b---   compare (LightJsonBool   a) (LightJsonBool   b)  = a `compare` b---   compare  LightJsonNull       LightJsonNull       = True--data (LightJsonField c) = LightJsonField String (LightJson c)+data LightJsonField c = LightJsonField String (LightJson c)  class LightJsonAt a where   lightJsonAt :: a -> LightJson a -wSpace :: Word8-wSpace = 0x20--data JsonState-  = Escaped-  | InJson-  | InString-  | InNumber-  | InIdent--slurpByteString :: BS.ByteString -> BS.ByteString-slurpByteString bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genString (InJson, bs) in cs-  where genString :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString))-        genString (InJson, cs) = case BS.uncons cs of-          Just (!e, !es) | e == _quotedbl     -> genString            (InString , es)-          -- TODO: Only match whitespace-          Just (!_, !es) -> genString            (InJson   , es)-          Nothing        -> Nothing-        genString (InString, ds) = case BS.uncons ds of-          Just (!e, !es) | e == _backslash    -> genString            (Escaped  , es)-          Just (!e, !_ ) | e == _quotedbl     -> Nothing-          Just (e , !es) -> Just (e            , (InString , es))-          Nothing        -> Nothing-        genString (Escaped, ds) = case BS.uncons ds of-          Just (_ , !es) -> Just (_period      , (InString , es))-          Nothing        -> Nothing-        genString (_, _) = Nothing--slurpString :: BS.ByteString -> String-slurpString bs = L.unfoldr genString (InJson, BSC.unpack bs)-  where genString :: (JsonState, String) -> Maybe (Char, (JsonState, String))-        genString (InJson, ds) = case ds of-          (e:es) | e == '"'  -> genString  (InString , es)-          (_:es) -> genString  (InJson   , es)-          _      -> Nothing-        genString (InString, ds) = case ds of-          (e:es) | e == '\\'  -> genString  (Escaped  , es)-          (e:_ ) | e == '"'   -> Nothing-          (e:es) -> Just (e,   (InString , es))-          _      -> Nothing-        genString (Escaped, ds) = case ds of-          (_:es) -> Just ('.', (InString , es))-          _      -> Nothing-        genString (_, _) = Nothing--slurpNumber :: BS.ByteString -> BS.ByteString-slurpNumber bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genNumber (InJson, bs) in cs-    where genNumber :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString))-          genNumber (InJson, cs) = case BS.uncons cs of-            Just (!d, !ds) | isLeadingDigit d   -> Just (d           , (InNumber , ds))-            Just (!d, !ds) -> Just (d           , (InJson   , ds))-            Nothing        -> Nothing-          genNumber (InNumber, cs) = case BS.uncons cs of-            Just (!d, !ds) | isTrailingDigit d  -> Just (d           , (InNumber , ds))-            Just (!d, !ds) | d == _quotedbl     -> Just (_parenleft  , (InString , ds))-            _              -> Nothing-          genNumber (_, _) = Nothing--instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JsonCursor BS.ByteString v w) where-  lightJsonAt k = case uncons remainder of-    Just (!c, _) | isLeadingDigit2 c  -> LightJsonNumber  (slurpNumber remainder)-    Just (!c, _) | isQuotDbl c        -> LightJsonString  (slurpString remainder)-    Just (!c, _) | isChar_t c         -> LightJsonBool    True-    Just (!c, _) | isChar_f c         -> LightJsonBool    False-    Just (!c, _) | isChar_n c         -> LightJsonNull-    Just (!c, _) | isBraceLeft c      -> LightJsonObject (mapValuesFrom   (firstChild k))-    Just (!c, _) | isBracketLeft c    -> LightJsonArray  (arrayValuesFrom (firstChild k))-    Just _       -> LightJsonError "Invalid Json Type"-    Nothing      -> LightJsonError "End of data"-    where ik                = interests k-          bpk               = balancedParens k-          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))-          remainder         = drop (toCount p) (cursorText k)-          arrayValuesFrom   = L.unfoldr (fmap (id &&& nextSibling))-          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField-          pairwise (a:b:rs) = (a, b) : pairwise rs-          pairwise _        = []-          asField (a, b)    = case lightJsonAt a of-                                LightJsonString s -> [(s, b)]-                                _                 -> []--toLightJsonField :: (String, LightJson c) -> LightJsonField c-toLightJsonField (k, v) = LightJsonField k v- instance LightJsonAt c => Pretty (LightJsonField c) where   pretty (LightJsonField k v) = text (show k) <> text ": " <> pretty v -hEncloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc-hEncloseSep l r s ds-    = case ds of-        []  -> l <> r-        [d] -> l <> d <> r-        _   -> hcat (zipWith (<>) (l : repeat s) ds) <> r- instance LightJsonAt c => Pretty (LightJson c) where   pretty c = case c of     LightJsonString s   -> dullgreen  (text (show s))@@ -171,6 +56,8 @@     LightJsonBool w     -> red (text (show w))     LightJsonNull       -> text "null"     LightJsonError s    -> text "<error " <> text s <> text ">"+    where toLightJsonField :: (String, LightJson c) -> LightJsonField c+          toLightJsonField (k, v) = LightJsonField k v  instance Pretty (Micro (LightJson c)) where   pretty (Micro (LightJsonString s )) = dullgreen (text (show s))@@ -211,63 +98,3 @@  instance LightJsonAt c => Pretty (MQuery (Entry String (LightJson c))) where   pretty (MQuery das) = pretty (Row 120 das)---- hasKV :: LightJsonAt c => BS.ByteString -> LightJson c -> LightJson c -> MQuery (LightJson c)--- hasKV k v (LightJsonObject xs)  = let ys = second lightJsonAt `map` xs in---                                   if (k, v) `elem` ys then MQuery (DL.singleton (LightJsonObject xs)) else MQuery DL.empty--- hasKV _ _  _                    = MQuery DL.empty--item :: LightJsonAt c => LightJson c -> MQuery (LightJson c)-item jpv = case jpv of-  LightJsonArray es -> MQuery $ DL.fromList (lightJsonAt `map` es)-  _                 -> MQuery   DL.empty--entry :: LightJsonAt c => LightJson c -> MQuery (Entry String (LightJson c))-entry jpv = case jpv of-  LightJsonObject fs -> MQuery $ DL.fromList ((uncurry Entry . second lightJsonAt) `map` fs)-  _                  -> MQuery   DL.empty--asString :: LightJson c -> MQuery String-asString jpv = case jpv of-  LightJsonString s -> MQuery $ DL.singleton s-  _                 -> MQuery   DL.empty--asDouble :: LightJson c -> MQuery Double-asDouble jpv = case jpv of-  LightJsonNumber sn  -> case ABC.parse ABC.rational sn of-    ABC.Fail    {}    -> MQuery DL.empty-    ABC.Partial f     -> case f " " of-      ABC.Fail    {}  -> MQuery DL.empty-      ABC.Partial _   -> MQuery DL.empty-      ABC.Done    _ r -> MQuery (DL.singleton r)-    ABC.Done    _ r   -> MQuery (DL.singleton r)-  _                   -> MQuery   DL.empty--asInteger :: LightJson c -> MQuery Integer-asInteger jpv = do-  d <- asDouble jpv-  return (floor d)--castAsInteger :: LightJson c -> MQuery Integer-castAsInteger jpv = case jpv of-  LightJsonString n -> MQuery $ DL.singleton (read n)-  LightJsonNumber _ -> asInteger jpv-  _                 -> MQuery   DL.empty--named :: String -> Entry String (LightJson c) -> MQuery (LightJson c)-named fieldName (Entry fieldName' jpv) | fieldName == fieldName'  = MQuery $ DL.singleton jpv-named _         _                      = MQuery   DL.empty--jsonKeys :: LightJson c -> [String]-jsonKeys jpv = case jpv of-  LightJsonObject fs -> fst `map` fs-  _                  -> []--hasKey :: String -> LightJson c -> Bool-hasKey fieldName jpv = fieldName `elem` jsonKeys jpv--jsonSize :: LightJson c -> MQuery Integer-jsonSize jpv = case jpv of-  LightJsonArray  es -> MQuery (DL.singleton (fromIntegral (length es)))-  LightJsonObject es -> MQuery (DL.singleton (fromIntegral (length es)))-  _                  -> MQuery (DL.singleton 0)

@@ -1,127 +0,0 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Json.Load-  ( indexJson-  , loadByteString-  , loadJson-  , loadJsonPartial-  , loadJsonStrict-  , loadJsonWithCsPoppyIndex-  , loadJsonWithIndex-  , loadJsonWithPoppy512Index-  , loadJsonWithPoppy512Index2-  ) where--import Control.Monad-import Data.Word-import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Internal.Index-import HaskellWorks.Data.Json.Internal.PartialIndex-import HaskellWorks.Data.Json.PartialValue-import HaskellWorks.Data.Json.Value-import HaskellWorks.Data.RankSelect.CsPoppy-import HaskellWorks.Data.RankSelect.Poppy512-import System.IO-import System.IO.MMap--import qualified Data.ByteString          as BS-import qualified Data.ByteString.Internal as BSI-import qualified Data.Vector.Storable     as DVS---- | Write out a vector verbatim into an open file handle.-hPutVector :: forall a. Storable a => Handle -> DVS.Vector a -> IO ()-hPutVector h v = withForeignPtr fp $ \p -> hPutBuf h (p `plusPtr` offset) sz-      where-        (fp, offset, n) = DVS.unsafeToForeignPtr v-        eltsize = sizeOf (undefined :: a)-        sz = n * eltsize---- | Write the vector verbatim to a file.-writeVector :: forall a. Storable a => FilePath -> DVS.Vector a -> IO ()-writeVector fp v = withFile fp WriteMode $ \h -> hPutVector h v--readJson :: String -> IO (JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-readJson path = do-  bs <- loadByteString path-  putStrLn "Read file"-  let !cursor = fromByteString bs :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))-  putStrLn "Created cursor"-  return cursor--loadJsonStrict :: String -> IO (Either DecodeError [JsonValue])-loadJsonStrict filename = do-  !cursor <- readJson filename-  let !jsonResult = (jsonIndexAt >=> jsonValueAt) cursor-  return $ (:[]) `fmap` jsonResult--loadByteString :: FilePath -> IO BS.ByteString-loadByteString filepath = do-  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing-  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size-  return bs--loadJsonRawWithIndex :: String -> IO (BS.ByteString, DVS.Vector Word64, DVS.Vector Word64)-loadJsonRawWithIndex filename = do-  jsonFr    <- mmapFileForeignPtr filename ReadOnly Nothing-  jsonIbFr  <- mmapFileForeignPtr (filename ++ ".ib") ReadOnly Nothing-  jsonBpFr  <- mmapFileForeignPtr (filename ++ ".bp") 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)--loadJsonWithIndex :: String -> IO JsonPartialValue-loadJsonWithIndex filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--loadJsonWithPoppy512Index :: String -> IO JsonPartialValue-loadJsonWithPoppy512Index filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--loadJsonWithCsPoppyIndex :: String -> IO JsonPartialValue-loadJsonWithCsPoppyIndex filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--loadJsonWithPoppy512Index2 :: String -> IO JsonPartialValue-loadJsonWithPoppy512Index2 filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1-                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--indexJson :: String -> IO ()-indexJson filename = do-  JsonCursor _ ib (SimpleBalancedParens bp) _ <- readJson filename-  let wib = DVS.unsafeCast ib :: DVS.Vector Word8-  let wbp = DVS.unsafeCast bp :: DVS.Vector Word8-  writeVector (filename ++ ".ib") wib-  writeVector (filename ++ ".bp") wbp--loadJson :: String -> IO JsonPartialValue-loadJson = loadJsonWithCsPoppyIndex--loadJsonPartial :: String -> IO JsonPartialValue-loadJsonPartial filename = do-  !cursor <- readJson filename-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult

@@ -1,109 +0,0 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Json.LoadCursor-  ( indexJsonCursor-  , loadByteString-  , loadJsonStrict-  , loadJsonWithCsPoppyIndex-  , loadJsonWithIndex-  , loadJsonWithPoppy512Index-  , loadJsonWithPoppy512Index2-  ) where--import Control.Monad-import Data.Word-import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Internal.Index-import HaskellWorks.Data.Json.Value-import HaskellWorks.Data.RankSelect.CsPoppy-import HaskellWorks.Data.RankSelect.Poppy512-import System.IO-import System.IO.MMap--import qualified Data.ByteString          as BS-import qualified Data.ByteString.Internal as BSI-import qualified Data.Vector.Storable     as DVS---- | Write out a vector verbatim into an open file handle.-hPutVector :: forall a. Storable a => Handle -> DVS.Vector a -> IO ()-hPutVector h v = withForeignPtr fp $ \p -> hPutBuf h (p `plusPtr` offset) sz-      where-        (fp, offset, n) = DVS.unsafeToForeignPtr v-        eltsize = sizeOf (undefined :: a)-        sz = n * eltsize---- | Write the vector verbatim to a file.-writeVector :: forall a. Storable a => FilePath -> DVS.Vector a -> IO ()-writeVector fp v = withFile fp WriteMode $ \h -> hPutVector h v--readJson :: String -> IO (JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-readJson path = do-  bs <- BS.readFile path-  putStrLn "Read file"-  let !cursor = fromByteString bs :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))-  putStrLn "Created cursor"-  return cursor--loadJsonStrict :: String -> IO (Either DecodeError [JsonValue])-loadJsonStrict filename = do-  !cursor <- readJson filename-  let !jsonResult = (jsonIndexAt >=> jsonValueAt) cursor-  return $ (:[]) `fmap` jsonResult--loadByteString :: FilePath -> IO BS.ByteString-loadByteString filepath = do-  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing-  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size-  return bs--loadJsonRawWithIndex :: String -> IO (BS.ByteString, DVS.Vector Word64, DVS.Vector Word64)-loadJsonRawWithIndex filename = do-  jsonFr    <- mmapFileForeignPtr filename ReadOnly Nothing-  jsonIbFr  <- mmapFileForeignPtr (filename ++ ".ib") ReadOnly Nothing-  jsonBpFr  <- mmapFileForeignPtr (filename ++ ".bp") 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)--loadJsonWithIndex :: String -> IO (JsonCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-loadJsonWithIndex filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1-  return cursor--loadJsonWithPoppy512Index :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))-loadJsonWithPoppy512Index filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1-  return cursor--loadJsonWithCsPoppyIndex :: String -> IO (JsonCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64)))-loadJsonWithCsPoppyIndex filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1-  return cursor--loadJsonWithPoppy512Index2 :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512))-loadJsonWithPoppy512Index2 filename = do-  (jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1-                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)-  return cursor--indexJsonCursor :: String -> IO ()-indexJsonCursor filename = do-  JsonCursor _  ib (SimpleBalancedParens bp) _ <- readJson filename-  let wib = DVS.unsafeCast ib :: DVS.Vector Word8-  let wbp = DVS.unsafeCast bp :: DVS.Vector Word8-  writeVector (filename ++ ".ib") wib-  writeVector (filename ++ ".bp") wbp

@@ -21,25 +21,20 @@   ) where  import Control.Arrow-import HaskellWorks.Data.AtLeastSize-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Entry-import HaskellWorks.Data.Json.Cursor+import HaskellWorks.Data.Json.Internal.Doc import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.Internal.Value-import HaskellWorks.Data.Micro-import HaskellWorks.Data.Mini import HaskellWorks.Data.MQuery-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.Row+import HaskellWorks.Data.MQuery.AtLeastSize+import HaskellWorks.Data.MQuery.Entry+import HaskellWorks.Data.MQuery.Micro+import HaskellWorks.Data.MQuery.Mini+import HaskellWorks.Data.MQuery.Row import Text.PrettyPrint.ANSI.Leijen  import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString                  as BS import qualified Data.DList                       as DL-import qualified HaskellWorks.Data.BalancedParens as BP  data JsonPartialValue   = JsonPartialString String@@ -84,21 +79,11 @@             ABC.Partial _   -> JsonPartialError "Unexpected end of field"             ABC.Done    _ s -> JsonPartialString s -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (JsonCursor BS.ByteString v w) where-  jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt- toJsonPartialField :: (String, JsonPartialValue) -> JsonPartialField toJsonPartialField (k, v) = JsonPartialField k v  instance Pretty JsonPartialField where   pretty (JsonPartialField k v) = text (show k) <> text ": " <> pretty v--hEncloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc-hEncloseSep l r s ds-    = case ds of-        []  -> l <> r-        [d] -> l <> d <> r-        _   -> hcat (zipWith (<>) (l : repeat s) ds) <> r  instance Pretty JsonPartialValue where   pretty mjpv = case mjpv of

@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}++module HaskellWorks.Data.Json.Query where++import Control.Arrow+import Data.String+import HaskellWorks.Data.Json.LightJson+import HaskellWorks.Data.MQuery+import HaskellWorks.Data.MQuery.Entry+import Prelude                          hiding (drop)++import qualified Data.Attoparsec.ByteString.Char8 as ABC+import qualified Data.DList                       as DL++item :: LightJsonAt c => LightJson c -> MQuery (LightJson c)+item jpv = case jpv of+  LightJsonArray es -> MQuery $ DL.fromList (lightJsonAt `map` es)+  _                 -> MQuery   DL.empty++entry :: LightJsonAt c => LightJson c -> MQuery (Entry String (LightJson c))+entry jpv = case jpv of+  LightJsonObject fs -> MQuery $ DL.fromList ((uncurry Entry . second lightJsonAt) `map` fs)+  _                  -> MQuery   DL.empty++asString :: LightJson c -> MQuery String+asString jpv = case jpv of+  LightJsonString s -> MQuery $ DL.singleton s+  _                 -> MQuery   DL.empty++asDouble :: LightJson c -> MQuery Double+asDouble jpv = case jpv of+  LightJsonNumber sn  -> case ABC.parse ABC.rational sn of+    ABC.Fail    {}    -> MQuery DL.empty+    ABC.Partial f     -> case f " " of+      ABC.Fail    {}  -> MQuery DL.empty+      ABC.Partial _   -> MQuery DL.empty+      ABC.Done    _ r -> MQuery (DL.singleton r)+    ABC.Done    _ r   -> MQuery (DL.singleton r)+  _                   -> MQuery   DL.empty++asInteger :: LightJson c -> MQuery Integer+asInteger jpv = do+  d <- asDouble jpv+  return (floor d)++castAsInteger :: LightJson c -> MQuery Integer+castAsInteger jpv = case jpv of+  LightJsonString n -> MQuery $ DL.singleton (read n)+  LightJsonNumber _ -> asInteger jpv+  _                 -> MQuery   DL.empty++named :: String -> Entry String (LightJson c) -> MQuery (LightJson c)+named fieldName (Entry fieldName' jpv) | fieldName == fieldName'  = MQuery $ DL.singleton jpv+named _         _                      = MQuery   DL.empty++jsonKeys :: LightJson c -> [String]+jsonKeys jpv = case jpv of+  LightJsonObject fs -> fst `map` fs+  _                  -> []++hasKey :: String -> LightJson c -> Bool+hasKey fieldName jpv = fieldName `elem` jsonKeys jpv++jsonSize :: LightJson c -> MQuery Integer+jsonSize jpv = case jpv of+  LightJsonArray  es -> MQuery (DL.singleton (fromIntegral (length es)))+  LightJsonObject es -> MQuery (DL.singleton (fromIntegral (length es)))+  _                  -> MQuery (DL.singleton 0)+

@@ -7,20 +7,8 @@   , JsonTypeAt(..)   ) where -import Data.Char-import Data.Word8-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.Words 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+import Prelude                       hiding (drop)  {-# ANN module ("HLint: Reduce duplication" :: String) #-} @@ -36,35 +24,3 @@ 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 (JsonCursor 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 (JsonCursor 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

@@ -0,0 +1,85 @@+{-# 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.Backend.Simple.CursorSpec+  ( spec+  ) where++import Control.Monad+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString                              as BS+import qualified HaskellWorks.Data.Json.Backend.Simple.Cursor as Z+import qualified HaskellWorks.Data.Json.Backend.Simple.Fast   as FAST+import qualified HaskellWorks.Data.Json.Backend.Simple.Value  as V+import qualified HaskellWorks.Data.TreeCursor                 as TC++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Backend.Simple.CursorSpec" $ do+  describe "Json cursor" $ do+    describe "For sample Json" $ do+      let k = FAST.makeCursor ("[[11],[22]]" :: BS.ByteString)+      -- [  [  1  1 ]  ,  [  2  2 ]  ]+      -- (( ((      )) )( ((      )) ))+      it "can navigate" $ requireTest $ do+        (Z.cursorRank <$>  Just                            k) === Just 1+        (Z.cursorRank <$>  ns                              k) === Nothing+        (Z.cursorRank <$>  fc                              k) === Just 2+        (Z.cursorRank <$> (fc >=> ns                     ) k) === Just 8+        (Z.cursorRank <$> (fc >=> ns >=> fc              ) k) === Just 9+        (Z.cursorRank <$> (fc >=> ns >=> fc >=> ns       ) k) === Nothing+        (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc       ) k) === Just 10+        (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing+        (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing+        (Z.cursorRank <$> (fc >=> fc                     ) k) === Just 3+        (Z.cursorRank <$> (fc >=> fc >=> ns              ) k) === Nothing+        (Z.cursorRank <$> (fc >=> fc >=> fc              ) k) === Just 4+        (Z.cursorRank <$> (fc >=> fc >=> fc >=> ns       ) k) === Nothing+        (Z.cursorRank <$> (fc >=> fc >=> fc >=> fc       ) k) === Nothing+      it "can snippet pos" $ requireTest $ do+        (V.snippetPos <$>  Just                            k) === Just (1, 11)+        (V.snippetPos <$>  ns                              k) === Nothing+        (V.snippetPos <$>  fc                              k) === Just (2,  5)+        (V.snippetPos <$> (fc >=> ns                     ) k) === Just (7, 10)+        (V.snippetPos <$> (fc >=> ns >=> fc              ) k) === Just (7, 10)+        (V.snippetPos <$> (fc >=> ns >=> fc >=> ns       ) k) === Nothing+        (V.snippetPos <$> (fc >=> ns >=> fc >=> fc       ) k) === Just (8,  9)+        (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing+        (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing+        (V.snippetPos <$> (fc >=> fc                     ) k) === Just (2,  5)+        (V.snippetPos <$> (fc >=> fc >=> ns              ) k) === Nothing+        (V.snippetPos <$> (fc >=> fc >=> fc              ) k) === Just (3,  4)+        (V.snippetPos <$> (fc >=> fc >=> fc >=> ns       ) k) === Nothing+        (V.snippetPos <$> (fc >=> fc >=> fc >=> fc       ) k) === Nothing+      it "can snippet" $ requireTest $ do+        (V.snippet <$>  Just                            k) === Just "[[11],[22]]"+        (V.snippet <$>  ns                              k) === Nothing+        (V.snippet <$>  fc                              k) === Just "[11]"+        (V.snippet <$> (fc >=> ns                     ) k) === Just "[22]"+        (V.snippet <$> (fc >=> ns >=> fc              ) k) === Just "[22]"+        (V.snippet <$> (fc >=> ns >=> fc >=> ns       ) k) === Nothing+        (V.snippet <$> (fc >=> ns >=> fc >=> fc       ) k) === Just "22"+        (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing+        (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing+        (V.snippet <$> (fc >=> fc                     ) k) === Just "[11]"+        (V.snippet <$> (fc >=> fc >=> ns              ) k) === Nothing+        (V.snippet <$> (fc >=> fc >=> fc              ) k) === Just "11"+        (V.snippet <$> (fc >=> fc >=> fc >=> ns       ) k) === Nothing+        (V.snippet <$> (fc >=> fc >=> fc >=> fc       ) k) === Nothing

@@ -0,0 +1,41 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+++module HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec+  ( spec+  ) where++import Data.Word+import HaskellWorks.Data.Bits.BitShow+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.Backend.Standard.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.Succinct.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 "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"

@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+++module HaskellWorks.Data.Json.Backend.Standard.Succinct.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.Backend.Standard.SemiIndex                 as SI+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson      as J+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 as J++{-# 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.Succinct.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 "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 "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"

@@ -0,0 +1,33 @@+{-# 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.Backend.Standard.Succinct.CursorSpec(spec) where++import Data.Word+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Succinct.GenCursorTest+import HaskellWorks.Data.RankSelect.Poppy512+import Test.Hspec++import qualified Data.ByteString                              as BS+import qualified Data.Vector.Storable                         as DVS+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do+  genTest "DVS.Vector Word64" (SLOW.makeCursor :: String -> JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+  genTest "Poppy512"          (FAST.makeCursor :: String -> JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))

@@ -0,0 +1,103 @@+{-# 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.Backend.Standard.Succinct.GenCursorTest(genTest) where++import Control.Monad+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token+import HaskellWorks.Data.Json.Internal.Index+import HaskellWorks.Data.Json.Internal.Token+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: redundant bracket"          :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling+pn = TC.parent+ss = TC.subtreeSize++genTest :: forall t u.+  ( Eq                t+  , Show              t+  , Select1           t+  , Eq                u+  , Show              u+  , Rank0             u+  , Rank1             u+  , BalancedParens    u+  , TestBit           u)+  => String -> (String -> JsonCursor 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+        jsonIndexAt cursor === Right (JsonIndexArray [JsonIndexNull])+    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+        (jsonTokenAt                                                                      ) cursor === Just (JsonTokenBraceL                 )+        (fc                                                                >=> jsonTokenAt) cursor === Just (JsonTokenString   "widget"      )+        (fc >=> ns                                                         >=> jsonTokenAt) cursor === Just (JsonTokenBraceL                 )+        (fc >=> ns >=> fc                                                  >=> jsonTokenAt) cursor === Just (JsonTokenString   "debug"       )+        (fc >=> ns >=> fc >=> ns                                           >=> jsonTokenAt) cursor === Just (JsonTokenString   "on"          )+        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> jsonTokenAt) cursor === Just (JsonTokenString   "window"      )+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> jsonTokenAt) cursor === Just (JsonTokenBraceL                 )+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> jsonTokenAt) cursor === Just (JsonTokenString   "name"        )+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> jsonTokenAt) cursor === Just (JsonTokenString   "main_window" )+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> jsonTokenAt) cursor === Just (JsonTokenString   "dimensions"  )+        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBracketL               )

@@ -12,15 +12,16 @@  module HaskellWorks.Data.Json.CorpusSpec(spec) where -import Data.Word+import Control.Monad.IO.Class import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.FromBitTextByteString-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Hspec.Hedgehog+import Hedgehog import Test.Hspec -import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS+import qualified Data.ByteString                              as BS+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -28,29 +29,29 @@  spec :: Spec spec = describe "HaskellWorks.Data.Json.Corpus" $ do-  it "Corpus 5000B loads properly" $ do-    inJsonBS                    <- BS.readFile "corpus/5000B.json"-    inInterestBitsBS            <- BS.readFile "corpus/5000B.ib"-    inInterestBalancedParensBS  <- BS.readFile "corpus/5000B.bp"+  it "Corpus 5000B loads properly" $ requireTest $ do+    inJsonBS                    <- liftIO $ BS.readFile "corpus/5000B.json"+    inInterestBitsBS            <- liftIO $ BS.readFile "corpus/5000B.ib"+    inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/5000B.bp"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))+    let !cursor = SLOW.makeCursor inJsonBS     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor-    text `shouldBe` inJsonBS-    ib `shouldBe` inInterestBits-    bp `shouldBe` inInterestBalancedParens-  it "issue-0001 loads properly" $ do-    inJsonBS                    <- BS.readFile "corpus/issue-0001.json"-    inInterestBitsBS            <- BS.readFile "corpus/issue-0001.ib"-    inInterestBalancedParensBS  <- BS.readFile "corpus/issue-0001.bp"+    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.ib"+    inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/issue-0001.bp"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))+    let !cursor = SLOW.makeCursor inJsonBS     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor-    text `shouldBe` inJsonBS-    ib `shouldBe` inInterestBits-    bp `shouldBe` inInterestBalancedParens+    text === inJsonBS+    ib === inInterestBits+    bp === inInterestBalancedParens

@@ -2,7 +2,9 @@  module HaskellWorks.Data.Json.Internal.BlankSpec (spec) where -import HaskellWorks.Data.Json.Internal.Blank+import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank+import HaskellWorks.Hspec.Hedgehog+import Hedgehog import Test.Hspec  import qualified Data.ByteString as BS@@ -11,8 +13,8 @@  whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec whenBlankedJsonShouldBe original expected = do-  it (show original ++ " when blanked json should be " ++ show expected) $ do-    BS.concat (blankJson [original]) `shouldBe` expected+  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

@@ -5,21 +5,23 @@  import Data.String import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Json.Internal.MakeIndex+import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex+import HaskellWorks.Hspec.Hedgehog+import Hedgehog import Test.Hspec -import qualified Data.ByteString                             as BS-import qualified HaskellWorks.Data.Json.Internal.BlankedJson as J+import qualified Data.ByteString                                              as BS+import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J  {-# ANN module ("HLint: Ignore Redundant do"        :: String) #-}  spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec" $ do-  it "Blanking JSON should not contain strange characters 1" $ do+  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 `shouldBe` fromString "11111111 11111111 00000000 11111111 00000000 00000000"-  it "Blanking JSON should not contain strange characters 2" $ do+    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 `shouldBe` fromString "11010000"+    bp === fromString "11010000"

@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}---module HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec(spec) where--import Data.String-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import Test.Hspec--import qualified Data.ByteString                                  as BS-import qualified Data.Vector.Storable                             as DVS-import qualified HaskellWorks.Data.Json.Internal.BlankedJson      as J-import qualified HaskellWorks.Data.Json.Internal.ToInterestBits64 as J--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}--interestBitsOf :: BS.ByteString -> DVS.Vector Word64-interestBitsOf bs = J.toInterestBits64 (J.toBlankedJsonTyped bs)--spec :: Spec-spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec" $ do-  it "Evaluating interest bits" $ do-    BitShown (interestBitsOf ""           ) `shouldBe` fromString ""-    BitShown (interestBitsOf "  \n \r \t ") `shouldBe` fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "1234 "      ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "false "     ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "true "      ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "\"hello\" " ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "\"\\\"\" "  ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "{ "         ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "} "         ) `shouldBe` fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "[ "         ) `shouldBe` fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "] "         ) `shouldBe` fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf ": "         ) `shouldBe` fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf ", "         ) `shouldBe` fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf "{{}}"       ) `shouldBe` fromString "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"-    BitShown (interestBitsOf " { { } } "  ) `shouldBe` fromString "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"

@@ -1,113 +0,0 @@-{-# 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.Succinct.CursorSpec(spec) where--import Control.Monad-import Data.String-import Data.Word-import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Internal.Cursor.Token-import HaskellWorks.Data.Json.Internal.Index-import HaskellWorks.Data.Json.Internal.Token-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512-import Test.Hspec--import qualified Data.ByteString              as BS-import qualified Data.Vector.Storable         as DVS-import qualified HaskellWorks.Data.TreeCursor as TC--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}--fc = TC.firstChild-ns = TC.nextSibling-pn = TC.parent-ss = TC.subtreeSize--spec :: Spec-spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-  genSpec "Poppy512"          (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))--genSpec :: forall t u.-  ( Eq                t-  , Show              t-  , Select1           t-  , Eq                u-  , Show              u-  , Rank0             u-  , Rank1             u-  , BalancedParens    u-  , TestBit           u-  , FromForeignRegion (JsonCursor BS.ByteString t u)-  , IsString          (JsonCursor BS.ByteString t u))-  => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()-genSpec t _ = do-  describe ("Json cursor of type " ++ t) $ do-    describe "For empty json array" $ do-      let cursor =  "[null]" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do-        jsonIndexAt cursor `shouldBe` Right (JsonIndexArray [JsonIndexNull])-    describe "For sample Json" $ do-      let cursor =  "{ \-                    \    \"widget\": { \-                    \        \"debug\": \"on\", \-                    \        \"window\": { \-                    \            \"name\": \"main_window\", \-                    \            \"dimensions\": [500, 600.01e-02, true, false, null] \-                    \        } \-                    \    } \-                    \}" :: JsonCursor BS.ByteString t u-      it "can navigate up" $ do-        (                                                                      pn) cursor `shouldBe` Nothing-        (fc                                                                >=> pn) cursor `shouldBe`                                    Just cursor-        (fc >=> ns                                                         >=> pn) cursor `shouldBe`                                    Just cursor-        (fc >=> ns >=> fc                                                  >=> pn) cursor `shouldBe` (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns                                           >=> pn) cursor `shouldBe` (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> pn) cursor `shouldBe` (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> pn) cursor `shouldBe` (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> pn) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> pn) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> pn) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-      it "can get subtree size" $ do-        (                                                                      ss) cursor `shouldBe` Just 16-        (fc                                                                >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns                                                         >=> ss) cursor `shouldBe` Just 14-        (fc >=> ns >=> fc                                                  >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns                                           >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> ss) cursor `shouldBe` Just 10-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> ss) cursor `shouldBe` Just 1-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor `shouldBe` Just 6-      it "can get token at cursor" $ do-        (jsonTokenAt                                                                      ) cursor `shouldBe` Just (JsonTokenBraceL                 )-        (fc                                                                >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "widget"      )-        (fc >=> ns                                                         >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBraceL                 )-        (fc >=> ns >=> fc                                                  >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "debug"       )-        (fc >=> ns >=> fc >=> ns                                           >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "on"          )-        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "window"      )-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBraceL                 )-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "name"        )-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "main_window" )-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString   "dimensions"  )-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBracketL               )

@@ -2,8 +2,10 @@  module HaskellWorks.Data.Json.Token.TokenizeSpec (spec) where -import Data.ByteString                                (ByteString)-import HaskellWorks.Data.Json.Internal.Token.Tokenize+import Data.ByteString                                                 (ByteString)+import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize+import HaskellWorks.Hspec.Hedgehog+import Hedgehog import Test.Hspec  import qualified Data.Attoparsec.ByteString.Char8 as BC@@ -16,35 +18,35 @@ spec :: Spec spec = describe "HaskellWorks.Data.Json.Token.TokenizeSpec" $ do   describe "When parsing single token at beginning of text" $ do-    it "Empty Json should produce no bits" $-      parseJsonToken' "" `shouldBe` Left "not enough input"-    it "Json with one space should produce whitespace token" $-      parseJsonToken' " " `shouldBe` Right JsonTokenWhitespace-    it "Json with two spaces should produce whitespace token" $-      parseJsonToken' "  " `shouldBe` Right JsonTokenWhitespace-    it "Spaces and newlines should produce no bits" $-      parseJsonToken' "  \n \r \t " `shouldBe` Right JsonTokenWhitespace-    it "`null` at beginning should produce one bit" $-      parseJsonToken' "null " `shouldBe` Right JsonTokenNull-    it "number at beginning should produce one bit" $-      parseJsonToken' "1234 " `shouldBe` Right (JsonTokenNumber 1234)-    it "false at beginning should produce one bit" $-      parseJsonToken' "false " `shouldBe` Right (JsonTokenBoolean False)-    it "true at beginning should produce one bit" $-      parseJsonToken' "true " `shouldBe` Right (JsonTokenBoolean True)-    it "string at beginning should produce one bit" $-      parseJsonToken' "\"hello\" " `shouldBe` Right (JsonTokenString "hello")-    it "quoted string should parse" $-      parseJsonToken' "\"\\\"\" " `shouldBe` Right (JsonTokenString "\"")-    it "left brace at beginning should produce one bit" $-      parseJsonToken' "{ " `shouldBe` Right JsonTokenBraceL-    it "right brace at beginning should produce one bit" $-      parseJsonToken' "} " `shouldBe` Right JsonTokenBraceR-    it "left bracket at beginning should produce one bit" $-      parseJsonToken' "[ " `shouldBe` Right JsonTokenBracketL-    it "right bracket at beginning should produce one bit" $-      parseJsonToken' "] " `shouldBe` Right JsonTokenBracketR-    it "right bracket at beginning should produce one bit" $-      parseJsonToken' ": " `shouldBe` Right JsonTokenColon-    it "right bracket at beginning should produce one bit" $-      parseJsonToken' ", " `shouldBe` Right JsonTokenComma+    it "Empty Json should produce no bits" $ requireTest $+      parseJsonToken' "" === Left "not enough input"+    it "Json with one space should produce whitespace token" $ requireTest $+      parseJsonToken' " " === Right JsonTokenWhitespace+    it "Json with two spaces should produce whitespace token" $ requireTest $+      parseJsonToken' "  " === Right JsonTokenWhitespace+    it "Spaces and newlines should produce no bits" $ requireTest $+      parseJsonToken' "  \n \r \t " === Right JsonTokenWhitespace+    it "`null` at beginning should produce one bit" $ requireTest $+      parseJsonToken' "null " === Right JsonTokenNull+    it "number at beginning should produce one bit" $ requireTest $+      parseJsonToken' "1234 " === Right (JsonTokenNumber 1234)+    it "false at beginning should produce one bit" $ requireTest $+      parseJsonToken' "false " === Right (JsonTokenBoolean False)+    it "true at beginning should produce one bit" $ requireTest $+      parseJsonToken' "true " === Right (JsonTokenBoolean True)+    it "string at beginning should produce one bit" $ requireTest $+      parseJsonToken' "\"hello\" " === Right (JsonTokenString "hello")+    it "quoted string should parse" $ requireTest $+      parseJsonToken' "\"\\\"\" " === Right (JsonTokenString "\"")+    it "left brace at beginning should produce one bit" $ requireTest $+      parseJsonToken' "{ " === Right JsonTokenBraceL+    it "right brace at beginning should produce one bit" $ requireTest $+      parseJsonToken' "} " === Right JsonTokenBraceR+    it "left bracket at beginning should produce one bit" $ requireTest $+      parseJsonToken' "[ " === Right JsonTokenBracketL+    it "right bracket at beginning should produce one bit" $ requireTest $+      parseJsonToken' "] " === Right JsonTokenBracketR+    it "right bracket at beginning should produce one bit" $ requireTest $+      parseJsonToken' ": " === Right JsonTokenColon+    it "right bracket at beginning should produce one bit" $ requireTest $+      parseJsonToken' ", " === Right JsonTokenComma

@@ -12,23 +12,21 @@ module HaskellWorks.Data.Json.TypeSpec (spec) where  import Control.Monad-import Data.String-import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor import HaskellWorks.Data.Json.Type import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512+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.TreeCursor as TC+import qualified Data.ByteString                              as BS+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW+import qualified HaskellWorks.Data.TreeCursor                 as TC  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -39,8 +37,8 @@  spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-  genSpec "Poppy512"          (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "DVS.Vector Word64" SLOW.makeCursor+  genSpec "Poppy512"          FAST.makeCursor  genSpec :: forall t u.   ( Eq                t@@ -51,47 +49,45 @@   , Rank0             u   , Rank1             u   , BalancedParens    u-  , TestBit           u-  , FromForeignRegion (JsonCursor BS.ByteString t u)-  , IsString          (JsonCursor BS.ByteString t u))-  => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()-genSpec t _ = do+  , TestBit           u)+  => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t makeCursor = do   describe ("Json cursor of type " ++ t) $ do-    let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)+    let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))     forJson "{}" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeObject+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeObject     forJson " {}" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeObject+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeObject     forJson "1234" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeNumber+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeNumber     forJson "\"Hello\"" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeString+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeString     forJson "[]" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeArray+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeArray     forJson "true" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeBool+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeBool     forJson "false" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeBool+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeBool     forJson "null" $ \cursor -> do-      it "should have correct type"       $         jsonTypeAt  cursor `shouldBe` Just JsonTypeNull+      it "should have correct type"       $ requireTest $         jsonTypeAt  cursor === Just JsonTypeNull     forJson "[null]" $ \cursor -> do-      it "should have correct type"       $ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull+      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" $ do-        (fc >=> ns >=> jsonTypeAt)  cursor  `shouldBe` Just JsonTypeObject-      it "cursor can navigate to first child of object at second child of array" $ do-        (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-      it "cursor can navigate to first child of object at second child of array" $ do-        (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber+      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 =  "[null]" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do-        (                     jsonTypeAt) cursor `shouldBe` Just JsonTypeArray-        (fc               >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull-        (fc >=> ns        >=> jsonTypeAt) cursor `shouldBe` Nothing-        (fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Nothing+      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 =  "{ \+      let cursor = makeCursor "{ \                     \    \"widget\": { \                     \        \"debug\": \"on\", \                     \        \"window\": { \@@ -100,15 +96,15 @@                     \        } \                     \    } \                     \}" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do-        (                                                                      jsonTypeAt) cursor `shouldBe` Just JsonTypeObject-        (fc                                                                >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns                                                         >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject-        (fc >=> ns >=> fc                                                  >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns                                           >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeArray+      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

@@ -12,25 +12,23 @@ module HaskellWorks.Data.Json.ValueSpec (spec) where  import Control.Monad-import Data.String-import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512+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.TreeCursor as TC+import qualified Data.ByteString                              as BS+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW+import qualified HaskellWorks.Data.TreeCursor                 as TC  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -41,8 +39,8 @@  spec :: Spec spec = describe "HaskellWorks.Data.Json.ValueSpec" $ do-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))-  genSpec "Poppy512"          (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "DVS.Vector Word64" SLOW.makeCursor+  genSpec "Poppy512"          FAST.makeCursor  jsonValueVia  ::   ( BalancedParens u@@ -64,46 +62,44 @@   , Rank0             u   , Rank1             u   , BalancedParens    u-  , TestBit           u-  , FromForeignRegion (JsonCursor BS.ByteString t u)-  , IsString          (JsonCursor BS.ByteString t u))-  => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()-genSpec t _ = do+  , TestBit           u)+  => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t makeCursor = do   describe ("Json cursor of type " ++ t) $ do-    let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)+    let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))     forJson "{}" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonObject [])+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject [])     forJson " {}" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonObject [])+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject [])     forJson "1234" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonNumber 1234)+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonNumber 1234)     forJson "\"Hello\"" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonString "Hello")+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "Hello")     forJson "[]" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [])+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [])     forJson "true" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonBool True)+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool True)     forJson "false" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonBool False)+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool False)     forJson "null" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right JsonNull+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right JsonNull     forJson "[null]" $ \cursor -> do-      it "should have correct value"      $ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [JsonNull])-      it "should have correct value"      $ jsonValueVia (fc   cursor) `shouldBe` Right  JsonNull+      it "should have correct value"      $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull])+      it "should have correct value"      $ requireTest $ jsonValueVia (fc   cursor) === Right  JsonNull     forJson "[null, {\"field\": 1}]" $ \cursor -> do-      it "cursor can navigate to second child of array" $ do-        jsonValueVia ((fc >=> ns)   cursor) `shouldBe` Right (                     JsonObject [("field", JsonNumber 1)] )-        jsonValueVia (Just          cursor) `shouldBe` Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]])+      it "cursor can navigate to second child of array" $ requireTest $ do+        jsonValueVia ((fc >=> ns)   cursor) === Right (                     JsonObject [("field", JsonNumber 1)] )+        jsonValueVia (Just          cursor) === Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]])     describe "For empty json array" $ do-      let cursor =  "[]" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do-        jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [])+      let cursor = makeCursor "[]"+      it "can navigate down and forwards" $ requireTest $ do+        jsonValueVia (Just cursor) === Right (JsonArray [])     describe "For empty json array" $ do-      let cursor =  "[null]" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do-        jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [JsonNull])+      let cursor = makeCursor "[null]"+      it "can navigate down and forwards" $ requireTest $ do+        jsonValueVia (Just cursor) === Right (JsonArray [JsonNull])     describe "For sample Json" $ do-      let cursor =  "{ \+      let cursor = makeCursor "{ \                     \    \"widget\": { \                     \        \"debug\": \"on\", \                     \        \"window\": { \@@ -112,24 +108,24 @@                     \        } \                     \    } \                     \}" :: JsonCursor BS.ByteString t u-      it "can navigate down and forwards" $ do+      it "can navigate down and forwards" $ requireTest $ do         let array   = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue         let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue         let object2 = JsonObject ([("debug", JsonString "on"), ("window", object1)]) :: JsonValue         let object3 = JsonObject ([("widget", object2)]) :: JsonValue-        jsonValueVia (Just                                                                                                   cursor) `shouldBe` Right object3-        jsonValueVia ((fc                                                                                                  ) cursor) `shouldBe` Right (JsonString "widget"      )-        jsonValueVia ((fc >=> ns                                                                                           ) cursor) `shouldBe` Right (object2                  )-        jsonValueVia ((fc >=> ns >=> fc                                                                                    ) cursor) `shouldBe` Right (JsonString "debug"       )-        jsonValueVia ((fc >=> ns >=> fc >=> ns                                                                             ) cursor) `shouldBe` Right (JsonString "on"          )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns                                                                      ) cursor) `shouldBe` Right (JsonString "window"      )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns                                                               ) cursor) `shouldBe` Right (object1                  )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                                                        ) cursor) `shouldBe` Right (JsonString "name"        )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns                                                 ) cursor) `shouldBe` Right (JsonString "main_window" )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns                                          ) cursor) `shouldBe` Right (JsonString "dimensions"  )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns                                   ) cursor) `shouldBe` Right (array                    )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                            ) cursor) `shouldBe` Right (JsonNumber 500           )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns                     ) cursor) `shouldBe` Right (JsonNumber 600.01e-02    )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns              ) cursor) `shouldBe` Right (JsonBool True            )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns       ) cursor) `shouldBe` Right (JsonBool False           )-        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) `shouldBe` Right JsonNull+        jsonValueVia (Just                                                                                                   cursor) === Right object3+        jsonValueVia ((fc                                                                                                  ) cursor) === Right (JsonString "widget"      )+        jsonValueVia ((fc >=> ns                                                                                           ) cursor) === Right (object2                  )+        jsonValueVia ((fc >=> ns >=> fc                                                                                    ) cursor) === Right (JsonString "debug"       )+        jsonValueVia ((fc >=> ns >=> fc >=> ns                                                                             ) cursor) === Right (JsonString "on"          )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns                                                                      ) cursor) === Right (JsonString "window"      )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns                                                               ) cursor) === Right (object1                  )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                                                        ) cursor) === Right (JsonString "name"        )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns                                                 ) cursor) === Right (JsonString "main_window" )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns                                          ) cursor) === Right (JsonString "dimensions"  )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns                                   ) cursor) === Right (array                    )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                            ) cursor) === Right (JsonNumber 500           )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns                     ) cursor) === Right (JsonNumber 600.01e-02    )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns              ) cursor) === Right (JsonBool True            )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns       ) cursor) === Right (JsonBool False           )+        jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) === Right JsonNull