hw-json 0.8.1.0 → 0.9.0.0

raw patch · 50 files changed

+812/−871 lines, 50 filesdep +generic-lensdep +lensdep +optparse-applicativedep ~containersdep ~criteriondep ~hw-rankselectnew-component:exe:hw-jsonnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-lens, lens, optparse-applicative, resourcet

Dependency ranges changed: containers, criterion, hw-rankselect

API changes (from Hackage documentation)

Files

• README.md +3/−4
• app/App/Commands.hs +13/−0
• app/App/Commands/CreateIndex.hs +51/−0
• app/App/Commands/Demo.hs +40/−0
• app/App/Commands/Types.hs +14/−0
• app/App/IO.hs +27/−0
• app/App/Lens.hs +14/−0
• app/Main.hs +6/−48
• bench/Main.hs +2/−3
• hw-json.cabal +35/−23
• src/HaskellWorks/Data/Json.hs +0/−1
• src/HaskellWorks/Data/Json/CharLike.hs +0/−23
• src/HaskellWorks/Data/Json/Cursor.hs +19/−44
• src/HaskellWorks/Data/Json/Internal/BlankedJson.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/CharLike.hs +23/−0
• src/HaskellWorks/Data/Json/Internal/Cursor/Token.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/IbBp.hs +24/−0
• src/HaskellWorks/Data/Json/Internal/Index.hs +61/−0
• src/HaskellWorks/Data/Json/Internal/MakeIndex.hs +3/−27
• src/HaskellWorks/Data/Json/Internal/PartialIndex.hs +62/−0
• src/HaskellWorks/Data/Json/Internal/ToBalancedParens64.hs +28/−0
• src/HaskellWorks/Data/Json/Internal/ToInterestBits64.hs +31/−0
• src/HaskellWorks/Data/Json/Internal/Token.hs +5/−0
• src/HaskellWorks/Data/Json/Internal/Token/Tokenize.hs +165/−0
• src/HaskellWorks/Data/Json/Internal/Token/Types.hs +15/−0
• src/HaskellWorks/Data/Json/Internal/Value.hs +63/−0
• src/HaskellWorks/Data/Json/Internal/Words.hs +3/−0
• src/HaskellWorks/Data/Json/LightJson.hs +1/−1
• src/HaskellWorks/Data/Json/Load.hs +5/−5
• src/HaskellWorks/Data/Json/LoadCursor.hs +6/−7
• src/HaskellWorks/Data/Json/PartialValue.hs +2/−2
• src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +0/−50
• src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs +0/−23
• src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs +0/−62
• src/HaskellWorks/Data/Json/Succinct/Cursor/Token.hs +0/−24
• src/HaskellWorks/Data/Json/Succinct/Index.hs +0/−61
• src/HaskellWorks/Data/Json/Succinct/PartialIndex.hs +0/−62
• src/HaskellWorks/Data/Json/Token.hs +0/−6
• src/HaskellWorks/Data/Json/Token/Tokenize.hs +0/−165
• src/HaskellWorks/Data/Json/Token/Types.hs +0/−15
• src/HaskellWorks/Data/Json/Type.hs +1/−3
• src/HaskellWorks/Data/Json/Value.hs +2/−2
• src/HaskellWorks/Data/Json/Value/Internal.hs +0/−63
• test/HaskellWorks/Data/Json/CorpusSpec.hs +4/−5
• test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs +6/−6
• test/HaskellWorks/Data/Json/Succinct/Cursor/InterestBitsSpec.hs +21/−22
• test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +4/−55
• test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +2/−2
• test/HaskellWorks/Data/Json/TypeSpec.hs +1/−42
• test/HaskellWorks/Data/Json/ValueSpec.hs +2/−15

@@ -55,7 +55,7 @@           82 import           HaskellWorks.Diagnostics           83 import           System.IO.MMap           88 (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "../data/78mbs.json" ReadOnly Nothing-         276 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+         276 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))  ## Examples @@ -70,7 +70,7 @@     import Data.Word     import System.CPUTime     (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing-    cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+    cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))     let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size     x <- measure $ jsonBsToInterestBs bs     let !y = BS.concat (unescape' "" [bs])@@ -111,9 +111,8 @@ let fc = TC.firstChild let ns = TC.nextSibling let pn = TC.parent-let cd = TC.depth let ss = TC.subtreeSize-let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)) cursor fc cursor (fc >=> ns) cursor

@@ -0,0 +1,13 @@+module App.Commands where++import App.Commands.CreateIndex+import Data.Semigroup           ((<>))+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+  <>  commandGroup "Commands:"+  <>  cmdCreateIndex

