hw-json 1.0.0.2 → 1.1.0.0

raw patch · 35 files changed

+572/−439 lines, 35 filesdep ~bits-extradep ~hedgehogdep ~hw-balancedparensPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bits-extra, hedgehog, hw-balancedparens, hw-prim

API changes (from Hackage documentation)

Files

• README.md +1/−1
• app/App/Commands/Demo.hs +5/−6
• bench/Main.hs +7/−7
• hw-json.cabal +37/−34
• src/HaskellWorks/Data/Json.hs +0/−5
• src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs +7/−6
• src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs +18/−21
• src/HaskellWorks/Data/Json/Backend/Simple/Value.hs +6/−7
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs +3/−164
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs +21/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs +50/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs +20/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs +11/−0
• src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs +20/−22
• src/HaskellWorks/Data/Json/Backend/Standard/Index.hs +10/−6
• src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs +17/−25
• src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs +3/−23
• src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs +12/−14
• src/HaskellWorks/Data/Json/FromValue.hs +18/−10
• src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs +2/−2
• src/HaskellWorks/Data/Json/Internal/Index.hs +40/−2
• src/HaskellWorks/Data/Json/Internal/Orphans.hs +11/−0
• src/HaskellWorks/Data/Json/Internal/PartialIndex.hs +52/−1
• src/HaskellWorks/Data/Json/Internal/Slurp.hs +9/−3
• src/HaskellWorks/Data/Json/LightJson.hs +57/−10
• src/HaskellWorks/Data/Json/PartialValue.hs +48/−25
• src/HaskellWorks/Data/Json/Query.hs +8/−7
• src/HaskellWorks/Data/Json/Type.hs +46/−1
• src/HaskellWorks/Data/Json/Value.hs +8/−5
• test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs +2/−3
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs +3/−9
• test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs +3/−3
• test/HaskellWorks/Data/Json/CorpusSpec.hs +4/−4
• test/HaskellWorks/Data/Json/TypeSpec.hs +6/−6
• test/HaskellWorks/Data/Json/ValueSpec.hs +7/−7

@@ -80,7 +80,7 @@ import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.RankSelect.CsPoppy import System.IO.MMap  import qualified Data.ByteString                                as BS

@@ -12,11 +12,10 @@ import Control.Monad import Control.Monad.ST import Data.Generics.Product.Any-import Data.Semigroup                                      ((<>))+import Data.Semigroup                                         ((<>)) import Data.Word import Foreign.ForeignPtr-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.Json.Query@@ -24,7 +23,7 @@ import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.Vector.AsVector8-import Options.Applicative                                 hiding (columns)+import Options.Applicative                                    hiding (columns)  import qualified App.Commands.Types                         as Z import qualified Data.ByteString                            as BS@@ -33,6 +32,7 @@ import qualified Data.DList                                 as DL import qualified Data.Vector.Storable                       as DVS import qualified Data.Vector.Storable.Mutable               as DVSM+import qualified HaskellWorks.Data.BalancedParens.RangeMin  as RM import qualified HaskellWorks.Data.ByteString.Lazy          as LBS import qualified HaskellWorks.Data.Json.Simd.Index.Standard as S import qualified Options.Applicative                        as OA@@ -77,14 +77,13 @@       case S.makeStandardJsonIbBps (LBS.resegmentPadded 512 (LBS.fromStrict bs)) of         Right ibBps -> do           let (!ib, !bp) = constructUnzipN size ibBps-          let !cursor = JsonCursor bs (makeCsPoppy ib) (SimpleBalancedParens bp) 1+          let !cursor = GenericCursor bs (makeCsPoppy ib) (RM.mkRangeMin bp) 1           let !json = lightJsonAt cursor           let q = MQuery (DL.singleton json)            putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count         Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create semi-index: " <> show msg     m -> IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show m-  optsDemo :: Parser Z.DemoOptions optsDemo = Z.DemoOptions

