hw-json (empty) → 0.0.0.1
raw patch · 27 files changed
+1466/−0 lines, 27 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed
Dependencies added: QuickCheck, attoparsec, base, bytestring, conduit, containers, criterion, hspec, hw-bits, hw-conduit, hw-diagnostics, hw-json, hw-parser, hw-prim, hw-rankselect, mmap, mono-traversable, parsec, resourcet, text, transformers, vector, word8
Files
- LICENSE +30/−0
- README.md +133/−0
- Setup.hs +2/−0
- app/Main.hs +50/−0
- bench/Main.hs +79/−0
- hw-json.cabal +118/−0
- src/HaskellWorks/Data/Json.hs +11/−0
- src/HaskellWorks/Data/Json/Extract.hs +45/−0
- src/HaskellWorks/Data/Json/Succinct.hs +5/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor.hs +8/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +51/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs +23/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs +66/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/FromJsonCursor.hs +33/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs +62/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +141/−0
- src/HaskellWorks/Data/Json/Succinct/Cursor/Token.hs +23/−0
- src/HaskellWorks/Data/Json/Token.hs +6/−0
- src/HaskellWorks/Data/Json/Token/Tokenize.hs +164/−0
- src/HaskellWorks/Data/Json/Token/Types.hs +15/−0
- src/HaskellWorks/Data/Json/Type.hs +16/−0
- src/HaskellWorks/Data/Json/Value.hs +17/−0
- test/HaskellWorks/Data/Json/Succinct/Cursor/InterestBitsSpec.hs +39/−0
- test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +251/−0
- test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +49/−0
- test/Spec.hs +1/−0
- test/data/sample.json +28/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,133 @@+# hw-json+[](https://circleci.com/gh/haskell-works/hw-json/tree/v0.0-branch)++Conduits for tokenizing streams.++`hw-json` is a succinct JSON parsing library. It uses succinct data-structures to allow traversal of+large JSON strings with minimal memory overhead.++It is currently considered experimental.++For an example, see [`app/Main.hs`](../master/app/Main.hs)++## Prerequisites+* Install `haskell-stack`.+* Install `hlint` (eg. `stack install hlint`)++## Building++Run the following in the shell:++ git clone git@github.com:haskell-works/hw-json.git+ cd hw-json+ stack setup+ stack build+ stack test+ stack ghci --ghc-options -XOverloadedStrings \+ --main-is hw-json:exe:hw-json-example++## Memory benchmark++### Parsing large Json files in Scala with Argonaut++ S0U EU OU MU CCSU CMD+ --------- --------- ----------- -------- -------- ---------------------------------------------------------------+ 0.0 80,526.3 76,163.6 72,338.6 13,058.6 sbt console+ 0.0 536,660.4 76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._+ 0.0 552,389.1 76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json"+ 0.0 634,066.5 76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int])+ 0.0 644,552.3 76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json")+ 0.0 655,038.1 76,163.6 72,338.6 13,058.6 is.read(array)+ 294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array)+ 285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json)+ ***********++### Parsing large Json files in Haskell with Aeson++ Mem (MB) CMD+ -------- ---------------------------------------------------------+ 302 import Data.Aeson+ 302 import qualified Data.ByteString.Lazy as BSL+ 302 json78m <- BSL.readFile "/Users/jky/Downloads/78mbs.json"+ 1400 let !x = decode json78m :: Maybe Value++### Parsing large Json files in Haskell with hw-json++ Mem (MB) CMD+ -------- ---------------------------------------------------------+ 274 import Foreign+ 274 import qualified Data.Vector.Storable as DVS+ 274 import qualified Data.ByteString as BS+ 274 import System.IO.MMap+ 274 import Data.Word+ 274 (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing+ 601 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))++## Examples++### Performance example++ import Foreign+ import qualified Data.Vector.Storable as DVS+ import qualified Data.ByteString as BS+ import qualified Data.ByteString.Internal as BSI+ import System.IO.MMap+ 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)))+ let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+ x <- measure $ jsonBsToInterestBs bs+ let !y = runListConduit [bs] (unescape' "")++ import Foreign+ import qualified Data.Vector.Storable as DVS+ import qualified Data.ByteString as BS+ import qualified Data.ByteString.Internal as BSI+ import System.IO.MMap+ import Data.Word+ import System.CPUTime+ (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/part40.json" ReadOnly Nothing+ let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+ x <- measure $ BS.concat $ runListConduit [bs] (blankJson =$= blankedJsonToInterestBits)+ x <- measure $ jsonBsToInterestBs bs++ jsonTokenAt $ J.nextSibling $ J.firstChild $ J.nextSibling $ J.firstChild $ J.firstChild cursor++### Navigation example++ $ cabal repl --ghc-option='-package mmap'+ λ> :set -XNoMonomorphismRestriction+ λ> import qualified Data.ByteString as BS+ λ> import Data.String+ λ> import qualified Data.Vector.Storable as DVS+ λ> import Data.Word+ λ> import HaskellWorks.Data.Bits.BitShow+ λ> import HaskellWorks.Data.Bits.BitShown+ λ> import HaskellWorks.Data.FromForeignRegion+ λ> import HaskellWorks.Data.Json.Succinct.Cursor as C+ λ> import HaskellWorks.Data.Json.Token+ λ> import HaskellWorks.Data.Succinct.BalancedParens.Internal+ λ> import HaskellWorks.Data.Succinct.BalancedParens.Simple+ λ> import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+ λ> import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+ λ> import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+ λ> import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+ λ> import qualified HaskellWorks.Data.TreeCursor as TC+ λ> import System.IO.MMap+ λ> 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))+ λ> cursor++## References+* [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8)+* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf)+* [Conduit Overview](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/conduit-overview)+++## Special mentions+* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import qualified Data.ByteString as BS+import qualified Data.Vector.Storable as DVS+import Data.Word+import GHC.Conc+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Succinct.BalancedParens.Simple+import HaskellWorks.Diagnostics.Time+import System.Mem++readJson :: String -> IO (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+readJson path = do+ bs <- BS.readFile path+ print "Read file"+ !cursor <- measure (fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ print "Created cursor"+ return cursor++main :: IO ()+main = do+ performGC+ !c0 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c1 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c2 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c3 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c4 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c5 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c6 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c7 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c8 <- readJson "/Users/jky/Downloads/78mbs.json"+ !c9 <- readJson "/Users/jky/Downloads/78mbs.json"+ print "Returned from readJson"+ performGC+ threadDelay 100000000+ print c0+ print c1+ print c2+ print c3+ print c4+ print c5+ print c6+ print c7+ print c8+ print c9
+ bench/Main.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Criterion.Main+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI+import qualified Data.Vector.Storable as DVS+import Data.Word+import Foreign+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Succinct.BalancedParens.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+import System.IO.MMap++setupEnvBs :: Int -> IO BS.ByteString+setupEnvBs n = return $ BS.pack (take n (cycle [maxBound, 0]))++setupEnvBss :: Int -> Int -> IO [BS.ByteString]+setupEnvBss n k = setupEnvBs n >>= \v -> return (replicate k v)++setupEnvVector :: Int -> IO (DVS.Vector Word64)+setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))++setupEnvVectors :: Int -> Int -> IO [DVS.Vector Word64]+setupEnvVectors n k = setupEnvVector n >>= \v -> return (replicate k v)++setupEnvJson :: FilePath -> IO BS.ByteString+setupEnvJson filepath = do+ (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing+ let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+ return bs++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))++benchRankSelect :: [Benchmark]+benchRankSelect =+ [ env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"+ [ bench "Rank - Once" (whnf (rank1 bv) 1)+ , bench "Select - Once" (whnf (select1 bv) 1)+ , bench "Rank - Many" (nf (map (getCount . rank1 bv)) [0, 1000..10000000])+ ]+ ]++benchRankJson40Conduits :: [Benchmark]+benchRankJson40Conduits =+ [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "Json40"+ [ bench "loadJson " (whnf loadJson bs)+ ]+ ]++benchRankJson80Conduits :: [Benchmark]+benchRankJson80Conduits =+ [ env (setupEnvJson "/Users/jky/Downloads/part80.json") $ \bs -> bgroup "Json40"+ [ bench "loadJson" (whnf loadJson bs)+ ]+ ]++benchRankJsonBigConduits :: [Benchmark]+benchRankJsonBigConduits =+ [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"+ [ bench "loadJson" (whnf loadJson bs)+ ]+ ]++benchBlankedJsonToBalancedParens :: [Benchmark]+benchBlankedJsonToBalancedParens =+ [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "JsonBig"+ [ bench "loadJson" (whnf loadJson bs)+ ]+ ]++main :: IO ()+main = defaultMain benchRankJson40Conduits
+ hw-json.cabal view
@@ -0,0 +1,118 @@+name: hw-json+version: 0.0.0.1+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/hw-json#readme+license: BSD3+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+category: Data, Conduit+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.10+data-files: test/data/sample.json++executable hw-json-example+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2+ build-depends: base >= 4+ , bytestring+ , conduit+ , criterion+ , hw-bits+ , hw-conduit+ , hw-diagnostics+ , hw-json+ , hw-prim+ , hw-rankselect+ , mmap+ , resourcet+ , vector+ default-language: Haskell2010++library+ hs-source-dirs: src+ exposed-modules: HaskellWorks.Data.Json+ , HaskellWorks.Data.Json.Extract+ , HaskellWorks.Data.Json.Succinct+ , HaskellWorks.Data.Json.Succinct.Cursor+ , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens+ , HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+ , HaskellWorks.Data.Json.Succinct.Cursor.CursorType+ , HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor+ , HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+ , HaskellWorks.Data.Json.Succinct.Cursor.Internal+ , HaskellWorks.Data.Json.Succinct.Cursor.Token+ , HaskellWorks.Data.Json.Token.Tokenize+ , HaskellWorks.Data.Json.Token.Types+ , HaskellWorks.Data.Json.Token+ , HaskellWorks.Data.Json.Type+ , HaskellWorks.Data.Json.Value+ build-depends: base >= 4.7 && < 5+ , attoparsec+ , bytestring+ , conduit+ , containers+ , hw-bits+ , hw-conduit+ , hw-parser+ , hw-prim+ , hw-rankselect+ , mono-traversable+ , text+ , vector+ , word8++ default-language: Haskell2010+ ghc-options: -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2++test-suite hw-json-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.Json.Token.TokenizeSpec+ , HaskellWorks.Data.Json.Succinct.CursorSpec+ , HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec+ build-depends: base+ , attoparsec+ , bytestring+ , conduit+ , hspec+ , hw-bits+ , hw-conduit+ , hw-json+ , hw-prim+ , hw-rankselect+ , mmap+ , parsec+ , QuickCheck+ , resourcet+ , transformers+ , vector+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-json++benchmark bench+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: bench+ Main-Is: Main.hs+ GHC-Options: -O2 -Wall -msse4.2+ Default-Language: Haskell2010+ Build-Depends: base >= 4 && < 5+ , bytestring+ , conduit+ , criterion+ , hw-bits+ , hw-json+ , hw-prim+ , hw-rankselect+ , mmap+ , resourcet+ , vector
+ src/HaskellWorks/Data/Json.hs view
@@ -0,0 +1,11 @@+-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Json+module HaskellWorks.Data.Json+ ( module X+ ) where++import HaskellWorks.Data.Json.Succinct as X+import HaskellWorks.Data.Json.Token as X
+ src/HaskellWorks/Data/Json/Extract.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Extract+ ( extractJsonSnippet+ ) where++import qualified Data.ByteString as BS+import Data.Word8+import HaskellWorks.Data.Conduit.Json.Words+import HaskellWorks.Data.Json.Type++data ExtractJsonState+ = ExtractJsonStringEscaped+ | ExtractJsonStringInJson+ | ExtractJsonStringInNumber+ | ExtractJsonStringInString++extractJsonSnippet :: BS.ByteString -> Maybe (JsonType, BS.ByteString)+extractJsonSnippet bs = case extractJsonSnippet' 0 ExtractJsonStringInJson bs of+ Just (jsonType, len) -> Just (jsonType, BS.take len bs)+ Nothing -> Nothing++extractJsonSnippet' :: Int -> ExtractJsonState -> BS.ByteString -> Maybe (JsonType, Int)+extractJsonSnippet' n ExtractJsonStringInJson bs = case BS.uncons bs of+ Just (!c, !cs) | isLeadingDigit c -> extractJsonSnippet' (n + 1) ExtractJsonStringInNumber cs+ Just (!c, !cs) | c == _quotedbl -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs+ Just (!c, _) | c == _t -> Just (JsonTypeBool, n + 1)+ Just (!c, _) | c == _f -> Just (JsonTypeBool, n + 1)+ Just (!c, _) | c == _n -> Just (JsonTypeNull, n + 1)+ Just (!c, _) | c == _braceleft -> Just (JsonTypeObject, n + 1)+ Just (!c, _) | c == _bracketleft -> Just (JsonTypeArray, n + 1)+ Just _ -> Nothing+ Nothing -> Nothing+extractJsonSnippet' n ExtractJsonStringInString bs = case BS.uncons bs of+ Just (!c, !cs) | c == _backslash -> extractJsonSnippet' (n + 1) ExtractJsonStringEscaped cs+ Just (!c, _) | c == _quotedbl -> Just (JsonTypeString, n + 1)+ Just (_ , !cs) -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs+ Nothing -> Nothing+extractJsonSnippet' n ExtractJsonStringEscaped bs = case BS.uncons bs of+ Just (_, !cs) -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs+ Nothing -> Nothing+extractJsonSnippet' n ExtractJsonStringInNumber bs = case BS.uncons bs of+ Just (!c, !cs) | isTrailingDigit c -> extractJsonSnippet' (n + 1) ExtractJsonStringInNumber cs+ Just _ -> Just (JsonTypeNumber, n)+ Nothing -> Just (JsonTypeNumber, n)
+ src/HaskellWorks/Data/Json/Succinct.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Json.Succinct+ ( module X+ ) where++import HaskellWorks.Data.Json.Succinct.Cursor as X
+ src/HaskellWorks/Data/Json/Succinct/Cursor.hs view
@@ -0,0 +1,8 @@++module HaskellWorks.Data.Json.Succinct.Cursor+ ( module X+ ) where++import HaskellWorks.Data.Json.Succinct.Cursor.CursorType as X+import HaskellWorks.Data.Json.Succinct.Cursor.Internal as X+import HaskellWorks.Data.Json.Succinct.Cursor.Token as X
+ src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens+ ( JsonBalancedParens(..)+ , getJsonBalancedParens+ ) where++import Control.Applicative+import qualified Data.ByteString as BS+import Data.Conduit+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Conduit.Json+import HaskellWorks.Data.Conduit.List+import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import HaskellWorks.Data.Succinct.BalancedParens as BP++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)+{-# INLINABLE genBitWordsForever #-}++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens [Bool])) where+ fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (runListConduit blankedJsonToBalancedParens bj))++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where+ fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+ where interestBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+ newLen = (BS.length interestBS + 7) `div` 8 * 8++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where+ fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+ where interestBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+ newLen = (BS.length interestBS + 7) `div` 8 * 8++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where+ fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+ where interestBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+ newLen = (BS.length interestBS + 7) `div` 8 * 8++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where+ fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+ where interestBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+ newLen = (BS.length interestBS + 7) `div` 8 * 8
+ src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs view
@@ -0,0 +1,23 @@++module HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+ ( BlankedJson(..)+ , FromBlankedJson(..)+ , getBlankedJson+ ) where++import qualified Data.ByteString as BS+import HaskellWorks.Data.ByteString+import HaskellWorks.Data.Conduit.Json.Blank+import HaskellWorks.Data.Conduit.List+import HaskellWorks.Data.FromByteString++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 (runListConduit blankJson (chunkedBy 4064 bs))
+ src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.CursorType+ ( HasJsonCursorType(..)+ , JsonCursorType(..)+ , jsonCursorPos+ ) where++import qualified Data.ByteString as BS+import Data.Char+import HaskellWorks.Data.Json.Succinct.Cursor.Internal+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Vector.VectorLike++data JsonCursorType+ = JsonCursorArray+ | JsonCursorBool+ | JsonCursorNull+ | JsonCursorNumber+ | JsonCursorObject+ | JsonCursorString+ deriving (Eq, Show)++class HasJsonCursorType k where+ jsonCursorType :: k -> JsonCursorType++jsonCursorType' :: Char -> JsonCursorType+jsonCursorType' c = case c of+ '[' -> JsonCursorArray+ 't' -> JsonCursorBool+ 'f' -> JsonCursorBool+ '0' -> JsonCursorNumber+ '1' -> JsonCursorNumber+ '2' -> JsonCursorNumber+ '3' -> JsonCursorNumber+ '4' -> JsonCursorNumber+ '5' -> JsonCursorNumber+ '6' -> JsonCursorNumber+ '7' -> JsonCursorNumber+ '8' -> JsonCursorNumber+ '9' -> JsonCursorNumber+ '+' -> JsonCursorNumber+ '-' -> JsonCursorNumber+ 'n' -> JsonCursorNull+ '{' -> JsonCursorObject+ '"' -> JsonCursorString+ _ -> error "Invalid JsonCursor cursorRank"++jsonCursorPos :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+ where ik = interests k+ bpk = balancedParens k++jsonCursorElemAt :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Elem s+jsonCursorElemAt k = cursorText k !!! jsonCursorPos k++instance (Rank1 i, Select1 i, Rank1 b) => HasJsonCursorType (JsonCursor String i b) where+ jsonCursorType = jsonCursorType' . jsonCursorElemAt++instance (Rank1 i, Select1 i, Rank1 b) => HasJsonCursorType (JsonCursor BS.ByteString i b) where+ jsonCursorType = jsonCursorType' . chr . fromIntegral . jsonCursorElemAt
+ src/HaskellWorks/Data/Json/Succinct/Cursor/FromJsonCursor.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor where++import qualified Data.ByteString as BS+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Succinct.Cursor.Internal+import HaskellWorks.Data.Json.Succinct.Cursor.Token+import HaskellWorks.Data.Json.Value+import HaskellWorks.Data.Json.Token.Types+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.TreeCursor++class FromJsonCursor t v w a where+ fromJsonCursor :: JsonCursor t v w -> a++instance (TreeCursor (JsonCursor BS.ByteString v w), Rank1 w, Select1 v, TestBit w) => FromJsonCursor BS.ByteString v w (JsonValue BS.ByteString BS.ByteString) where+ fromJsonCursor k = case jsonTokenAt k of+ Just JsonTokenBraceL -> undefined+ Just JsonTokenBraceR -> undefined+ Just JsonTokenBracketL -> undefined+ Just JsonTokenBracketR -> undefined+ Just JsonTokenComma -> undefined+ Just JsonTokenColon -> undefined+ Just JsonTokenWhitespace -> undefined+ Just (JsonTokenString _) -> undefined+ Just (JsonTokenBoolean value) -> JsonBool value+ Just (JsonTokenNumber _) -> undefined+ Just JsonTokenNull -> undefined+ Nothing -> undefined
+ src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+ ( JsonInterestBits(..)+ , getJsonInterestBits+ ) where++import Control.Applicative+import qualified Data.ByteString as BS+import Data.ByteString.Internal+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Conduit.Json+import HaskellWorks.Data.Conduit.List+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512++newtype JsonInterestBits a = JsonInterestBits a++getJsonInterestBits :: JsonInterestBits a -> a+getJsonInterestBits (JsonInterestBits a) = a++blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString+blankedJsonBssToInterestBitsBs bss = BS.concat $ runListConduit 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 . runListConduit 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
+ src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.Internal+ ( JsonCursor(..)+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.ByteString.Internal as BSI+import Data.String+import qualified Data.Vector.Storable as DVS+import Data.Word+import Data.Word8+import Foreign.ForeignPtr+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens+import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+import HaskellWorks.Data.Json.Type+import HaskellWorks.Data.Json.Value+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Succinct.BalancedParens as BP+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import HaskellWorks.Data.TreeCursor+import HaskellWorks.Data.Vector.VectorLike++data JsonCursor t v w = JsonCursor+ { cursorText :: !t+ , interests :: !v+ , balancedParens :: !w+ , cursorRank :: !Count+ }+ deriving (Eq, Show)++instance (FromBlankedJson (JsonInterestBits a), FromBlankedJson (JsonBalancedParens b))+ => FromByteString (JsonCursor BS.ByteString a b) where+ fromByteString bs = JsonCursor+ { cursorText = bs+ , interests = getJsonInterestBits (fromBlankedJson blankedJson)+ , balancedParens = getJsonBalancedParens (fromBlankedJson blankedJson)+ , cursorRank = 1+ }+ where blankedJson :: BlankedJson+ blankedJson = fromByteString bs++instance IsString (JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])) where+ fromString :: String -> JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ fromString s = JsonCursor+ { cursorText = s+ , cursorRank = 1+ , interests = getJsonInterestBits (fromBlankedJson blankedJson)+ , balancedParens = getJsonBalancedParens (fromBlankedJson blankedJson)+ }+ where blankedJson :: BlankedJson+ blankedJson = fromByteString (BSC.pack s)++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where+ fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) where+ fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) where+ fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) where+ fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where+ fromString = fromByteString . BSC.pack++instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (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)) (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)) (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)) (SimpleBalancedParens (DVS.Vector Word64))) where+ fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where+ fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where+ firstChild :: JsonCursor t v u -> JsonCursor t v u+ firstChild k = k { cursorRank = BP.firstChild (balancedParens k) (cursorRank k) }++ nextSibling :: JsonCursor t v u -> JsonCursor t v u+ nextSibling k = k { cursorRank = BP.nextSibling (balancedParens k) (cursorRank k) }++ parent :: JsonCursor t v u -> JsonCursor t v u+ parent k = k { cursorRank = BP.parent (balancedParens k) (cursorRank k) }++ depth :: JsonCursor t v u -> Count+ depth k = BP.depth (balancedParens k) (cursorRank k)++ subtreeSize :: JsonCursor t v u -> Count+ subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++wIsJsonNumberDigit :: Word8 -> Bool+wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen++instance TestBit w => JsonTypeAt (JsonCursor BS.ByteString v w) where+ jsonTypeAtPosition p k = if balancedParens k .?. p+ then case cursorText k !!! p of+ c | c == _bracketleft -> Just JsonTypeArray+ c | c == _t -> Just JsonTypeBool+ c | c == _n -> Just JsonTypeNull+ c | wIsJsonNumberDigit c -> Just JsonTypeNumber+ c | c == _braceleft -> Just JsonTypeObject+ c | c == _quotedbl -> Just JsonTypeString+ _ -> Nothing+ else Nothing++ jsonTypeAt k = jsonTypeAtPosition (lastPositionOf (cursorRank k)) k++instance TestBit w => JsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString v w) where+ jsonValueAt :: JsonCursor BS.ByteString v w -> Maybe (JsonValue BS.ByteString BS.ByteString)+ jsonValueAt k = case jsonTypeAtPosition p k of+ Just JsonTypeArray -> error "Not Implemented"+ Just JsonTypeBool -> case cursorText k !!! p of+ c | c == _t -> Just $ JsonBool True+ c | c == _t -> Just $ JsonBool False+ _ -> Nothing+ Just JsonTypeNull -> Just JsonNull+ Just JsonTypeNumber -> error "Not Implemented"+ Just JsonTypeObject -> error "Not Implemented"+ Just JsonTypeString -> error "Not Implemented"+ Nothing -> Nothing+ where p = lastPositionOf (cursorRank k)
+ src/HaskellWorks/Data/Json/Succinct/Cursor/Token.hs view
@@ -0,0 +1,23 @@++module HaskellWorks.Data.Json.Succinct.Cursor.Token+ ( jsonTokenAt+ ) where++import qualified Data.Attoparsec.ByteString.Char8 as ABC+import Data.ByteString.Internal as BSI+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Succinct.Cursor.CursorType+import HaskellWorks.Data.Json.Succinct.Cursor.Internal+import HaskellWorks.Data.Json.Token.Tokenize+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Vector.VectorLike++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 (vDrop (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
+ src/HaskellWorks/Data/Json/Token.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Json.Token+ ( module X+ ) where++import HaskellWorks.Data.Json.Token.Types as X+import HaskellWorks.Data.Json.Token.Tokenize as X
+ src/HaskellWorks/Data/Json/Token/Tokenize.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HaskellWorks.Data.Json.Token.Tokenize+ ( IsChar(..)+ , JsonToken(..)+ , ParseJson(..)+ ) where++import Control.Applicative+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 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++hexDigitNumeric :: P.Parser t => T.Parser t Int+hexDigitNumeric = do+ c <- satisfyChar (\c -> '0' <= c && c <= '9')+ return $ ord c - ord '0'++hexDigitAlphaLower :: P.Parser t => T.Parser t Int+hexDigitAlphaLower = do+ c <- satisfyChar (\c -> 'a' <= c && c <= 'z')+ return $ ord c - ord 'a' + 10++hexDigitAlphaUpper :: P.Parser t => T.Parser t Int+hexDigitAlphaUpper = do+ c <- satisfyChar (\c -> 'A' <= c && c <= 'Z')+ return $ ord c - ord 'A' + 10++hexDigit :: P.Parser t => 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)
+ src/HaskellWorks/Data/Json/Token/Types.hs view
@@ -0,0 +1,15 @@+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)
+ src/HaskellWorks/Data/Json/Type.hs view
@@ -0,0 +1,16 @@+module HaskellWorks.Data.Json.Type where++import HaskellWorks.Data.Positioning++data JsonType+ = JsonTypeArray+ | JsonTypeBool+ | JsonTypeNull+ | JsonTypeNumber+ | JsonTypeObject+ | JsonTypeString+ deriving (Eq, Show)++class JsonTypeAt a where+ jsonTypeAtPosition :: Position -> a -> Maybe JsonType+ jsonTypeAt :: a -> Maybe JsonType
+ src/HaskellWorks/Data/Json/Value.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Value where++import Data.Map++data JsonValue s n+ = JsonString s+ | JsonNumber n+ | JsonObject (Map s (JsonValue s n))+ | JsonArray [JsonValue s n]+ | JsonBool Bool+ | JsonNull+ deriving (Eq, Show)++class JsonValueAt s n a where+ jsonValueAt :: a -> Maybe (JsonValue s n)
+ test/HaskellWorks/Data/Json/Succinct/Cursor/InterestBitsSpec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+++module HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec(spec) where++import qualified Data.ByteString as BS+import Data.String+import qualified Data.Vector.Storable as DVS+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++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++interestBitsOf :: FromBlankedJson (JsonInterestBits a) => BS.ByteString -> a+interestBitsOf = getJsonInterestBits . fromBlankedJson . fromByteString++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"
+ test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Json.Succinct.CursorSpec(spec) where++import qualified Data.ByteString as BS+import Data.String+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Token+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import qualified HaskellWorks.Data.TreeCursor as TC+import System.IO.MMap+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: redundant bracket" :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling+pn = TC.parent+cd = TC.depth+ss = TC.subtreeSize++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])+ jsonCursorType cursor `shouldBe` JsonCursorObject+ it "initialises to beginning of empty object preceded by spaces" $ do+ let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorObject+ it "initialises to beginning of number" $ do+ let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorNumber+ it "initialises to beginning of string" $ do+ let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorString+ it "initialises to beginning of array" $ do+ let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorArray+ it "initialises to beginning of boolean true" $ do+ let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorBool+ it "initialises to beginning of boolean false" $ do+ let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorBool+ it "initialises to beginning of null" $ do+ let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType cursor `shouldBe` JsonCursorNull+ it "cursor can navigate to first child of array" $ do+ let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType (fc cursor) `shouldBe` JsonCursorNull+ it "cursor can navigate to second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject+ 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])+ jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString+ 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])+ jsonCursorType ((ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber+ it "depth at top" $ do+ let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ cd cursor `shouldBe` 1+ it "depth at first child of array" $ do+ let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ cd (fc cursor) `shouldBe` 2+ it "depth at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ cd ((ns . fc) cursor) `shouldBe` 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])+ cd ((fc . ns . fc) cursor) `shouldBe` 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])+ cd ((ns . fc . ns . fc) cursor) `shouldBe` 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 "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+ , Select1 t+ , Eq u+ , Show u+ , Rank0 u+ , Rank1 u+ , BalancedParens u+ , TestBit u+ , FromForeignRegion (JsonCursor BS.ByteString t u)+ , IsString (JsonCursor BS.ByteString t u)+ , HasJsonCursorType (JsonCursor BS.ByteString t u))+ => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t _ = do+ describe ("Cursor for (" ++ t ++ ")") $ do+ it "initialises to beginning of empty object" $ do+ let cursor = "{}" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorObject+ it "initialises to beginning of empty object preceded by spaces" $ do+ let cursor = " {}" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorObject+ it "initialises to beginning of number" $ do+ let cursor = "1234" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorNumber+ it "initialises to beginning of string" $ do+ let cursor = "\"Hello\"" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorString+ it "initialises to beginning of array" $ do+ let cursor = "[]" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorArray+ it "initialises to beginning of boolean true" $ do+ let cursor = "true" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorBool+ it "initialises to beginning of boolean false" $ do+ let cursor = "false" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorBool+ it "initialises to beginning of null" $ do+ let cursor = "null" :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorNull+ it "cursor can navigate to first child of array" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ jsonCursorType (fc cursor) `shouldBe` JsonCursorNull+ it "cursor can navigate to second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject+ it "cursor can navigate to first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString+ it "cursor can navigate to first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ jsonCursorType ((ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber+ it "depth at top" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ cd cursor `shouldBe` 1+ it "depth at first child of array" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ cd (fc cursor) `shouldBe` 2+ it "depth at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ cd ((ns . fc) cursor) `shouldBe` 2+ it "depth at first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ cd ((fc . ns . fc) cursor) `shouldBe` 3+ it "depth at first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+ cd ((ns . fc . ns . fc) cursor) `shouldBe` 3+ it "can navigate down and forwards" $ do+ (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing+ let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+ jsonCursorType cursor `shouldBe` JsonCursorObject+ jsonCursorType (( fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . fc) cursor) `shouldBe` JsonCursorObject+ jsonCursorType (( fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorObject+ jsonCursorType (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+ jsonCursorType ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber+ it "can navigate up" $ do+ (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing+ let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+ ( pn . fc) cursor `shouldBe` cursor+ ( pn . ns . fc) cursor `shouldBe` cursor+ ( pn . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor+ ( pn . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor+ ( pn . ns . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor+ ( pn . ns . ns . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor+ ( pn . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ ( pn . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ ( pn . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ ( pn . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ ( pn . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ ( pn . ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+ it "can get subtree size" $ do+ (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing+ let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+ ss cursor `shouldBe` 45+ ss (( fc) cursor) `shouldBe` 1+ ss (( ns . fc) cursor) `shouldBe` 43+ ss (( fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 9+ ss (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ ss ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+ it "can get token at cursor" $ do+ (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing+ let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+ jsonTokenAt cursor `shouldBe` Just (JsonTokenBraceL )+ jsonTokenAt (( fc) cursor) `shouldBe` Just (JsonTokenString "widget" )+ jsonTokenAt (( ns . fc) cursor) `shouldBe` Just (JsonTokenBraceL )+ jsonTokenAt (( fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "debug" )+ jsonTokenAt (( ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "on" )+ jsonTokenAt (( ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "window" )+ jsonTokenAt (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenBraceL )+ jsonTokenAt (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "title" )+ jsonTokenAt (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "Sample Konfabulator Widget")+ jsonTokenAt (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "name" )+ jsonTokenAt (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "main_window" )+ jsonTokenAt (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "width" )+ jsonTokenAt ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenNumber 500.0 )
+ test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Token.TokenizeSpec (spec) where++import qualified Data.Attoparsec.ByteString.Char8 as BC+import Data.ByteString as BS+import HaskellWorks.Data.Json.Token.Tokenize+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++parseJsonToken' :: ByteString -> Either String (JsonToken String Double)+parseJsonToken' = BC.parseOnly parseJsonToken++spec :: Spec+spec = describe "Data.Conduit.Succinct.JsonSpec" $ do+ describe "When parsing single token at beginning of text" $ do+ it "Empty Json should produce no bits" $+ parseJsonToken' "" `shouldBe` Left "not enough input"+ it "Json with one space should produce whitespace token" $+ parseJsonToken' " " `shouldBe` Right JsonTokenWhitespace+ it "Json with two spaces should produce whitespace token" $+ parseJsonToken' " " `shouldBe` Right JsonTokenWhitespace+ it "Spaces and newlines should produce no bits" $+ parseJsonToken' " \n \r \t " `shouldBe` Right JsonTokenWhitespace+ it "`null` at beginning should produce one bit" $+ parseJsonToken' "null " `shouldBe` Right JsonTokenNull+ it "number at beginning should produce one bit" $+ parseJsonToken' "1234 " `shouldBe` Right (JsonTokenNumber 1234)+ it "false at beginning should produce one bit" $+ parseJsonToken' "false " `shouldBe` Right (JsonTokenBoolean False)+ it "true at beginning should produce one bit" $+ parseJsonToken' "true " `shouldBe` Right (JsonTokenBoolean True)+ it "string at beginning should produce one bit" $+ parseJsonToken' "\"hello\" " `shouldBe` Right (JsonTokenString "hello")+ it "quoted string should parse" $+ parseJsonToken' "\"\\\"\" " `shouldBe` Right (JsonTokenString "\"")+ it "left brace at beginning should produce one bit" $+ parseJsonToken' "{ " `shouldBe` Right JsonTokenBraceL+ it "right brace at beginning should produce one bit" $+ parseJsonToken' "} " `shouldBe` Right JsonTokenBraceR+ it "left bracket at beginning should produce one bit" $+ parseJsonToken' "[ " `shouldBe` Right JsonTokenBracketL+ it "right bracket at beginning should produce one bit" $+ parseJsonToken' "] " `shouldBe` Right JsonTokenBracketR+ it "right bracket at beginning should produce one bit" $+ parseJsonToken' ": " `shouldBe` Right JsonTokenColon+ it "right bracket at beginning should produce one bit" $+ parseJsonToken' ", " `shouldBe` Right JsonTokenComma
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/data/sample.json view
@@ -0,0 +1,28 @@+{+ "widget": {+ "debug": "on",+ "window": {+ "title": "Sample Konfabulator Widget",+ "name": "main_window",+ "width": 500,+ "height": 500+ },+ "image": {+ "src": "Images/Sun.png",+ "name": "sun1",+ "hOffset": 250,+ "vOffset": 250,+ "alignment": "center"+ },+ "text": {+ "data": "Click Here",+ "size": 36,+ "style": "bold",+ "name": "text1",+ "hOffset": 250,+ "vOffset": 100,+ "alignment": "center",+ "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"+ }+ }+}