@@ -0,0 +1,51 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.CreateIndex+  ( cmdCreateIndex+  ) where++import App.Commands.Types+import Control.Lens+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++runCreateIndex :: CreateIndexOptions -> IO ()+runCreateIndex opts = do+  let filePath = opts ^. L.filePath+  (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++optsCreateIndex :: Parser CreateIndexOptions+optsCreateIndex = CreateIndexOptions+  <$> strOption+        (   long "input"+        <>  short 'i'+        <>  help "Input JSON file"+        <>  metavar "STRING"+        )++cmdCreateIndex :: Mod CommandFields (IO ())+cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex

@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.Demo+  ( cmdDemo+  ) where++import App.Commands.Types+import Control.Lens+import Control.Monad+import Data.Semigroup                    ((<>))+import HaskellWorks.Data.Json.LightJson+import HaskellWorks.Data.Json.LoadCursor+import HaskellWorks.Data.Micro+import HaskellWorks.Data.MQuery+import Options.Applicative               hiding (columns)++import qualified App.Lens   as L+import qualified Data.DList as DL++runDemo :: DemoOptions -> IO ()+runDemo opts = do+  !cursor <- loadJsonWithCsPoppyIndex (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++optsDemo :: Parser DemoOptions+optsDemo = DemoOptions+  <$> strOption+        (   long "input"+        <>  short 'i'+        <>  help "Input DSV file"+        <>  metavar "STRING"+        )++cmdDemo :: Mod CommandFields (IO ())+cmdDemo = command "create-index"  $ flip info idm $ runDemo <$> optsDemo

@@ -0,0 +1,14 @@+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Types+  ( CreateIndexOptions(..)+  , DemoOptions(..)+  ) where++newtype CreateIndexOptions = CreateIndexOptions+  { _createIndexOptionsFilePath  :: FilePath+  } deriving (Eq, Show)++newtype DemoOptions = DemoOptions+  { _demoOptionsFilePath  :: FilePath+  } deriving (Eq, Show)

@@ -0,0 +1,27 @@+module App.IO where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import System.IO                    (Handle)++import qualified Data.ByteString.Lazy as LBS+import qualified System.IO            as IO++openOutputFile :: MonadResource m => FilePath -> Maybe Int -> m (ReleaseKey, Handle)+openOutputFile "-" _ = allocate (return IO.stdout) (const (return ()))+openOutputFile filePath maybeBufferSize = allocate open close+  where open  = do+          handle <- IO.openFile filePath IO.WriteMode+          forM_ maybeBufferSize $ \bufferSize ->+            liftIO $ IO.hSetBuffering handle (IO.BlockBuffering (Just bufferSize))+          return handle+        close = IO.hClose++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

@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE TemplateHaskell        #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeSynonymInstances   #-}++module App.Lens where++import App.Commands.Types+import Control.Lens++makeFields ''CreateIndexOptions+makeFields ''DemoOptions

@@ -1,53 +1,11 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}- module Main where +import App.Commands import Control.Monad-import Data.Function-import Data.Word-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.LightJson-import HaskellWorks.Data.Json.LoadCursor-import HaskellWorks.Data.Micro-import HaskellWorks.Data.MQuery--import qualified Data.ByteString      as BS-import qualified Data.DList           as DL-import qualified Data.Vector.Storable as DVS--readJson :: String -> IO (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))-readJson path = do-  bs <- BS.readFile path-  print ("Read file" :: String)-  let !cursor = fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))-  print ("Created cursor" :: String)-  return cursor---- exploreSiblings :: BalancedParens b => b -> Count -> ([Count] -> [Count])--- exploreSiblings b c = case nextSibling b c of---   Just d -> (d:) . explore b d---   Nothing -> id------ exploreChildren :: BalancedParens b => b -> Count -> ([Count] -> [Count])--- exploreChildren b c = case firstChild b c of---   Just d -> (d:) . explore b d---   Nothing -> id------ explore :: BalancedParens b => b -> Count -> ([Count] -> [Count])--- explore b c = exploreSiblings b c . exploreChildren b c+import Data.Semigroup      ((<>))+import Options.Applicative  main :: IO ()-main = do-  !cursor <- loadJsonWithCsPoppyIndex "../data/78mb.json"-  -- let ranks = explore (balancedParens cursor) (cursorRank cursor)-  -- putStrLn $ "Ranks: " ++ show (length (ranks []))--  let !json = lightJsonAt cursor-  let q = MQuery (DL.singleton json)--  putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & count+main = join $ customExecParser+  (prefs $ showHelpOnEmpty <> showHelpOnError)+  (info (commands <**> helper) idm)

@@ -9,7 +9,6 @@ import Data.Word import Foreign import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.FromByteString import HaskellWorks.Data.Json.Cursor import HaskellWorks.Data.Json.Internal.Blank@@ -27,8 +26,8 @@   let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size   return bs -loadJson :: BS.ByteString -> JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))-loadJson bs = fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+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

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           hw-json-version:        0.8.1.0+version:        0.9.0.0 synopsis:       Memory efficient JSON parser description:    Memory efficient JSON parser. Please see README.md category:       Data@@ -51,14 +51,14 @@     , 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.11+    , 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.6+    , containers        >= 0.5        && < 0.7     , dlist             >= 0.8        && < 0.9     , hw-mquery         >= 0.1        && < 0.2     , hw-parser         >= 0.1        && < 0.2@@ -71,34 +71,35 @@     cpp-options: -DBMI2_ENABLED   exposed-modules:       HaskellWorks.Data.Json-      HaskellWorks.Data.Json.CharLike       HaskellWorks.Data.Json.Cursor       HaskellWorks.Data.Json.DecodeError       HaskellWorks.Data.Json.FromValue       HaskellWorks.Data.Json.Internal.Blank+      HaskellWorks.Data.Json.Internal.BlankedJson+      HaskellWorks.Data.Json.Internal.CharLike+      HaskellWorks.Data.Json.Internal.Cursor.Token+      HaskellWorks.Data.Json.Internal.IbBp+      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.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.LightJson       HaskellWorks.Data.Json.Load       HaskellWorks.Data.Json.LoadCursor       HaskellWorks.Data.Json.PartialValue-      HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens-      HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson-      HaskellWorks.Data.Json.Succinct.Cursor.InterestBits-      HaskellWorks.Data.Json.Succinct.Cursor.Token-      HaskellWorks.Data.Json.Succinct.Index-      HaskellWorks.Data.Json.Succinct.PartialIndex-      HaskellWorks.Data.Json.Token-      HaskellWorks.Data.Json.Token.Tokenize-      HaskellWorks.Data.Json.Token.Types       HaskellWorks.Data.Json.Type       HaskellWorks.Data.Json.Value-      HaskellWorks.Data.Json.Value.Internal   other-modules:       Paths_hw_json   default-language: Haskell2010 -executable hw-json-example+executable hw-json   main-is: Main.hs   hs-source-dirs:       app@@ -109,19 +110,30 @@     , 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.11+    , 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.5-    , dlist             >= 0.8        && < 0.9+    , criterion             >= 1.4        && < 1.6+    , dlist                 >= 0.8        && < 0.9     , hw-json-    , hw-mquery         >= 0.1        && < 0.2+    , hw-mquery             >= 0.1        && < 0.2+    , generic-lens          >= 1          && < 1.1+    , lens                  >= 4          && < 5+    , optparse-applicative  >= 0.14       && < 0.15+    , resourcet             >= 1.2        && < 1.3   if (flag(sse42))     ghc-options: -mbmi2   if (flag(bmi2)) && (impl(ghc >=8.4.1))     ghc-options: -mbmi2 -msse4.2     cpp-options: -DBMI2_ENABLED+  other-modules:+      App.Commands+      App.Commands.CreateIndex+      App.Commands.Demo+      App.Commands.Types+      App.IO+      App.Lens   default-language: Haskell2010  test-suite hw-json-test@@ -136,12 +148,12 @@     , 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.11+    , 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.6+    , containers        >= 0.5        && < 0.7     , hspec             >= 2.5        && < 2.6     , hw-json   if (flag(sse42))@@ -172,11 +184,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.11+    , 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.5+    , criterion         >= 1.4        && < 1.6     , directory         >= 1.3        && < 1.4     , hw-json   if (flag(sse42))