@@ -6,6 +6,7 @@ import Control.Monad import Criterion.Main import Data.List+import Data.Semigroup                                             ((<>)) import Data.Word import Foreign import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank@@ -57,8 +58,8 @@   let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries   benchmarks <- forM files $ \file -> return     [ env (setupEnvJson file) $ \bs -> bgroup file-      [ bench "Run slow make cursor" (whnf SLOW.makeCursor bs)-      , bench "Run fast make cursor" (whnf FAST.makeCursor bs)+      [ bench "Run slow make cursor" (whnf SLOW.fromByteString bs)+      , bench "Run fast make cursor" (whnf FAST.fromByteString bs)       ]     ] @@ -66,9 +67,8 @@  main :: IO () main = do-  benchmarks <- mconcat <$> sequence-    [ makeBenchBlankJson-    , makeBenchJsonToInterestBits-    , makeBenchMakeCursor-    ]+  benchmarks <- fmap mconcat $ sequence $ mempty+    <> [makeBenchBlankJson]+    <> [makeBenchJsonToInterestBits]+    <> [makeBenchMakeCursor]   defaultMain benchmarks

@@ -1,7 +1,7 @@ cabal-version:  2.2  name:           hw-json-version:        1.0.0.2+version:        1.1.0.0 synopsis:       Memory efficient JSON parser description:    Memory efficient JSON parser. Please see README.md category:       Data@@ -28,35 +28,35 @@   location: https://github.com/haskell-works/hw-json  flag bmi2-  description: Enable bmi2 instruction set-  manual: False-  default: False+  description:  Enable bmi2 instruction set+  manual:       False+  default:      False  flag sse42-  description: Enable sse4.2 instruction set-  manual: False-  default: False+  description:  Enable sse4.2 instruction set+  manual:       False+  default:      False  common base                 { build-depends: base                 >= 4          && < 5      }  common ansi-wl-pprint       { build-depends: ansi-wl-pprint       >= 0.6.8.2    && < 0.7    } common array                { build-depends: array                >= 0.5        && < 0.6    } common attoparsec           { build-depends: attoparsec           >= 0.13       && < 0.14   }-common bits-extra           { build-depends: bits-extra           >= 0.0.1      && < 0.1    }+common bits-extra           { build-depends: bits-extra           >= 0.0.1.3    && < 0.1    } common bytestring           { build-depends: bytestring           >= 0.10.6     && < 0.11   } common criterion            { build-depends: criterion            >= 1.4        && < 1.6    } common directory            { build-depends: directory            >= 1.3        && < 1.4    } common dlist                { build-depends: dlist                >= 0.8        && < 0.9    } common generic-lens         { build-depends: generic-lens         >= 1.1.0.0    && < 1.2    }-common hedgehog             { build-depends: hedgehog             >= 0.5        && < 0.7    }+common hedgehog             { build-depends: hedgehog             >= 0.6        && < 1.1    } common hspec                { build-depends: hspec                >= 2.4        && < 3      }-common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.2.0.1    && < 0.3    }+common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.3.0.0    && < 0.4    } common hw-bits              { build-depends: hw-bits              >= 0.7.0.5    && < 0.8    } common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1.0.4    && < 0.2    } common hw-json-simd         { build-depends: hw-json-simd         >= 0.1.0.2    && < 0.2    } common hw-mquery            { build-depends: hw-mquery            >= 0.2.0.0    && < 0.3    } common hw-parser            { build-depends: hw-parser            >= 0.1        && < 0.2    }-common hw-prim              { build-depends: hw-prim              >= 0.6.2.21   && < 0.7    }+common hw-prim              { build-depends: hw-prim              >= 0.6.2.28   && < 0.7    } common hw-rankselect        { build-depends: hw-rankselect        >= 0.13       && < 0.14   } common hw-rankselect-base   { build-depends: hw-rankselect-base   >= 0.3.2.1    && < 0.4    } common hw-simd              { build-depends: hw-simd              >= 0.1.1.2    && < 0.2    }@@ -71,10 +71,10 @@ common semigroups   { if impl(ghc <  8    ) { build-depends: semigroups     >= 0.16     && < 0.19 } }  common config-  default-language: Haskell2010-  ghc-options: -Wall+  default-language:   Haskell2010+  ghc-options:        -Wall -O2 -msse4.2   if flag(sse42)-    ghc-options: -mbmi2+    ghc-options: -msse4.2   if flag(bmi2) && impl(ghc >= 8.4.1)     ghc-options: -mbmi2 -msse4.2     cpp-options: -DBMI2_ENABLED@@ -100,10 +100,9 @@           , text           , vector           , word8-  hs-source-dirs:   src-  ghc-options:      -O2 -msse4.2-  other-modules:    Paths_hw_json-  autogen-modules:  Paths_hw_json+  hs-source-dirs:       src+  other-modules:        Paths_hw_json+  autogen-modules:      Paths_hw_json   exposed-modules:       HaskellWorks.Data.Json       HaskellWorks.Data.Json.Backend.Simple.Cursor@@ -111,6 +110,10 @@       HaskellWorks.Data.Json.Backend.Simple.SemiIndex       HaskellWorks.Data.Json.Backend.Simple.Value       HaskellWorks.Data.Json.Backend.Standard.Cursor+      HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast+      HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+      HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow+      HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific       HaskellWorks.Data.Json.Backend.Standard.Fast       HaskellWorks.Data.Json.Backend.Standard.Index       HaskellWorks.Data.Json.Backend.Standard.Load.Cursor@@ -134,6 +137,7 @@       HaskellWorks.Data.Json.Internal.CharLike       HaskellWorks.Data.Json.Internal.Doc       HaskellWorks.Data.Json.Internal.Index+      HaskellWorks.Data.Json.Internal.Orphans       HaskellWorks.Data.Json.Internal.PartialIndex       HaskellWorks.Data.Json.Internal.Slurp       HaskellWorks.Data.Json.Internal.Token@@ -163,10 +167,10 @@           , optparse-applicative           , semigroups           , vector-  main-is:        Main.hs-  hs-source-dirs: app-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2-  build-depends:  hw-json+  main-is:            Main.hs+  hs-source-dirs:     app+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  build-depends:      hw-json   other-modules:       App.Commands       App.Commands.CreateIndex@@ -187,12 +191,12 @@           , hw-rankselect-base           , transformers           , vector-  type:           exitcode-stdio-1.0-  main-is:        Spec.hs-  build-depends:  hw-json-  hs-source-dirs: test-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N-  build-tools:    hspec-discover+  type:               exitcode-stdio-1.0+  main-is:            Spec.hs+  build-depends:      hw-json+  hs-source-dirs:     test+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  build-tools:        hspec-discover   other-modules:       HaskellWorks.Data.Json.Backend.Simple.CursorSpec       HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec@@ -214,9 +218,8 @@           , directory           , mmap           , semigroups-  type:           exitcode-stdio-1.0-  main-is:        Main.hs-  hs-source-dirs: bench-  ghc-options:    -O2 -msse4.2-  build-depends:  hw-json-  other-modules:  Paths_hw_json+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     bench+  build-depends:      hw-json+  other-modules:      Paths_hw_json

@@ -1,8 +1,3 @@--- |--- Copyright: 2016 John Ky--- License: MIT------ Json module HaskellWorks.Data.Json     ( module X     ) where

@@ -17,7 +17,7 @@ import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.TreeCursor import Prelude                                   hiding (drop) @@ -27,6 +27,7 @@ import qualified Data.Vector.Storable                            as DVS import qualified Foreign.ForeignPtr                              as F import qualified HaskellWorks.Data.BalancedParens                as BP+import qualified HaskellWorks.Data.BalancedParens.RangeMin       as RM import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as SI  data JsonCursor t v w = JsonCursor@@ -46,11 +47,11 @@     }     where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs -instance FromByteString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+instance FromByteString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where   fromByteString bs = JsonCursor     { cursorText      = bs-    , interests       = makePoppy512 ib-    , balancedParens  = BP.SimpleBalancedParens bp+    , interests       = makeCsPoppy ib+    , balancedParens  = RM.mkRangeMin (makeCsPoppy bp)     , cursorRank      = 1     }     where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs@@ -58,13 +59,13 @@ instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where   fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+instance FromForeignRegion (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where   fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size)  instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where   fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where+instance IsString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where   fromString = fromByteString . BSC.pack  instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where