@@ -7,6 +7,5 @@     ( module X     ) where -import HaskellWorks.Data.Json.Token as X import HaskellWorks.Data.Json.Type  as X import HaskellWorks.Data.Json.Value as X

@@ -1,23 +0,0 @@-module HaskellWorks.Data.Json.CharLike where--import Data.Word-import Data.Word8-import HaskellWorks.Data.Json.Internal.Words--class JsonCharLike c where-  isLeadingDigit2 :: c -> Bool-  isQuotDbl :: c -> Bool-  isChar_t :: c -> Bool-  isChar_f :: c -> Bool-  isChar_n :: c -> Bool-  isBraceLeft :: c -> Bool-  isBracketLeft :: c -> Bool--instance JsonCharLike Word8 where-  isLeadingDigit2 = isLeadingDigit-  isQuotDbl       = (== _quotedbl)-  isChar_t        = (== _t)-  isChar_f        = (== _f)-  isChar_n        = (== _n)-  isBraceLeft     = (== _braceleft)-  isBracketLeft   = (== _bracketleft)

@@ -9,15 +9,12 @@   , jsonCursorPos   ) where -import Data.ByteString.Internal                            as BSI+import Data.ByteString.Internal                  as BSI import Data.String import Data.Word import Foreign.ForeignPtr-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.FromByteString import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson-import HaskellWorks.Data.Json.Succinct.Cursor.InterestBits import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1@@ -25,11 +22,11 @@ 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.Succinct.Cursor.BalancedParens as CBP+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@@ -39,53 +36,31 @@   }   deriving (Eq, Show) -instance  (FromBlankedJson (JsonInterestBits a), FromBlankedJson (CBP.JsonBalancedParens b))-          => FromByteString (JsonCursor BS.ByteString a b) where-  fromByteString bs   = JsonCursor+instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+  fromByteString bs = JsonCursor     { cursorText      = bs-    , interests       = getJsonInterestBits (fromBlankedJson blankedJson)-    , balancedParens  = CBP.getJsonBalancedParens (fromBlankedJson blankedJson)+    , interests       = ib+    , balancedParens  = BP.SimpleBalancedParens bp     , cursorRank      = 1     }-    where blankedJson :: BlankedJson-          blankedJson = fromByteString bs+    where J.IbBp ib bp = J.toIbBp bs -instance IsString (JsonCursor String (BitShown [Bool]) (BP.SimpleBalancedParens [Bool])) where-  fromString :: String -> JsonCursor String (BitShown [Bool]) (BP.SimpleBalancedParens [Bool])-  fromString s = JsonCursor-    { cursorText      = s+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-    , interests       = getJsonInterestBits (fromBlankedJson blankedJson)-    , balancedParens  = CBP.getJsonBalancedParens (fromBlankedJson blankedJson)     }-    where blankedJson :: BlankedJson-          blankedJson = fromByteString (BSC.pack s)--instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where-  fromString = fromByteString . BSC.pack--instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where-  fromString = fromByteString . BSC.pack--instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where-  fromString = fromByteString . BSC.pack+    where J.IbBp ib bp = J.toIbBp bs -instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+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 (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where-  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)--instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where-  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)--instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where-  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)--instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where+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

@@ -0,0 +1,24 @@++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

@@ -0,0 +1,23 @@+module HaskellWorks.Data.Json.Internal.CharLike where++import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Internal.Words++class JsonCharLike c where+  isLeadingDigit2 :: c -> Bool+  isQuotDbl :: c -> Bool+  isChar_t :: c -> Bool+  isChar_f :: c -> Bool+  isChar_n :: c -> Bool+  isBraceLeft :: c -> Bool+  isBracketLeft :: c -> Bool++instance JsonCharLike Word8 where+  isLeadingDigit2 = isLeadingDigit+  isQuotDbl       = (== _quotedbl)+  isChar_t        = (== _t)+  isChar_f        = (== _f)+  isChar_n        = (== _n)+  isBraceLeft     = (== _braceleft)+  isBracketLeft   = (== _bracketleft)

@@ -0,0 +1,24 @@++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,24 @@+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

@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++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 qualified Data.ByteString                  as BS+import qualified Data.List                        as L+import qualified HaskellWorks.Data.BalancedParens as BP++data JsonIndex+  = JsonIndexString BS.ByteString+  | JsonIndexNumber BS.ByteString+  | JsonIndexObject [(BS.ByteString, JsonIndex)]+  | JsonIndexArray [JsonIndex]+  | JsonIndexBool Bool+  | JsonIndexNull+  deriving (Eq, Show)++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)]+                                _                 -> []

@@ -5,7 +5,6 @@   ( blankedJsonToInterestBits   , byteStringToBits   , blankedJsonToBalancedParens-  , blankedJsonToBalancedParens2   , compressWordAsBit   , interestingWord8s   ) where@@ -57,29 +56,6 @@                     , BS.drop 8 ds                     ) -blankedJsonToBalancedParens :: [BS.ByteString] -> [Bool]-blankedJsonToBalancedParens (as) = case as of-    (bs:bss) -> blankedJsonToBalancedParens' bs bss []-    []       -> []--blankedJsonToBalancedParens' :: BS.ByteString -> [BS.ByteString] -> ([Bool] -> [Bool])-blankedJsonToBalancedParens' bs = case BS.uncons bs of-  Just (c, cs) -> do-    let t = case c of-          d | d == _braceleft     -> (True:)-          d | d == _braceright    -> (False:)-          d | d == _bracketleft   -> (True:)-          d | d == _bracketright  -> (False:)-          d | d == _parenleft     -> (True:)-          d | d == _parenright    -> (False:)-          d | d == _t             -> (True:) . (False:)-          d | d == _f             -> (True:) . (False:)-          d | d == _1             -> (True:) . (False:)-          d | d == _n             -> (True:) . (False:)-          _ -> id-    (t .) . blankedJsonToBalancedParens' cs-  Nothing -> const id- 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]@@ -105,11 +81,11 @@                     , BS.drop 8 xs                     ) -blankedJsonToBalancedParens2 :: [BS.ByteString] -> [BS.ByteString]-blankedJsonToBalancedParens2 as = case as of+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:blankedJsonToBalancedParens2 bss+    cs:blankedJsonToBalancedParens bss   [] -> []   where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))         gen (Just True  , bs) = Just (0xFF, (Nothing, bs))