@@ -2,37 +2,34 @@ {-# LANGUAGE TypeSynonymInstances #-}  module HaskellWorks.Data.Json.Backend.Simple.Fast-  ( makeCursor+  ( fromByteString+  , fromForeignRegion+  , fromString   ) where -import Data.Word import Foreign.ForeignPtr-import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Backend.Simple.Cursor-import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.RankSelect.CsPoppy  import qualified Data.ByteString                                       as BS import qualified Data.ByteString.Char8                                 as BSC import qualified Data.ByteString.Internal                              as BSI-import qualified Data.Vector.Storable                                  as DVS-import qualified HaskellWorks.Data.BalancedParens                      as BP+import qualified HaskellWorks.Data.BalancedParens.RangeMin             as RM+import qualified HaskellWorks.Data.FromForeignRegion                   as F import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp   as J import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp as J -class MakeCursor a where-  makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))--instance MakeCursor BS.ByteString where-  makeCursor bs = JsonCursor-    { cursorText      = bs-    , interests       = makePoppy512 ib-    , balancedParens  = BP.SimpleBalancedParens bp-    , cursorRank      = 1-    }-    where J.IbBp ib bp = J.toIbBp bs+fromByteString :: BS.ByteString -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)+fromByteString bs = JsonCursor+  { cursorText      = bs+  , interests       = makeCsPoppy ib+  , balancedParens  = RM.mkRangeMin (makeCsPoppy bp)+  , cursorRank      = 1+  }+  where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor String where-  makeCursor = makeCursor . BSC.pack+fromForeignRegion :: F.ForeignRegion -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)+fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance MakeCursor ForeignRegion where-  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)+fromString :: String -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)+fromString = fromByteString . BSC.pack

@@ -1,15 +1,14 @@ module HaskellWorks.Data.Json.Backend.Simple.Value where  import Data.Maybe-import Data.Word import HaskellWorks.Data.Json.Backend.Simple.Cursor import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.RankSelect.CsPoppy -import qualified Data.ByteString                  as BS-import qualified Data.Vector.Storable             as DVS-import qualified HaskellWorks.Data.BalancedParens as BP+import qualified Data.ByteString                           as BS+import qualified HaskellWorks.Data.BalancedParens          as BP+import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM  data JsonValue   = JsonValues JsonValues@@ -24,7 +23,7 @@   | JsonObject [(String, JsonValue)]   deriving (Eq, Show) -snippetPos :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> (Count, Count)+snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) snippetPos k = (kpa, kpz)   where kpa   = select1 kib kta + km         kpz   = select1 kib ktz - km@@ -38,6 +37,6 @@         ktz   = ksz `div` 2         km    = ksa `mod` 2 -snippet :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> BS.ByteString+snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt)   where kt    = cursorText k

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

@@ -0,0 +1,21 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast+  ( Cursor+  ) where++import Data.Word+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific+import HaskellWorks.Data.RankSelect.CsPoppy++import qualified Data.ByteString                           as BS+import qualified Data.Vector.Storable                      as DVS+import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM++data Fast++instance SpecificCursor Fast where+  type CursorOf Fast = Cursor++type Cursor = GenericCursor BS.ByteString CsPoppy (RM.RangeMin (DVS.Vector Word64))

@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}++module HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+  ( GenericCursor(..)+  , jsonCursorPos+  ) where++import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.TreeCursor+import Prelude                                   hiding (drop)++import qualified HaskellWorks.Data.BalancedParens as BP++data GenericCursor t v w = GenericCursor+  { cursorText     :: !t+  , interests      :: !v+  , balancedParens :: !w+  , cursorRank     :: !Count+  }+  deriving (Eq, Show)++instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where+  firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k)++  parent :: GenericCursor t v u -> Maybe (GenericCursor t v u)+  parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq++  depth :: GenericCursor t v u -> Maybe Count+  depth k = BP.depth (balancedParens k) (cursorRank k)++  subtreeSize :: GenericCursor t v u -> Maybe Count+  subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+  where ik  = interests k+        bpk = balancedParens k

@@ -0,0 +1,20 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow+  ( Cursor+  ) where++import Data.Word+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific++import qualified Data.ByteString                  as BS+import qualified Data.Vector.Storable             as DVS+import qualified HaskellWorks.Data.BalancedParens as BP++data Slow++instance SpecificCursor Slow where+  type CursorOf Slow = Cursor++type Cursor = GenericCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))

@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific+  ( SpecificCursor(..)+  , jsonCursorPos+  ) where++import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic++class SpecificCursor w where+  type CursorOf w

@@ -2,37 +2,35 @@ {-# LANGUAGE TypeSynonymInstances #-}  module HaskellWorks.Data.Json.Backend.Standard.Fast-  ( makeCursor+  ( fromByteString+  , fromForeignRegion+  , fromString   ) where -import Data.Word import Foreign.ForeignPtr-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Backend.Standard.Cursor-import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.RankSelect.CsPoppy  import qualified Data.ByteString                                       as BS import qualified Data.ByteString.Char8                                 as BSC import qualified Data.ByteString.Internal                              as BSI-import qualified Data.Vector.Storable                                  as DVS import qualified HaskellWorks.Data.BalancedParens                      as BP+import qualified HaskellWorks.Data.BalancedParens.RangeMin             as RM+import qualified HaskellWorks.Data.FromForeignRegion                   as F import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J -class MakeCursor a where-  makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))--instance MakeCursor BS.ByteString where-  makeCursor bs = JsonCursor-    { cursorText      = bs-    , interests       = makePoppy512 ib-    , balancedParens  = BP.SimpleBalancedParens bp-    , cursorRank      = 1-    }-    where J.IbBp ib bp = J.toIbBp bs--instance MakeCursor String where-  makeCursor = makeCursor . BSC.pack+fromByteString :: BS.ByteString -> Cursor+fromByteString bs = GenericCursor+  { cursorText      = bs+  , interests       = makeCsPoppy ib+  , balancedParens  = RM.mkRangeMin bp+  , cursorRank      = 1+  }+  where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor ForeignRegion where-  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)+fromForeignRegion :: F.ForeignRegion -> Cursor+fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) +fromString :: String -> Cursor+fromString = fromByteString . BSC.pack

@@ -1,19 +1,23 @@+{-# LANGUAGE BangPatterns #-}+ module HaskellWorks.Data.Json.Backend.Standard.Index   ( indexJson   ) where  import Data.Word import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import qualified Data.ByteString                                     as BS-import qualified Data.Vector.Storable                                as DVS-import qualified HaskellWorks.Data.ByteString                        as BS-import qualified HaskellWorks.Data.Json.Backend.Standard.Load.Cursor as L+import qualified Data.ByteString                              as BS+import qualified Data.Vector.Storable                         as DVS+import qualified HaskellWorks.Data.ByteString                 as BS+import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW  indexJson :: String -> IO () indexJson filename = do-  JsonCursor _ ib (SimpleBalancedParens bp) _ <- L.loadCursor filename+  bs <- BS.mmap filename+  -- We use the SLOW reference implementation because we are writing to a file and will never query.+  let GenericCursor _ !ib (SimpleBalancedParens !bp) _ = SLOW.fromByteString bs   let wib = DVS.unsafeCast ib :: DVS.Vector Word8   let wbp = DVS.unsafeCast bp :: DVS.Vector Word8   BS.writeFile (filename ++ ".ib.idx") (BS.toByteString wib)

@@ -3,51 +3,43 @@ module HaskellWorks.Data.Json.Backend.Standard.Load.Cursor   ( loadCursor   , loadCursorWithIndex-  , loadCursorWithPoppy512Index   , loadCursorWithCsPoppyIndex-  , loadCursorWithPoppy512Index2+  , loadCursorWithCsPoppyIndex2   ) where  import Data.Word import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Raw import HaskellWorks.Data.RankSelect.CsPoppy-import HaskellWorks.Data.RankSelect.Poppy512 -import qualified Data.ByteString                              as BS-import qualified Data.ByteString.Internal                     as BSI-import qualified Data.Vector.Storable                         as DVS-import qualified HaskellWorks.Data.ByteString                 as BS-import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW+import qualified Data.ByteString.Internal                            as BSI+import qualified Data.Vector.Storable                                as DVS+import qualified HaskellWorks.Data.ByteString                        as BS+import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast as FAST+import qualified HaskellWorks.Data.Json.Backend.Standard.Fast        as FAST -loadCursor :: String -> IO (JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+loadCursor :: String -> IO FAST.Cursor loadCursor path = do   bs <- BS.mmap path-  let !cursor = SLOW.makeCursor bs+  let !cursor = FAST.fromByteString bs   return cursor -loadCursorWithIndex :: String -> IO (JsonCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithIndex :: String -> IO (GenericCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) loadCursorWithIndex filename = do   (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1-  return cursor--loadCursorWithPoppy512Index :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))-loadCursorWithPoppy512Index filename = do-  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1+  let cursor = GenericCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1   return cursor -loadCursorWithCsPoppyIndex :: String -> IO (JsonCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64)))+loadCursorWithCsPoppyIndex :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64))) loadCursorWithCsPoppyIndex filename = do   (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1+  let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1   return cursor -loadCursorWithPoppy512Index2 :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512))-loadCursorWithPoppy512Index2 filename = do+loadCursorWithCsPoppyIndex2 :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy))+loadCursorWithCsPoppyIndex2 filename = do   (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1-                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)+  let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens (makeCsPoppy jsonBp)) 1+                :: GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy)   return cursor

@@ -6,47 +6,27 @@   ( loadPartial   , loadPartialWithCsPoppyIndex   , loadPartialWithIndex-  , loadPartialWithPoppy512Index-  , loadPartialWithPoppy512Index2   ) where  import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Raw import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.PartialValue import HaskellWorks.Data.RankSelect.CsPoppy-import HaskellWorks.Data.RankSelect.Poppy512 -import qualified Data.ByteString.Internal as BSI- loadPartialWithIndex :: String -> IO JsonPartialValue loadPartialWithIndex filename = do   (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--loadPartialWithPoppy512Index :: String -> IO JsonPartialValue-loadPartialWithPoppy512Index filename = do-  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1+  let cursor = GenericCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1   let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)   return jsonResult  loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue loadPartialWithCsPoppyIndex filename = do   (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult--loadPartialWithPoppy512Index2 :: String -> IO JsonPartialValue-loadPartialWithPoppy512Index2 filename = do-  (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename-  let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1-                :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)+  let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1   let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)   return jsonResult 

@@ -2,26 +2,24 @@ {-# LANGUAGE TypeSynonymInstances #-}  module HaskellWorks.Data.Json.Backend.Standard.Slow-  ( makeCursor+  ( fromByteString+  , fromForeignRegion+  , fromString   ) where -import Data.Word import Foreign.ForeignPtr-import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow  import qualified Data.ByteString                                       as BS import qualified Data.ByteString.Char8                                 as BSC import qualified Data.ByteString.Internal                              as BSI-import qualified Data.Vector.Storable                                  as DVS import qualified HaskellWorks.Data.BalancedParens                      as BP+import qualified HaskellWorks.Data.FromForeignRegion                   as F import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J -class MakeCursor a where-  makeCursor :: a -> JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))--instance MakeCursor BS.ByteString where-  makeCursor bs = JsonCursor+fromByteString :: BS.ByteString -> Cursor+fromByteString bs = GenericCursor     { cursorText      = bs     , interests       = ib     , balancedParens  = BP.SimpleBalancedParens bp@@ -29,8 +27,8 @@     }     where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor String where-  makeCursor = makeCursor . BSC.pack+fromForeignRegion :: F.ForeignRegion -> Cursor+fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance MakeCursor ForeignRegion where-  makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size)+fromString :: String -> Cursor+fromString = fromByteString . BSC.pack

@@ -3,9 +3,12 @@  module HaskellWorks.Data.Json.FromValue where +import Data.Text                          (Text) import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Value +import qualified Data.Text as T+ class FromJsonValue a where   fromJsonValue :: JsonValue -> Either DecodeError a @@ -14,28 +17,33 @@  instance FromJsonValue String where   fromJsonValue v = case v of-    JsonString r  -> Right r-    _             -> Left (DecodeError "Not a string")+    JsonString r -> Right (T.unpack r)+    _            -> Left (DecodeError "Not a string") +instance FromJsonValue Text where+  fromJsonValue v = case v of+    JsonString r -> Right r+    _            -> Left (DecodeError "Not a string")+ instance FromJsonValue Int where   fromJsonValue v = case v of-    JsonNumber r  -> Right (floor r)-    _             -> Left (DecodeError "Not an integer")+    JsonNumber r -> Right (floor r)+    _            -> Left (DecodeError "Not an integer")  instance FromJsonValue Double where   fromJsonValue v = case v of-    JsonNumber r  -> Right r-    _             -> Left (DecodeError "Not a double")+    JsonNumber r -> Right r+    _            -> Left (DecodeError "Not a double")  instance FromJsonValue Bool where   fromJsonValue v = case v of-    JsonBool r    -> Right r-    _             -> Left (DecodeError "Not a boolean")+    JsonBool r -> Right r+    _          -> Left (DecodeError "Not a boolean")  instance FromJsonValue a => FromJsonValue [a] where   fromJsonValue v = case v of-    JsonArray xs  -> mapM fromJsonValue xs-    _             -> Left (DecodeError "Not an array")+    JsonArray xs -> mapM fromJsonValue xs+    _            -> Left (DecodeError "Not an array")  instance (FromJsonValue a, FromJsonValue b) => FromJsonValue (a, b) where   fromJsonValue v = case v of

@@ -6,7 +6,7 @@ import Data.ByteString.Internal                                        as BSI import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank1@@ -15,7 +15,7 @@  import qualified Data.Attoparsec.ByteString.Char8 as ABC -jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe (JsonToken String Double)+jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => GenericCursor 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"

@@ -1,12 +1,27 @@+{-# LANGUAGE BangPatterns      #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}  module HaskellWorks.Data.Json.Internal.Index where +import Control.Arrow+import Control.Monad+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError-import Prelude                            hiding (drop)+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.ByteString                  as BS+import qualified Data.List                        as L+import qualified HaskellWorks.Data.BalancedParens as BP  data JsonIndex   = JsonIndexString BS.ByteString@@ -19,3 +34,26 @@  class JsonIndexAt a where   jsonIndexAt :: a -> Either DecodeError JsonIndex++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (GenericCursor 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)]+                                _                 -> []

@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module HaskellWorks.Data.Json.Internal.Orphans where++import Data.Text+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))++import qualified Data.Text as T++instance Pretty Text where+  pretty s = pretty (T.unpack s)