@@ -0,0 +1,62 @@+{-# 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++data JsonPartialIndex+  = JsonPartialIndexString BS.ByteString+  | JsonPartialIndexNumber BS.ByteString+  | JsonPartialIndexObject [(BS.ByteString, JsonPartialIndex)]+  | JsonPartialIndexArray [JsonPartialIndex]+  | JsonPartialIndexBool Bool+  | JsonPartialIndexNull+  | JsonPartialIndexError String+  deriving (Eq, Show)++class JsonPartialIndexAt a where+  jsonPartialIndexAt :: a -> JsonPartialIndex++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where+  jsonPartialIndexAt k = case 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,28 @@+{-# 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)

@@ -0,0 +1,31 @@+{-# 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)

@@ -0,0 +1,5 @@+module HaskellWorks.Data.Json.Internal.Token+  ( module X+  ) where++import HaskellWorks.Data.Json.Internal.Token.Tokenize as X

@@ -0,0 +1,165 @@+{-# 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)

@@ -0,0 +1,15 @@+module HaskellWorks.Data.Json.Internal.Token.Types (JsonToken(..)) where++data JsonToken s d+  = JsonTokenBraceL+  | JsonTokenBraceR+  | JsonTokenBracketL+  | JsonTokenBracketR+  | JsonTokenComma+  | JsonTokenColon+  | JsonTokenWhitespace+  | JsonTokenString s+  | JsonTokenBoolean Bool+  | JsonTokenNumber d+  | JsonTokenNull+  deriving (Eq, Show)

@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TupleSections         #-}++module HaskellWorks.Data.Json.Internal.Value where++import Control.Applicative+import Data.Bits+import Data.Char+import Data.String+import HaskellWorks.Data.Parser as P++import qualified Data.Attoparsec.ByteString.Char8 as ABC+import qualified Data.Attoparsec.Types            as T++parseHexDigitNumeric :: P.Parser t u => T.Parser t Int+parseHexDigitNumeric = do+  c <- satisfyChar (\c -> '0' <= c && c <= '9')+  return $ ord c - ord '0'++parseHexDigitAlphaLower :: P.Parser t u => T.Parser t Int+parseHexDigitAlphaLower = do+  c <- satisfyChar (\c -> 'a' <= c && c <= 'z')+  return $ ord c - ord 'a' + 10++parseHexDigitAlphaUpper :: P.Parser t u => T.Parser t Int+parseHexDigitAlphaUpper = do+  c <- satisfyChar (\c -> 'A' <= c && c <= 'Z')+  return $ ord c - ord 'A' + 10++parseHexDigit :: P.Parser t u => T.Parser t Int+parseHexDigit = parseHexDigitNumeric <|> parseHexDigitAlphaLower <|> parseHexDigitAlphaUpper++parseJsonString :: (P.Parser t u, IsString t) => T.Parser t String+parseJsonString = do+  _ <- string "\""+  value <- many (verbatimChar <|> escapedChar <|> escapedCode)+  _ <- string "\""+  return value+  where+    verbatimChar  = satisfyChar (ABC.notInClass "\"\\") <?> "invalid string character"+    escapedChar   = do+      _ <- string "\\"+      (   char '"'  >> return '"'  ) <|>+        ( char 'b'  >> return '\b' ) <|>+        ( char 'n'  >> return '\n' ) <|>+        ( char 'f'  >> return '\f' ) <|>+        ( char 'r'  >> return '\r' ) <|>+        ( char 't'  >> return '\t' ) <|>+        ( char '\\' >> return '\\' ) <|>+        ( char '\'' >> return '\'' ) <|>+        ( char '/'  >> return '/'  )+    escapedCode   = do+      _ <- string "\\u"+      a <- parseHexDigit+      b <- parseHexDigit+      c <- parseHexDigit+      d <- parseHexDigit+      return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d

@@ -11,3 +11,6 @@  isAlphabetic :: Word8 -> Bool isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)++wIsJsonNumberDigit :: Word8 -> Bool+wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen

@@ -16,8 +16,8 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop import HaskellWorks.Data.Entry-import HaskellWorks.Data.Json.CharLike 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

@@ -25,9 +25,9 @@ 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.Succinct.Index-import HaskellWorks.Data.Json.Succinct.PartialIndex import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.RankSelect.Poppy512@@ -50,11 +50,11 @@ 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 (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+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 (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+  let !cursor = fromByteString bs :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))   putStrLn "Created cursor"   return cursor @@ -111,7 +111,7 @@  indexJson :: String -> IO () indexJson filename = do-  JsonCursor _ (BitShown ib) (SimpleBalancedParens bp) _ <- readJson filename+  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

@@ -18,12 +18,11 @@ 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.Succinct.Index+import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.RankSelect.Poppy512@@ -46,11 +45,11 @@ 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 (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+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 (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+  let !cursor = fromByteString bs :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))   putStrLn "Created cursor"   return cursor @@ -76,10 +75,10 @@   let jsonBp  = fromForeignRegion jsonBpFr  :: DVS.Vector Word64   return (jsonBS, jsonIb, jsonBp) -loadJsonWithIndex :: String -> IO (JsonCursor BSI.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+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 (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1+  let cursor = JsonCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1   return cursor  loadJsonWithPoppy512Index :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))@@ -103,7 +102,7 @@  indexJsonCursor :: String -> IO () indexJsonCursor filename = do-  JsonCursor _ (BitShown ib) (SimpleBalancedParens bp) _ <- readJson filename+  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

@@ -25,8 +25,8 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Entry import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Succinct.PartialIndex-import HaskellWorks.Data.Json.Value.Internal+import HaskellWorks.Data.Json.Internal.PartialIndex+import HaskellWorks.Data.Json.Internal.Value import HaskellWorks.Data.Micro import HaskellWorks.Data.Mini import HaskellWorks.Data.MQuery

@@ -1,50 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens-  ( JsonBalancedParens(..)-  , getJsonBalancedParens-  ) where--import Control.Applicative-import Data.Word-import HaskellWorks.Data.BalancedParens                   as BP-import HaskellWorks.Data.Json.Internal.MakeIndex-import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson--import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS--newtype JsonBalancedParens a = JsonBalancedParens a--getJsonBalancedParens :: JsonBalancedParens a -> a-getJsonBalancedParens (JsonBalancedParens a) = a--genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString)-genBitWordsForever bs = BS.uncons bs <|> Just (0, bs)-{-# INLINE genBitWordsForever #-}--instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens [Bool])) where-  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (blankedJsonToBalancedParens bj))--instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where-  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))-    where bpBS        = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj))-          newLen      = (BS.length bpBS + 7) `div` 8 * 8--instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where-  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))-    where bpBS        = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj))-          newLen      = (BS.length bpBS + 7) `div` 8 * 8--instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where-  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))-    where bpBS        = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj))-          newLen      = (BS.length bpBS + 7) `div` 8 * 8--instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where-  fromBlankedJson bj  = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))-    where bpBS        = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj))-          newLen      = (BS.length bpBS + 7) `div` 8 * 8

@@ -1,23 +0,0 @@--module HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson-  ( BlankedJson(..)-  , FromBlankedJson(..)-  , getBlankedJson-  ) where--import HaskellWorks.Data.ByteString-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Internal.Blank--import qualified Data.ByteString as BS--newtype BlankedJson = BlankedJson [BS.ByteString] deriving (Eq, Show)--getBlankedJson :: BlankedJson -> [BS.ByteString]-getBlankedJson (BlankedJson bs) = bs--class FromBlankedJson a where-  fromBlankedJson :: BlankedJson -> a--instance FromByteString BlankedJson where-  fromByteString bs = BlankedJson (blankJson (chunkedBy 4064 bs))

@@ -1,62 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Succinct.Cursor.InterestBits-  ( JsonInterestBits(..)-  , getJsonInterestBits-  ) where--import Control.Applicative-import Data.ByteString.Internal-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Internal.MakeIndex-import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson-import HaskellWorks.Data.RankSelect.Poppy512--import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS--newtype JsonInterestBits a = JsonInterestBits a--getJsonInterestBits :: JsonInterestBits a -> a-getJsonInterestBits (JsonInterestBits a) = a--blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString-blankedJsonBssToInterestBitsBs bss = BS.concat $ blankedJsonToInterestBits bss--genInterest :: ByteString -> Maybe (Word8, ByteString)-genInterest = BS.uncons--genInterestForever :: ByteString -> Maybe (Word8, ByteString)-genInterestForever bs = BS.uncons bs <|> Just (0, bs)--instance FromBlankedJson (JsonInterestBits (BitShown [Bool])) where-  fromBlankedJson = JsonInterestBits . fromByteString . BS.concat . blankedJsonToInterestBits . getBlankedJson--instance FromBlankedJson (JsonInterestBits (BitShown BS.ByteString)) where-  fromBlankedJson = JsonInterestBits . BitShown . BS.unfoldr genInterest . blankedJsonBssToInterestBitsBs . getBlankedJson--instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word8))) where-  fromBlankedJson = JsonInterestBits . BitShown . DVS.unfoldr genInterest . blankedJsonBssToInterestBitsBs . getBlankedJson--instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word16))) where-  fromBlankedJson bj = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))-    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)-          newLen        = (BS.length interestBS + 1) `div` 2 * 2--instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word32))) where-  fromBlankedJson bj = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))-    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)-          newLen        = (BS.length interestBS + 3) `div` 4 * 4--instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word64))) where-  fromBlankedJson bj    = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))-    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)-          newLen        = (BS.length interestBS + 7) `div` 8 * 8--instance FromBlankedJson (JsonInterestBits Poppy512) where-  fromBlankedJson = JsonInterestBits . makePoppy512 . bitShown . getJsonInterestBits . fromBlankedJson

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

@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Succinct.Index where--import Control.Arrow-import Control.Monad-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.CharLike-import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.DecodeError-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 JsonIndex-  = JsonIndexString BS.ByteString-  | JsonIndexNumber BS.ByteString-  | JsonIndexObject [(BS.ByteString, JsonIndex)]-  | JsonIndexArray [JsonIndex]-  | JsonIndexBool Bool-  | JsonIndexNull-  deriving (Eq, Show)--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,62 +0,0 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}--module HaskellWorks.Data.Json.Succinct.PartialIndex where--import Control.Arrow-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.CharLike-import HaskellWorks.Data.Json.Cursor-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 JsonPartialIndex-  = JsonPartialIndexString BS.ByteString-  | JsonPartialIndexNumber BS.ByteString-  | JsonPartialIndexObject [(BS.ByteString, JsonPartialIndex)]-  | JsonPartialIndexArray [JsonPartialIndex]-  | JsonPartialIndexBool Bool-  | JsonPartialIndexNull-  | JsonPartialIndexError String-  deriving (Eq, Show)--class JsonPartialIndexAt a where-  jsonPartialIndexAt :: a -> JsonPartialIndex--instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where-  jsonPartialIndexAt k = case 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)]-                                _                        -> []

@@ -1,6 +0,0 @@-module HaskellWorks.Data.Json.Token-  ( module X-  ) where--import HaskellWorks.Data.Json.Token.Types     as X-import HaskellWorks.Data.Json.Token.Tokenize  as X

@@ -1,165 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeSynonymInstances  #-}--module HaskellWorks.Data.Json.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.Token.Types-import HaskellWorks.Data.Parser           as P--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--hexDigitNumeric :: P.Parser t u => T.Parser t Int-hexDigitNumeric = do-  c <- satisfyChar (\c -> '0' <= c && c <= '9')-  return $ ord c - ord '0'--hexDigitAlphaLower :: P.Parser t u => T.Parser t Int-hexDigitAlphaLower = do-  c <- satisfyChar (\c -> 'a' <= c && c <= 'z')-  return $ ord c - ord 'a' + 10--hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int-hexDigitAlphaUpper = do-  c <- 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 = string "{" >> return JsonTokenBraceL-  parseJsonTokenBraceR = string "}" >> return JsonTokenBraceR-  parseJsonTokenBracketL = string "[" >> return JsonTokenBracketL-  parseJsonTokenBracketR = string "]" >> return JsonTokenBracketR-  parseJsonTokenComma = string "," >> return JsonTokenComma-  parseJsonTokenColon = string ":" >> return JsonTokenColon-  parseJsonTokenNull = string "null" >> return JsonTokenNull-  parseJsonTokenDouble = JsonTokenNumber <$> rational--  parseJsonTokenString = do-    _ <- string "\""-    value <- many (verbatimChar <|> escapedChar <|> escapedCode)-    _ <- string "\""-    return $ JsonTokenString value-    where-      verbatimChar  = satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"-      escapedChar   = do-        _ <- string "\\"-        (   char '"'  >> return '"'  ) <|>-          ( char 'b'  >> return '\b' ) <|>-          ( char 'n'  >> return '\n' ) <|>-          ( char 'f'  >> return '\f' ) <|>-          ( char 'r'  >> return '\r' ) <|>-          ( char 't'  >> return '\t' ) <|>-          ( char '\\' >> return '\\' ) <|>-          ( char '\'' >> return '\'' ) <|>-          ( char '/'  >> return '/'  )-      escapedCode   = do-        _ <- 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 [string " ", string "\t", string "\n", string "\r"]-    return JsonTokenWhitespace--  parseJsonTokenBoolean = true <|> false-    where-      true  = string "true"   >> return (JsonTokenBoolean True)-      false = string "false"  >> return (JsonTokenBoolean False)--instance ParseJson BS.ByteString BS.ByteString Double where-  parseJsonTokenBraceL = string "{" >> return JsonTokenBraceL-  parseJsonTokenBraceR = string "}" >> return JsonTokenBraceR-  parseJsonTokenBracketL = string "[" >> return JsonTokenBracketL-  parseJsonTokenBracketR = string "]" >> return JsonTokenBracketR-  parseJsonTokenComma = string "," >> return JsonTokenComma-  parseJsonTokenColon = string ":" >> return JsonTokenColon-  parseJsonTokenNull = string "null" >> return JsonTokenNull-  parseJsonTokenDouble = JsonTokenNumber <$> rational--  parseJsonTokenString = do-    _ <- string "\""-    value <- many (verbatimChar <|> escapedChar <|> escapedCode)-    _ <- string "\""-    return $ JsonTokenString $ BS.pack value-    where-      word :: Word8 -> T.Parser BS.ByteString Word8-      word w = satisfy (== w)-      verbatimChar :: T.Parser BS.ByteString Word8-      verbatimChar  = satisfy (\w -> w /= _quotedbl && w /= _backslash) -- <?> "invalid string character"-      escapedChar :: T.Parser BS.ByteString Word8-      escapedChar   = do-        _ <- 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-        _ <- 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 [string " ", string "\t", string "\n", string "\r"]-    return JsonTokenWhitespace--  parseJsonTokenBoolean = true <|> false-    where-      true  = string "true"   >> return (JsonTokenBoolean True)-      false = string "false"  >> return (JsonTokenBoolean False)

@@ -1,15 +0,0 @@-module HaskellWorks.Data.Json.Token.Types (JsonToken(..)) where--data JsonToken s d-  = JsonTokenBraceL-  | JsonTokenBraceR-  | JsonTokenBracketL-  | JsonTokenBracketR-  | JsonTokenComma-  | JsonTokenColon-  | JsonTokenWhitespace-  | JsonTokenString s-  | JsonTokenBoolean Bool-  | JsonTokenNumber d-  | JsonTokenNull-  deriving (Eq, Show)