@@ -1,7 +1,33 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+ module HaskellWorks.Data.Json.Internal.PartialIndex where -import qualified Data.ByteString as BS+import Control.Arrow+import Control.Monad+import Data.String+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+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@@ -14,3 +40,28 @@  class JsonPartialIndexAt a where   jsonPartialIndexAt :: a -> JsonPartialIndex++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (GenericCursor 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 (GenericCursor 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,8 +1,13 @@ {-# LANGUAGE BangPatterns #-} -module HaskellWorks.Data.Json.Internal.Slurp where+module HaskellWorks.Data.Json.Internal.Slurp+  ( JsonState(..)+  , slurpText+  , slurpNumber+  ) where  import Data.String+import Data.Text import Data.Word import Data.Word8 import HaskellWorks.Data.Json.Internal.Word8@@ -11,6 +16,7 @@ import qualified Data.ByteString       as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.List             as L+import qualified Data.Text             as T  data JsonState   = Escaped@@ -19,8 +25,8 @@   | InNumber   | InIdent -slurpString :: BS.ByteString -> String-slurpString bs = L.unfoldr genString (InJson, BSC.unpack bs)+slurpText :: BS.ByteString -> Text+slurpText bs = T.pack $ L.unfoldr genString (InJson, BSC.unpack bs) -- TODO optimise   where genString :: (JsonState, String) -> Maybe (Char, (JsonState, String))         genString (InJson, ds) = case ds of           (e:es) | e == '"' -> genString  (InString , es)

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns          #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE InstanceSigs          #-}@@ -8,27 +9,44 @@ module HaskellWorks.Data.Json.LightJson where  import Control.Arrow+import Control.Monad import Data.String+import Data.Text                                              (Text)+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Internal.CharLike import HaskellWorks.Data.Json.Internal.Doc+import HaskellWorks.Data.Json.Internal.Slurp import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.AtLeastSize import HaskellWorks.Data.MQuery.Entry import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.MQuery.Mini import HaskellWorks.Data.MQuery.Row-import Prelude                              hiding (drop)+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.TreeCursor+import HaskellWorks.Data.Uncons+import Prelude                                                hiding (drop)+import Prelude                                                hiding (drop) import Text.PrettyPrint.ANSI.Leijen -import qualified Data.ByteString as BS+import qualified Data.ByteString                  as BS+import qualified Data.List                        as L+import qualified Data.Text                        as T+import qualified HaskellWorks.Data.BalancedParens as BP  data LightJson c-  = LightJsonString String+  = LightJsonString Text   | LightJsonNumber BS.ByteString-  | LightJsonObject [(String, c)]+  | LightJsonObject [(Text, c)]   | LightJsonArray [c]   | LightJsonBool Bool   | LightJsonNull-  | LightJsonError String+  | LightJsonError Text   deriving Show  instance Eq (LightJson c) where@@ -38,7 +56,7 @@   (==)  LightJsonNull       LightJsonNull      = True   (==)  _                   _                  = False -data LightJsonField c = LightJsonField String (LightJson c)+data LightJsonField c = LightJsonField Text (LightJson c)  class LightJsonAt a where   lightJsonAt :: a -> LightJson a@@ -55,8 +73,8 @@     LightJsonArray vs   -> hEncloseSep (text "[") (text "]") (text ",") ((pretty . lightJsonAt) `map` vs)     LightJsonBool w     -> red (text (show w))     LightJsonNull       -> text "null"-    LightJsonError s    -> text "<error " <> text s <> text ">"-    where toLightJsonField :: (String, LightJson c) -> LightJsonField c+    LightJsonError s    -> text "<error " <> text (T.unpack s) <> text ">"+    where toLightJsonField :: (Text, LightJson c) -> LightJsonField c           toLightJsonField (k, v) = LightJsonField k v  instance Pretty (Micro (LightJson c)) where@@ -68,11 +86,14 @@   pretty (Micro (LightJsonArray _  )) = text "[..]"   pretty (Micro (LightJsonBool w   )) = red (text (show w))   pretty (Micro  LightJsonNull      ) = text "null"-  pretty (Micro (LightJsonError s  )) = text "<error " <> text s <> text ">"+  pretty (Micro (LightJsonError s  )) = text "<error " <> text (T.unpack s) <> text ">"  instance Pretty (Micro (String, LightJson c)) where   pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) +instance Pretty (Micro (Text, LightJson c)) where+  pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv)+ instance LightJsonAt c => Pretty (Mini (LightJson c)) where   pretty mjpv = case mjpv of     Mini (LightJsonString s   ) -> dullgreen  (text (show s))@@ -88,13 +109,39 @@     Mini (LightJsonArray _    )                       -> text "[]"     Mini (LightJsonBool w     ) -> red (text (show w))     Mini  LightJsonNull         -> text "null"-    Mini (LightJsonError s    ) -> text "<error " <> text s <> text ">"+    Mini (LightJsonError s    ) -> text "<error " <> text (T.unpack s) <> text ">"  instance LightJsonAt c => Pretty (Mini (String, LightJson c)) where   pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) +instance LightJsonAt c => Pretty (Mini (Text, LightJson c)) where+  pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv)+ instance LightJsonAt c => Pretty (MQuery (LightJson c)) where   pretty = pretty . Row 120 . mQuery  instance LightJsonAt c => Pretty (MQuery (Entry String (LightJson c))) where   pretty (MQuery das) = pretty (Row 120 das)++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (GenericCursor BS.ByteString v w) where+  lightJsonAt k = case uncons remainder of+    Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber  (slurpNumber remainder)+    Just (!c, _) | isQuotDbl c       -> LightJsonString  (slurpText   remainder)+    Just (!c, _) | isChar_t c        -> LightJsonBool    True+    Just (!c, _) | isChar_f c        -> LightJsonBool    False+    Just (!c, _) | isChar_n c        -> LightJsonNull+    Just (!c, _) | isBraceLeft c     -> LightJsonObject (mapValuesFrom   (firstChild k))+    Just (!c, _) | isBracketLeft c   -> LightJsonArray  (arrayValuesFrom (firstChild k))+    Just _                           -> LightJsonError "Invalid Json Type"+    Nothing                          -> LightJsonError "End of data"+    where ik                = interests k+          bpk               = balancedParens k+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          remainder         = drop (toCount p) (cursorText k)+          arrayValuesFrom   = L.unfoldr (fmap (id &&& nextSibling))+          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField+          pairwise (a:b:rs) = (a, b) : pairwise rs+          pairwise _        = []+          asField (a, b)    = case lightJsonAt a of+                                LightJsonString s -> [(s, b)]+                                _                 -> []

@@ -10,6 +10,7 @@   , JsonPartialValueAt(..)   , asInteger   , asString+  , asText   , castAsInteger   , entry   , hasKey@@ -21,7 +22,12 @@   ) where  import Control.Arrow+import Data.String+import Data.Text                                              (Text)+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Doc+import HaskellWorks.Data.Json.Internal.Orphans                () import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.Internal.Value import HaskellWorks.Data.MQuery@@ -30,28 +36,34 @@ import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.MQuery.Mini import HaskellWorks.Data.MQuery.Row-import Text.PrettyPrint.ANSI.Leijen+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude                                                hiding (drop)+import Text.PrettyPrint.ANSI.Leijen                           hiding ((<$>))  import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString                  as BS import qualified Data.DList                       as DL+import qualified Data.Text                        as T+import qualified HaskellWorks.Data.BalancedParens as BP  data JsonPartialValue-  = JsonPartialString String+  = JsonPartialString Text   | JsonPartialNumber Double-  | JsonPartialObject [(String, JsonPartialValue)]+  | JsonPartialObject [(Text, JsonPartialValue)]   | JsonPartialArray [JsonPartialValue]   | JsonPartialBool Bool   | JsonPartialNull-  | JsonPartialError String+  | JsonPartialError Text   deriving (Eq, Show, Ord)  class JsonPartialValueAt a where   jsonPartialJsonValueAt :: a -> JsonPartialValue -data JsonPartialField = JsonPartialField String JsonPartialValue+data JsonPartialField = JsonPartialField Text JsonPartialValue -jsonPartialValueString :: JsonPartialValue -> String+jsonPartialValueString :: JsonPartialValue -> Text jsonPartialValueString pjv = case pjv of   JsonPartialString s -> s   _                   -> ""@@ -59,13 +71,13 @@ instance JsonPartialValueAt JsonPartialIndex where   jsonPartialJsonValueAt i = case i of     JsonPartialIndexString s  -> case ABC.parse parseJsonString s of-      ABC.Fail    {}  -> JsonPartialError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'")+      ABC.Fail    {}  -> JsonPartialError ("Invalid string: '" <> T.pack (show (BS.take 20 s)) <> "...'")       ABC.Partial _   -> JsonPartialError "Unexpected end of string"-      ABC.Done    _ r -> JsonPartialString r+      ABC.Done    _ r -> JsonPartialString (T.pack r) -- TODO optimise     JsonPartialIndexNumber s  -> case ABC.parse ABC.rational s of-      ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")+      ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'")       ABC.Partial f     -> case f " " of-        ABC.Fail    {}  -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")+        ABC.Fail    {}  -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'")         ABC.Partial _   -> JsonPartialError "Unexpected end of number"         ABC.Done    _ r -> JsonPartialNumber r       ABC.Done    _ r   -> JsonPartialNumber r@@ -73,13 +85,13 @@     JsonPartialIndexArray   es -> JsonPartialArray (map jsonPartialJsonValueAt es)     JsonPartialIndexBool    v  -> JsonPartialBool v     JsonPartialIndexNull       -> JsonPartialNull-    JsonPartialIndexError s    -> JsonPartialError s+    JsonPartialIndexError s    -> JsonPartialError (T.pack s) -- TODO optimise     where parseString bs = case ABC.parse parseJsonString bs of-            ABC.Fail    {}  -> JsonPartialError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'")+            ABC.Fail    {}  -> JsonPartialError ("Invalid field: '" <> T.pack (show (BS.take 20 bs)) <> "...'")             ABC.Partial _   -> JsonPartialError "Unexpected end of field"-            ABC.Done    _ s -> JsonPartialString s+            ABC.Done    _ s -> JsonPartialString (T.pack s) -- TODO optimise -toJsonPartialField :: (String, JsonPartialValue) -> JsonPartialField+toJsonPartialField :: (Text, JsonPartialValue) -> JsonPartialField toJsonPartialField (k, v) = JsonPartialField k v  instance Pretty JsonPartialField where@@ -94,7 +106,7 @@     JsonPartialArray vs   -> hEncloseSep (text "[") (text "]") (text ",") (pretty `map` vs)     JsonPartialBool w     -> red (text (show w))     JsonPartialNull       -> text "null"-    JsonPartialError s    -> text "<error " <> text s <> text ">"+    JsonPartialError s    -> text "<error " <> text (T.unpack s) <> text ">"  instance Pretty (Micro JsonPartialValue) where   pretty (Micro (JsonPartialString s )) = dullgreen (text (show s))@@ -105,11 +117,14 @@   pretty (Micro (JsonPartialArray _  )) = text "[..]"   pretty (Micro (JsonPartialBool w   )) = red (text (show w))   pretty (Micro  JsonPartialNull      ) = text "null"-  pretty (Micro (JsonPartialError s  )) = text "<error " <> text s <> text ">"+  pretty (Micro (JsonPartialError s  )) = text "<error " <> text (T.unpack s) <> text ">"  instance Pretty (Micro (String, JsonPartialValue)) where   pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) +instance Pretty (Micro (Text, JsonPartialValue)) where+  pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv)+ instance Pretty (Mini JsonPartialValue) where   pretty mjpv = case mjpv of     Mini (JsonPartialString s   ) -> dullgreen  (text (show s))@@ -125,18 +140,21 @@     Mini (JsonPartialArray _    )                       -> text "[]"     Mini (JsonPartialBool w     ) -> red (text (show w))     Mini  JsonPartialNull         -> text "null"-    Mini (JsonPartialError s    ) -> text "<error " <> text s <> text ">"+    Mini (JsonPartialError s    ) -> text "<error " <> text (T.unpack s) <> text ">" -instance Pretty (Mini (String, JsonPartialValue)) where+instance Pretty (Mini (Text, JsonPartialValue)) where   pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv)  instance Pretty (MQuery JsonPartialValue) where   pretty = pretty . Row 120 . mQuery -instance Pretty (MQuery (Entry String JsonPartialValue)) where+instance Pretty (MQuery (Entry Text JsonPartialValue)) where   pretty (MQuery das) = pretty (Row 120 das) -hasKV :: String -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue+instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (GenericCursor BS.ByteString v w) where+  jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt++hasKV :: Text -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue hasKV k v (JsonPartialObject xs) = if (k, v) `elem` xs then MQuery (DL.singleton (JsonPartialObject xs)) else MQuery DL.empty hasKV _ _  _                     = MQuery DL.empty @@ -145,13 +163,18 @@   JsonPartialArray es -> MQuery $ DL.fromList es   _                   -> MQuery   DL.empty -entry :: JsonPartialValue -> MQuery (Entry String JsonPartialValue)+entry :: JsonPartialValue -> MQuery (Entry Text JsonPartialValue) entry jpv = case jpv of   JsonPartialObject fs -> MQuery $ DL.fromList (uncurry Entry `map` fs)   _                    -> MQuery   DL.empty  asString :: JsonPartialValue -> MQuery String asString jpv = case jpv of+  JsonPartialString s -> MQuery $ DL.singleton (T.unpack s)+  _                   -> MQuery   DL.empty++asText :: JsonPartialValue -> MQuery Text+asText jpv = case jpv of   JsonPartialString s -> MQuery $ DL.singleton s   _                   -> MQuery   DL.empty @@ -162,20 +185,20 @@  castAsInteger :: JsonPartialValue -> MQuery Integer castAsInteger jpv = case jpv of-  JsonPartialString n -> MQuery $ DL.singleton (read n)+  JsonPartialString n -> MQuery $ DL.singleton (read (T.unpack n))   JsonPartialNumber n -> MQuery $ DL.singleton (floor n)   _                   -> MQuery   DL.empty -named :: String -> Entry String JsonPartialValue -> MQuery JsonPartialValue+named :: Text -> Entry Text JsonPartialValue -> MQuery JsonPartialValue named fieldName (Entry fieldName' jpv) | fieldName == fieldName'  = MQuery $ DL.singleton jpv named _         _                      = MQuery   DL.empty -jsonKeys :: JsonPartialValue -> [String]+jsonKeys :: JsonPartialValue -> [Text] jsonKeys jpv = case jpv of   JsonPartialObject fs -> fst `map` fs   _                    -> [] -hasKey :: String -> JsonPartialValue -> Bool+hasKey :: Text -> JsonPartialValue -> Bool hasKey fieldName jpv = fieldName `elem` jsonKeys jpv  jsonSize :: JsonPartialValue -> MQuery JsonPartialValue

@@ -8,7 +8,7 @@ module HaskellWorks.Data.Json.Query where  import Control.Arrow-import Data.String+import Data.Text                        (Text) import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.Entry@@ -16,18 +16,19 @@  import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.DList                       as DL+import qualified Data.Text                        as T  item :: LightJsonAt c => LightJson c -> MQuery (LightJson c) item jpv = case jpv of   LightJsonArray es -> MQuery $ DL.fromList (lightJsonAt `map` es)   _                 -> MQuery   DL.empty -entry :: LightJsonAt c => LightJson c -> MQuery (Entry String (LightJson c))+entry :: LightJsonAt c => LightJson c -> MQuery (Entry Text (LightJson c)) entry jpv = case jpv of   LightJsonObject fs -> MQuery $ DL.fromList ((uncurry Entry . second lightJsonAt) `map` fs)   _                  -> MQuery   DL.empty -asString :: LightJson c -> MQuery String+asString :: LightJson c -> MQuery Text asString jpv = case jpv of   LightJsonString s -> MQuery $ DL.singleton s   _                 -> MQuery   DL.empty@@ -50,20 +51,20 @@  castAsInteger :: LightJson c -> MQuery Integer castAsInteger jpv = case jpv of-  LightJsonString n -> MQuery $ DL.singleton (read n)+  LightJsonString n -> MQuery $ DL.singleton (read (T.unpack n)) -- TODO Optimise   LightJsonNumber _ -> asInteger jpv   _                 -> MQuery   DL.empty -named :: String -> Entry String (LightJson c) -> MQuery (LightJson c)+named :: Text -> Entry Text (LightJson c) -> MQuery (LightJson c) named fieldName (Entry fieldName' jpv) | fieldName == fieldName'  = MQuery $ DL.singleton jpv named _         _                      = MQuery   DL.empty -jsonKeys :: LightJson c -> [String]+jsonKeys :: LightJson c -> [Text] jsonKeys jpv = case jpv of   LightJsonObject fs -> fst `map` fs   _                  -> [] -hasKey :: String -> LightJson c -> Bool+hasKey :: Text -> LightJson c -> Bool hasKey fieldName jpv = fieldName `elem` jsonKeys jpv  jsonSize :: LightJson c -> MQuery Integer

@@ -7,9 +7,22 @@   , JsonTypeAt(..)   ) where +import Data.Char+import Data.String+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Drop+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic+import HaskellWorks.Data.Json.Internal.Word8 import HaskellWorks.Data.Positioning-import Prelude                       hiding (drop)+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude                                                hiding (drop) +import qualified Data.ByteString                  as BS+import qualified HaskellWorks.Data.BalancedParens as BP+ {-# ANN module ("HLint: Reduce duplication" :: String) #-}  data JsonType@@ -24,3 +37,35 @@ class JsonTypeAt a where   jsonTypeAtPosition :: Position -> a -> Maybe JsonType   jsonTypeAt :: a -> Maybe JsonType++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor String v w) where+  jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of+    c:_ | fromIntegral (ord c) == _bracketleft      -> Just JsonTypeArray+    c:_ | fromIntegral (ord c) == _f                -> Just JsonTypeBool+    c:_ | fromIntegral (ord c) == _t                -> Just JsonTypeBool+    c:_ | fromIntegral (ord c) == _n                -> Just JsonTypeNull+    c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber+    c:_ | fromIntegral (ord c) == _braceleft        -> Just JsonTypeObject+    c:_ | fromIntegral (ord c) == _quotedbl         -> Just JsonTypeString+    _                                               -> Nothing++  jsonTypeAt k = jsonTypeAtPosition p k+    where p   = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          ik  = interests k+          bpk = balancedParens k++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor BS.ByteString v w) where+  jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of+    Just (c, _) | c == _bracketleft    -> Just JsonTypeArray+    Just (c, _) | c == _f              -> Just JsonTypeBool+    Just (c, _) | c == _t              -> Just JsonTypeBool+    Just (c, _) | c == _n              -> Just JsonTypeNull+    Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber+    Just (c, _) | c == _braceleft      -> Just JsonTypeObject+    Just (c, _) | c == _quotedbl       -> Just JsonTypeString+    _                                  -> Nothing++  jsonTypeAt k = jsonTypeAtPosition p k+    where p   = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))+          ik  = interests k+          bpk = balancedParens k

@@ -6,17 +6,19 @@  module HaskellWorks.Data.Json.Value where +import Data.Text                             (Text) import HaskellWorks.Data.Json.DecodeError 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+import qualified Data.Text                        as T  data JsonValue-  = JsonString String+  = JsonString Text   | JsonNumber Double-  | JsonObject [(String, JsonValue)]+  | JsonObject [(Text, JsonValue)]   | JsonArray [JsonValue]   | JsonBool Bool   | JsonNull@@ -30,7 +32,7 @@     JsonIndexString  s  -> case ABC.parse parseJsonString s of       ABC.Fail    {}  -> Left (DecodeError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'"))       ABC.Partial _   -> Left (DecodeError "Unexpected end of string")-      ABC.Done    _ r -> Right (JsonString r)+      ABC.Done    _ r -> Right (JsonString (T.pack r)) -- TODO optimise     JsonIndexNumber  s  -> case ABC.parse ABC.rational s of       ABC.Fail    {}    -> Left (DecodeError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'"))       ABC.Partial f     -> case f " " of@@ -38,11 +40,12 @@         ABC.Partial _   -> Left (DecodeError "Unexpected end of number")         ABC.Done    _ r -> Right (JsonNumber r)       ABC.Done    _ r   -> Right (JsonNumber r)-    JsonIndexObject  fs -> JsonObject <$> mapM (\f -> (,) <$> parseString (fst f) <*> jsonValueAt (snd f)) fs+    JsonIndexObject  fs -> JsonObject <$> mapM (\f -> (,) <$> parseText (fst f) <*> jsonValueAt (snd f)) fs     JsonIndexArray   es -> JsonArray <$> mapM jsonValueAt es     JsonIndexBool    v  -> Right (JsonBool v)     JsonIndexNull       -> Right JsonNull-    where parseString bs = case ABC.parse parseJsonString bs of+    where parseText bs = T.pack <$> parseString bs -- TODO optimise+          parseString bs = case ABC.parse parseJsonString bs of             ABC.Fail    {}  -> Left (DecodeError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'"))             ABC.Partial _   -> Left (DecodeError "Unexpected end of field")             ABC.Done    _ s -> Right s

@@ -18,7 +18,6 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString                              as BS import qualified HaskellWorks.Data.Json.Backend.Simple.Cursor as Z import qualified HaskellWorks.Data.Json.Backend.Simple.Fast   as FAST import qualified HaskellWorks.Data.Json.Backend.Simple.Value  as V@@ -26,7 +25,7 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}  fc = TC.firstChild ns = TC.nextSibling@@ -35,7 +34,7 @@ spec = describe "HaskellWorks.Data.Json.Backend.Simple.CursorSpec" $ do   describe "Json cursor" $ do     describe "For sample Json" $ do-      let k = FAST.makeCursor ("[[11],[22]]" :: BS.ByteString)+      let k = FAST.fromByteString "[[11],[22]]"       -- [  [  1  1 ]  ,  [  2  2 ]  ]       -- (( ((      )) )( ((      )) ))       it "can navigate" $ requireTest $ do

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