@@ -12,6 +12,7 @@ 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@@ -22,9 +23,6 @@ import qualified HaskellWorks.Data.BalancedParens as BP  {-# ANN module ("HLint: Reduce duplication" :: String) #-}--wIsJsonNumberDigit :: Word8 -> Bool-wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen  data JsonType   = JsonTypeArray

@@ -7,8 +7,8 @@ module HaskellWorks.Data.Json.Value where  import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Succinct.Index-import HaskellWorks.Data.Json.Value.Internal+import HaskellWorks.Data.Json.Internal.Index+import HaskellWorks.Data.Json.Internal.Value  import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString                  as BS

@@ -1,63 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TupleSections         #-}--module HaskellWorks.Data.Json.Value.Internal where--import Control.Applicative-import Data.Bits-import Data.Char-import Data.String-import HaskellWorks.Data.Parser as P--import qualified Data.Attoparsec.ByteString.Char8 as ABC-import qualified Data.Attoparsec.Types            as T--parseHexDigitNumeric :: P.Parser t u => T.Parser t Int-parseHexDigitNumeric = do-  c <- satisfyChar (\c -> '0' <= c && c <= '9')-  return $ ord c - ord '0'--parseHexDigitAlphaLower :: P.Parser t u => T.Parser t Int-parseHexDigitAlphaLower = do-  c <- satisfyChar (\c -> 'a' <= c && c <= 'z')-  return $ ord c - ord 'a' + 10--parseHexDigitAlphaUpper :: P.Parser t u => T.Parser t Int-parseHexDigitAlphaUpper = do-  c <- satisfyChar (\c -> 'A' <= c && c <= 'Z')-  return $ ord c - ord 'A' + 10--parseHexDigit :: P.Parser t u => T.Parser t Int-parseHexDigit = parseHexDigitNumeric <|> parseHexDigitAlphaLower <|> parseHexDigitAlphaUpper--parseJsonString :: (P.Parser t u, IsString t) => T.Parser t String-parseJsonString = do-  _ <- string "\""-  value <- many (verbatimChar <|> escapedChar <|> escapedCode)-  _ <- string "\""-  return value-  where-    verbatimChar  = satisfyChar (ABC.notInClass "\"\\") <?> "invalid string character"-    escapedChar   = do-      _ <- string "\\"-      (   char '"'  >> return '"'  ) <|>-        ( char 'b'  >> return '\b' ) <|>-        ( char 'n'  >> return '\n' ) <|>-        ( char 'f'  >> return '\f' ) <|>-        ( char 'r'  >> return '\r' ) <|>-        ( char 't'  >> return '\t' ) <|>-        ( char '\\' >> return '\\' ) <|>-        ( char '\'' >> return '\'' ) <|>-        ( char '/'  >> return '/'  )-    escapedCode   = do-      _ <- string "\\u"-      a <- parseHexDigit-      b <- parseHexDigit-      c <- parseHexDigit-      d <- parseHexDigit-      return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d

@@ -14,7 +14,6 @@  import Data.Word import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.FromByteString import HaskellWorks.Data.Json.Cursor@@ -35,12 +34,12 @@     inInterestBalancedParensBS  <- BS.readFile "corpus/5000B.bp"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor     text `shouldBe` inJsonBS-    ib `shouldBe` BitShown inInterestBits+    ib `shouldBe` inInterestBits     bp `shouldBe` inInterestBalancedParens   it "issue-0001 loads properly" $ do     inJsonBS                    <- BS.readFile "corpus/issue-0001.json"@@ -48,10 +47,10 @@     inInterestBalancedParensBS  <- BS.readFile "corpus/issue-0001.bp"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+    let !cursor = fromByteString inJsonBS :: JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor     text `shouldBe` inJsonBS-    ib `shouldBe` BitShown inInterestBits+    ib `shouldBe` inInterestBits     bp `shouldBe` inInterestBalancedParens

@@ -6,20 +6,20 @@ import Data.String import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Json.Internal.MakeIndex-import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import Test.Hspec -import qualified Data.ByteString as BS+import qualified Data.ByteString                             as BS+import qualified HaskellWorks.Data.Json.Internal.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-    let blankedJson = BlankedJson ["[ [],", "[]]"]-    let bp = BitShown $ BS.concat (blankedJsonToBalancedParens2 (getBlankedJson blankedJson))+    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-    let blankedJson = BlankedJson ["[ [],", "[]]"]-    let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson blankedJson))+    let blankedJson = J.BlankedJson ["[ [],", "[]]"]+    let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens) (J.unBlankedJson blankedJson))     bp `shouldBe` fromString "11010000"

@@ -7,34 +7,33 @@ import Data.String import Data.Word import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson-import HaskellWorks.Data.Json.Succinct.Cursor.InterestBits import Test.Hspec -import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS+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 :: FromBlankedJson (JsonInterestBits a) => BS.ByteString -> a-interestBitsOf = getJsonInterestBits . fromBlankedJson . fromByteString+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-    (interestBitsOf ""            :: BitShown (DVS.Vector Word8)) `shouldBe` fromString ""-    (interestBitsOf "  \n \r \t " :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"-    (interestBitsOf "1234 "       :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "false "      :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "true "       :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "\"hello\" "  :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "\"\\\"\" "   :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "{ "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "} "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"-    (interestBitsOf "[ "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"-    (interestBitsOf "] "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"-    (interestBitsOf ": "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"-    (interestBitsOf ", "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"-    (interestBitsOf "{{}}"        :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "11000000"-    (interestBitsOf " { { } } "   :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "01010000 00000000"+    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"

@@ -16,14 +16,12 @@ import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Cursor-import HaskellWorks.Data.Json.Succinct.Cursor.Token-import HaskellWorks.Data.Json.Succinct.Index-import HaskellWorks.Data.Json.Token+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@@ -41,51 +39,13 @@ fc = TC.firstChild ns = TC.nextSibling pn = TC.parent--- cd = TC.depth ss = TC.subtreeSize  spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do-  -- describe "Cursor for [Bool]" $ do-  --   it "depth at top" $ do-  --     let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-  --     cd cursor `shouldBe` Just 1-  --   it "depth at first child of array" $ do-  --     let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-  --     (fc >=> cd) cursor `shouldBe` Just 2-  --   it "depth at second child of array" $ do-  --     let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-  --     (fc >=> ns >=> cd) cursor `shouldBe` Just 2-  --   it "depth at first child of object at second child of array" $ do-  --     let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-  --     (fc >=> ns >=> fc >=> cd) cursor `shouldBe` Just 3-  --   it "depth at first child of object at second child of array" $ do-  --     let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-  --     (fc >=> ns >=> fc >=> ns >=> cd) cursor `shouldBe` Just 3-  genSpec "DVS.Vector Word8"  (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))-  genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))-  genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  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)))-  it "Loads same Json consistentally from different backing vectors" $ do-    let cursor8   = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))-    let cursor16  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))-    let cursor32  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))-    let cursor64  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))-    cursorText cursor8 `shouldBe` cursorText cursor16-    cursorText cursor8 `shouldBe` cursorText cursor32-    cursorText cursor8 `shouldBe` cursorText cursor64-    let ic8   = bitShow $ interests cursor8-    let ic16  = bitShow $ interests cursor16-    let ic32  = bitShow $ interests cursor32-    let ic64  = bitShow $ interests cursor64-    ic16 `shouldBeginWith` ic8-    ic32 `shouldBeginWith` ic16-    ic64 `shouldBeginWith` ic32 -shouldBeginWith :: (Eq a, Show a) => [a] -> [a] -> IO ()-shouldBeginWith as bs = take (length bs) as `shouldBe` bs- genSpec :: forall t u.   ( Eq                t   , Show              t@@ -101,17 +61,6 @@   => String -> (JsonCursor BS.ByteString t u) -> SpecWith () genSpec t _ = do   describe ("Json cursor of type " ++ t) $ do-    -- let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)-    -- forJson "[null]" $ \cursor -> do-    --   it "depth at top"                   $ cd          cursor `shouldBe` Just 1-    --   it "depth at first child of array"  $ (fc >=> cd) cursor `shouldBe` Just 2-    -- forJson "[null, {\"field\": 1}]" $ \cursor -> do-    --   it "depth at second child of array" $ do-    --     (fc >=> ns >=> cd) cursor `shouldBe` Just 2-    --   it "depth at first child of object at second child of array" $ do-    --     (fc >=> ns >=> fc >=> cd) cursor `shouldBe` Just 3-    --   it "depth at first child of object at second child of array" $ do-    --     (fc >=> ns >=> fc >=> ns >=> cd) cursor `shouldBe` Just 3     describe "For empty json array" $ do       let cursor =  "[null]" :: JsonCursor BS.ByteString t u       it "can navigate down and forwards" $ do

@@ -2,8 +2,8 @@  module HaskellWorks.Data.Json.Token.TokenizeSpec (spec) where -import Data.ByteString                       as BS-import HaskellWorks.Data.Json.Token.Tokenize+import Data.ByteString                                (ByteString)+import HaskellWorks.Data.Json.Internal.Token.Tokenize import Test.Hspec  import qualified Data.Attoparsec.ByteString.Char8 as BC

@@ -16,7 +16,6 @@ import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Cursor@@ -40,47 +39,7 @@  spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do-  describe "Cursor for [Bool]" $ do-    it "initialises to beginning of empty object" $ do-      let cursor = "{}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeObject-    it "initialises to beginning of empty object preceded by spaces" $ do-      let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeObject-    it "initialises to beginning of number" $ do-      let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeNumber-    it "initialises to beginning of string" $ do-      let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeString-    it "initialises to beginning of array" $ do-      let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeArray-    it "initialises to beginning of boolean true" $ do-      let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeBool-    it "initialises to beginning of boolean false" $ do-      let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeBool-    it "initialises to beginning of null" $ do-      let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      jsonTypeAt cursor `shouldBe` Just JsonTypeNull-    it "cursor can navigate to first child of array" $ do-      let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull-    it "cursor can navigate to second child of array" $ do-      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject-    it "cursor can navigate to first child of object at second child of array" $ do-      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString-    it "cursor can navigate to first child of object at second child of array" $ do-      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])-      (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber-  genSpec "DVS.Vector Word8"  (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))-  genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))-  genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  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.

@@ -16,12 +16,11 @@ import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Cursor import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Succinct.Index+import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1@@ -39,14 +38,10 @@  fc = TC.firstChild ns = TC.nextSibling--- cd = TC.depth  spec :: Spec spec = describe "HaskellWorks.Data.Json.ValueSpec" $ do-  genSpec "DVS.Vector Word8"  (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))-  genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))-  genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))-  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  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)))  jsonValueVia  ::@@ -95,18 +90,10 @@     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 "depth at top"                   $ cd          cursor `shouldBe` Just 1-      -- it "depth at first child of array"  $ (fc >=> cd) cursor `shouldBe` Just 2     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 "depth at second child of array" $ do-      --   (fc >=> ns >=> cd) cursor `shouldBe` Just 2-      -- it "depth at first child of object at second child of array" $ do-      --   (fc >=> ns >=> fc >=> cd) cursor `shouldBe` Just 3-      -- it "depth at first child of object at second child of array" $ do-      --   (fc >=> ns >=> fc >=> ns >=> cd) cursor `shouldBe` Just 3     describe "For empty json array" $ do       let cursor =  "[]" :: JsonCursor BS.ByteString t u       it "can navigate down and forwards" $ do