@@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Internal.Token@@ -30,7 +30,7 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}  fc = TC.firstChild ns = TC.nextSibling@@ -47,7 +47,7 @@   , Rank1             u   , BalancedParens    u   , TestBit           u)-  => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith ()+  => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genTest t mkCursor = do   describe ("Json cursor of type " ++ t) $ do     describe "For empty json array" $ do

@@ -15,7 +15,7 @@ import Control.Monad.IO.Class import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.FromBitTextByteString-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec@@ -25,7 +25,7 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}  spec :: Spec spec = describe "HaskellWorks.Data.Json.Corpus" $ do@@ -35,7 +35,7 @@     inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/5000B.json.bp.idx"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = SLOW.makeCursor inJsonBS+    let !cursor = SLOW.fromByteString inJsonBS     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor@@ -48,7 +48,7 @@     inInterestBalancedParensBS  <- liftIO $ BS.readFile "corpus/issue-0001.json.bp.idx"     let inInterestBits            = fromBitTextByteString inInterestBitsBS     let inInterestBalancedParens  = fromBitTextByteString inInterestBalancedParensBS-    let !cursor = SLOW.makeCursor inJsonBS+    let !cursor = SLOW.fromByteString inJsonBS     let text                    = cursorText      cursor     let ib                      = interests       cursor     let SimpleBalancedParens bp = balancedParens  cursor

@@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Type import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1@@ -30,15 +30,15 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}  fc = TC.firstChild ns = TC.nextSibling  spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do-  genSpec "DVS.Vector Word64" SLOW.makeCursor-  genSpec "Poppy512"          FAST.makeCursor+  genSpec "DVS.Vector Word64" SLOW.fromString+  genSpec "CsPoppy"           FAST.fromString  genSpec :: forall t u.   ( Eq                t@@ -50,7 +50,7 @@   , Rank1             u   , BalancedParens    u   , TestBit           u)-  => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith ()+  => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genSpec t makeCursor = do   describe ("Json cursor of type " ++ t) $ do     let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))@@ -95,7 +95,7 @@                     \            \"dimensions\": [500, 600.01e-02, true, false, null] \                     \        } \                     \    } \-                    \}" :: JsonCursor BS.ByteString t u+                    \}" :: GenericCursor BS.ByteString t u       it "can navigate down and forwards" $ requireTest $ do         (                                                                      jsonTypeAt) cursor === Just JsonTypeObject         (fc                                                                >=> jsonTypeAt) cursor === Just JsonTypeString

@@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Json.Backend.Standard.Cursor+import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Value@@ -32,15 +32,15 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}  fc = TC.firstChild ns = TC.nextSibling  spec :: Spec spec = describe "HaskellWorks.Data.Json.ValueSpec" $ do-  genSpec "DVS.Vector Word64" SLOW.makeCursor-  genSpec "Poppy512"          FAST.makeCursor+  genSpec "DVS.Vector Word64" SLOW.fromString+  genSpec "CsPoppy"           FAST.fromString  jsonValueVia  ::   ( BalancedParens u@@ -48,7 +48,7 @@   , Rank1 u   , Select1 t   , TestBit u)-  => Maybe (JsonCursor BS.ByteString t u) -> Either DecodeError JsonValue+  => Maybe (GenericCursor BS.ByteString t u) -> Either DecodeError JsonValue jsonValueVia mk = case mk of   Just k  -> (jsonIndexAt >=> jsonValueAt) k   Nothing -> Left (DecodeError "No such element")@@ -63,7 +63,7 @@   , Rank1             u   , BalancedParens    u   , TestBit           u)-  => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith ()+  => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genSpec t makeCursor = do   describe ("Json cursor of type " ++ t) $ do     let forJson s f = describe ("of value " ++ show s) (f (makeCursor s))@@ -107,7 +107,7 @@                     \            \"dimensions\": [500, 600.01e-02, true, false, null] \                     \        } \                     \    } \-                    \}" :: JsonCursor BS.ByteString t u+                    \}" :: GenericCursor BS.ByteString t u       it "can navigate down and forwards" $ requireTest $ do         let array   = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue         let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue