hw-json 0.7.0.1 → 0.8.0.0
raw patch · 34 files changed
+433/−483 lines, 34 filesdep −QuickCheckdep −conduitdep −hw-conduitdep ~hw-parserPVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, conduit, hw-conduit, hw-diagnostics, mono-traversable, parsec, resourcet, transformers
Dependency ranges changed: hw-parser
API changes (from Hackage documentation)
- HaskellWorks.Data.Json.Conduit: blankedJsonToBalancedParens :: Monad m => ConduitT ByteString Bool m ()
- HaskellWorks.Data.Json.Conduit: blankedJsonToBalancedParens2 :: Monad m => ConduitT ByteString ByteString m ()
- HaskellWorks.Data.Json.Conduit: blankedJsonToInterestBits :: Monad m => ConduitT ByteString ByteString m ()
- HaskellWorks.Data.Json.Conduit: byteStringToBits :: Monad m => ConduitT ByteString Bool m ()
- HaskellWorks.Data.Json.Conduit: compressWordAsBit :: Monad m => ConduitT ByteString ByteString m ()
- HaskellWorks.Data.Json.Conduit: interestingWord8s :: UArray Word8 Word8
- HaskellWorks.Data.Json.Conduit.Blank: blankJson :: MonadThrow m => ConduitT ByteString ByteString m ()
- HaskellWorks.Data.Json.Conduit.Words: isAlphabetic :: Word8 -> Bool
- HaskellWorks.Data.Json.Conduit.Words: isLeadingDigit :: Word8 -> Bool
- HaskellWorks.Data.Json.Conduit.Words: isTrailingDigit :: Word8 -> Bool
+ HaskellWorks.Data.Json.Internal.Blank: blankJson :: [ByteString] -> [ByteString]
+ HaskellWorks.Data.Json.Internal.MakeIndex: blankedJsonToBalancedParens :: [ByteString] -> [Bool]
+ HaskellWorks.Data.Json.Internal.MakeIndex: blankedJsonToBalancedParens2 :: [ByteString] -> [ByteString]
+ HaskellWorks.Data.Json.Internal.MakeIndex: blankedJsonToInterestBits :: [ByteString] -> [ByteString]
+ HaskellWorks.Data.Json.Internal.MakeIndex: byteStringToBits :: [ByteString] -> [Bool] -> [Bool]
+ HaskellWorks.Data.Json.Internal.MakeIndex: compressWordAsBit :: [ByteString] -> [ByteString]
+ HaskellWorks.Data.Json.Internal.MakeIndex: interestingWord8s :: UArray Word8 Word8
+ HaskellWorks.Data.Json.Internal.Words: isAlphabetic :: Word8 -> Bool
+ HaskellWorks.Data.Json.Internal.Words: isLeadingDigit :: Word8 -> Bool
+ HaskellWorks.Data.Json.Internal.Words: isTrailingDigit :: Word8 -> Bool
- HaskellWorks.Data.Json.Value.Internal: parseHexDigit :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigit :: Parser t u => Parser t Int
- HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaLower :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaLower :: Parser t u => Parser t Int
- HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaUpper :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaUpper :: Parser t u => Parser t Int
- HaskellWorks.Data.Json.Value.Internal: parseHexDigitNumeric :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitNumeric :: Parser t u => Parser t Int
- HaskellWorks.Data.Json.Value.Internal: parseJsonString :: (Parser t, IsString t) => Parser t String
+ HaskellWorks.Data.Json.Value.Internal: parseJsonString :: (Parser t u, IsString t) => Parser t String
Files
- README.md +2/−6
- app/Main.hs +3/−4
- bench/Main.hs +30/−35
- hw-json.cabal +76/−80
- src/HaskellWorks/Data/Json.hs +3/−4
- src/HaskellWorks/Data/Json/CharLike.hs +1/−1
- src/HaskellWorks/Data/Json/Conduit.hs +0/−170
- src/HaskellWorks/Data/Json/Conduit/Blank.hs +0/−62
- src/HaskellWorks/Data/Json/Conduit/Words.hs +0/−13
- src/HaskellWorks/Data/Json/Internal/Blank.hs +56/−0
- src/HaskellWorks/Data/Json/Internal/MakeIndex.hs +158/−0
- src/HaskellWorks/Data/Json/Internal/Words.hs +13/−0
- src/HaskellWorks/Data/Json/LightJson.hs +3/−3
- src/HaskellWorks/Data/Json/Load.hs +1/−1
- src/HaskellWorks/Data/Json/LoadCursor.hs +1/−1
- src/HaskellWorks/Data/Json/PartialValue.hs +1/−1
- src/HaskellWorks/Data/Json/Succinct.hs +0/−5
- src/HaskellWorks/Data/Json/Succinct/Cursor.hs +0/−7
- src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +6/−8
- src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs +2/−3
- src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs +3/−4
- src/HaskellWorks/Data/Json/Succinct/Index.hs +2/−2
- src/HaskellWorks/Data/Json/Succinct/PartialIndex.hs +2/−2
- src/HaskellWorks/Data/Json/Token/Tokenize.hs +4/−4
- src/HaskellWorks/Data/Json/Type.hs +2/−2
- src/HaskellWorks/Data/Json/Value/Internal.hs +6/−5
- test/HaskellWorks/Data/Json/Conduit/BlankSpec.hs +0/−50
- test/HaskellWorks/Data/Json/CorpusSpec.hs +1/−1
- test/HaskellWorks/Data/Json/Internal/BlankSpec.hs +49/−0
- test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs +3/−5
- test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +2/−1
- test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +1/−1
- test/HaskellWorks/Data/Json/TypeSpec.hs +1/−1
- test/HaskellWorks/Data/Json/ValueSpec.hs +1/−1
README.md view
@@ -73,7 +73,7 @@ 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' "")+ let !y = BS.concat (unescape' "" [bs]) import Foreign import qualified Data.Vector.Storable as DVS@@ -84,7 +84,7 @@ 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 $ BS.concat $ blankedJsonToInterestBits $ blankJson [bs] x <- measure $ jsonBsToInterestBs bs jsonTokenAt $ J.nextSibling $ J.firstChild $ J.nextSibling $ J.firstChild $ J.firstChild cursor@@ -218,11 +218,7 @@ * [Semi-Indexing Semi-Structured Data in Tiny Space](http://www.di.unipi.it/~ottavian/files/semi_index_cikm.pdf) * [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8) * [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf)-* [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/)--- :set +s
app/Main.hs view
@@ -12,10 +12,9 @@ import HaskellWorks.Data.FromByteString import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.Json.LoadCursor-import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Micro import HaskellWorks.Data.MQuery-import HaskellWorks.Diagnostics.Time import qualified Data.ByteString as BS import qualified Data.DList as DL@@ -25,7 +24,7 @@ readJson path = do bs <- BS.readFile path print ("Read file" :: String)- !cursor <- measure (fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ let !cursor = fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) print ("Created cursor" :: String) return cursor @@ -51,4 +50,4 @@ let !json = lightJsonAt cursor let q = MQuery (DL.singleton json) - measureIO $ putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & count+ putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & count
bench/Main.hs view
@@ -3,23 +3,21 @@ module Main where -import Criterion.Main-import Control.Monad.Trans.Resource (MonadThrow)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BSI-import Data.Conduit-import qualified Data.Vector.Storable as DVS-import Data.Word-import Foreign-import HaskellWorks.Data.BalancedParens.Simple-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Conduit.List-import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Conduit-import HaskellWorks.Data.Json.Conduit.Blank-import HaskellWorks.Data.Json.Succinct.Cursor-import System.IO.MMap+import Criterion.Main+import Data.Word+import Foreign+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.Json.Internal.Blank+import HaskellWorks.Data.Json.Internal.MakeIndex+import HaskellWorks.Data.Json.Succinct.Cursor.Internal+import System.IO.MMap +import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI+import qualified Data.Vector.Storable as DVS+ setupEnvJson :: FilePath -> IO BS.ByteString setupEnvJson filepath = do (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing@@ -29,38 +27,35 @@ 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)) -runCon :: Conduit i [] BS.ByteString -> i -> BS.ByteString-runCon con bs = BS.concat $ runListConduit con [bs]--jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString-jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits+jsonToInterestBits3 :: [BS.ByteString] -> [BS.ByteString]+jsonToInterestBits3 = blankedJsonToInterestBits . blankJson -benchRankJson40Conduits :: [Benchmark]-benchRankJson40Conduits =+benchRankJson40 :: [Benchmark]+benchRankJson40 = [ env (setupEnvJson "corpus/part40.json") $ \bs -> bgroup "Json40"- [ bench "Run blankJson " (whnf (runCon blankJson ) bs)- , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)- , bench "loadJson " (whnf loadJson bs)+ [ bench "Run blankJson " (whnf (BS.concat . blankJson ) [bs])+ , bench "Run jsonToInterestBits3 " (whnf (BS.concat . jsonToInterestBits3) [bs])+ , bench "loadJson " (whnf loadJson bs ) ] ] -benchRankJson80Conduits :: [Benchmark]-benchRankJson80Conduits =+benchRankJson80 :: [Benchmark]+benchRankJson80 = [ env (setupEnvJson "corpus/part80.json") $ \bs -> bgroup "Json40"- [ bench "Run blankJson " (whnf (runCon blankJson ) bs)- , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)+ [ bench "Run blankJson " (whnf (BS.concat . blankJson ) [bs])+ , bench "Run jsonToInterestBits3 " (whnf (BS.concat . jsonToInterestBits3) [bs]) , bench "loadJson" (whnf loadJson bs) ] ] -benchRankJsonBigConduits :: [Benchmark]-benchRankJsonBigConduits =+benchRankJsonBig :: [Benchmark]+benchRankJsonBig = [ env (setupEnvJson "corpus/78mb.json") $ \bs -> bgroup "JsonBig"- [ bench "Run blankJson " (whnf (runCon blankJson ) bs)- , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)+ [ bench "Run blankJson " (whnf (BS.concat . blankJson ) [bs])+ , bench "Run jsonToInterestBits3 " (whnf (BS.concat . jsonToInterestBits3) [bs]) , bench "loadJson" (whnf loadJson bs) ] ] main :: IO ()-main = defaultMain benchRankJson40Conduits+main = defaultMain benchRankJson40
hw-json.cabal view
@@ -1,14 +1,12 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack------ hash: b4bd849a21612a66cf5c9004ea3b8843cdb14954a1181ced3bbf953a50752f99 name: hw-json-version: 0.7.0.1+version: 0.8.0.0 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md-category: Data, Conduit+category: Data homepage: http://github.com/haskell-works/hw-json#readme bug-reports: https://github.com/haskell-works/hw-json/issues author: John Ky@@ -33,47 +31,56 @@ type: git location: https://github.com/haskell-works/hw-json +flag bmi2+ description: Enable bmi2 instruction set+ manual: False+ default: False++flag sse42+ description: Enable sse4.2 instruction set+ manual: False+ default: False+ library hs-source-dirs: src ghc-options: -Wall -O2 -msse4.2 build-depends:- ansi-wl-pprint+ base >= 4 && <5+ , bytestring+ , hw-balancedparens >= 0.1.0.0+ , hw-bits >= 0.4.0.0+ , hw-prim >= 0.4.0.0+ , hw-rankselect >= 0.8.0.0+ , hw-rankselect-base >= 0.2.0.0+ , mmap+ , vector , array+ , ansi-wl-pprint , attoparsec- , base >=4 && <5- , bytestring- , conduit , containers , dlist- , hw-balancedparens >=0.1.0.0- , hw-bits >=0.4.0.0- , hw-conduit >=0.1.0.0- , hw-mquery >=0.1.0.0- , hw-parser >=0.0.0.1- , hw-prim >=0.4.0.0- , hw-rankselect >=0.8.0.0- , hw-rankselect-base >=0.2.0.0- , mmap- , mono-traversable- , resourcet+ , hw-mquery >= 0.1.0.0+ , hw-parser >= 0.1.0.0 , text- , vector , word8+ if (flag(sse42))+ ghc-options: -mbmi2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED exposed-modules: HaskellWorks.Data.Json HaskellWorks.Data.Json.CharLike- HaskellWorks.Data.Json.Conduit- HaskellWorks.Data.Json.Conduit.Blank- HaskellWorks.Data.Json.Conduit.Words HaskellWorks.Data.Json.DecodeError HaskellWorks.Data.Json.FromValue+ HaskellWorks.Data.Json.Internal.Blank+ HaskellWorks.Data.Json.Internal.MakeIndex+ HaskellWorks.Data.Json.Internal.Words HaskellWorks.Data.Json.LightJson HaskellWorks.Data.Json.Load HaskellWorks.Data.Json.LoadCursor HaskellWorks.Data.Json.PartialValue- HaskellWorks.Data.Json.Succinct- HaskellWorks.Data.Json.Succinct.Cursor HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson HaskellWorks.Data.Json.Succinct.Cursor.InterestBits@@ -81,9 +88,9 @@ HaskellWorks.Data.Json.Succinct.Cursor.Token HaskellWorks.Data.Json.Succinct.Index HaskellWorks.Data.Json.Succinct.PartialIndex+ HaskellWorks.Data.Json.Token HaskellWorks.Data.Json.Token.Tokenize HaskellWorks.Data.Json.Token.Types- HaskellWorks.Data.Json.Token HaskellWorks.Data.Json.Type HaskellWorks.Data.Json.Value HaskellWorks.Data.Json.Value.Internal@@ -97,33 +104,24 @@ app ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2 build-depends:- ansi-wl-pprint- , array- , attoparsec- , base >=4 && <5+ base >= 4 && <5 , bytestring- , conduit- , containers+ , hw-balancedparens >= 0.1.0.0+ , hw-bits >= 0.4.0.0+ , hw-prim >= 0.4.0.0+ , hw-rankselect >= 0.8.0.0+ , hw-rankselect-base >= 0.2.0.0+ , mmap+ , vector , criterion , dlist- , hw-balancedparens >=0.1.0.0- , hw-bits >=0.4.0.0- , hw-conduit >=0.1.0.0- , hw-diagnostics >=0.0.0.5 , hw-json- , hw-mquery >=0.1.0.0- , hw-parser >=0.0.0.1- , hw-prim >=0.4.0.0- , hw-rankselect >=0.8.0.0- , hw-rankselect-base >=0.2.0.0- , mmap- , mono-traversable- , resourcet- , text- , vector- , word8- other-modules:- Paths_hw_json+ , hw-mquery >= 0.1.0.0+ if (flag(sse42))+ ghc-options: -mbmi2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED default-language: Haskell2010 test-suite hw-json-test@@ -133,35 +131,33 @@ test ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends:- QuickCheck- , attoparsec- , base >=4 && <5+ base >= 4 && <5 , bytestring- , conduit+ , hw-balancedparens >= 0.1.0.0+ , hw-bits >= 0.4.0.0+ , hw-prim >= 0.4.0.0+ , hw-rankselect >= 0.8.0.0+ , hw-rankselect-base >= 0.2.0.0+ , mmap+ , vector+ , attoparsec , containers , hspec- , hw-balancedparens >=0.1.0.0- , hw-bits >=0.4.0.0- , hw-conduit >=0.1.0.0 , hw-json- , hw-prim >=0.4.0.0- , hw-rankselect >=0.8.0.0- , hw-rankselect-base >=0.2.0.0- , mmap- , parsec- , resourcet- , transformers- , vector+ if (flag(sse42))+ ghc-options: -mbmi2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED other-modules:- HaskellWorks.Data.Json.Conduit.BlankSpec HaskellWorks.Data.Json.CorpusSpec+ HaskellWorks.Data.Json.Internal.BlankSpec HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec HaskellWorks.Data.Json.Succinct.CursorSpec HaskellWorks.Data.Json.Token.TokenizeSpec HaskellWorks.Data.Json.TypeSpec HaskellWorks.Data.Json.ValueSpec- Paths_hw_json default-language: Haskell2010 benchmark bench@@ -171,20 +167,20 @@ bench ghc-options: -Wall -O2 -msse4.2 build-depends:- base >=4 && <5+ base >= 4 && <5 , bytestring- , conduit- , criterion- , hw-balancedparens >=0.1.0.0- , hw-bits >=0.4.0.0- , hw-conduit >=0.1.0.0- , hw-json- , hw-prim >=0.4.0.0- , hw-rankselect >=0.8.0.0- , hw-rankselect-base >=0.2.0.0+ , hw-balancedparens >= 0.1.0.0+ , hw-bits >= 0.4.0.0+ , hw-prim >= 0.4.0.0+ , hw-rankselect >= 0.8.0.0+ , hw-rankselect-base >= 0.2.0.0 , mmap- , resourcet , vector- other-modules:- Paths_hw_json+ , criterion+ , hw-json+ if (flag(sse42))+ ghc-options: -mbmi2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED default-language: Haskell2010
src/HaskellWorks/Data/Json.hs view
@@ -7,7 +7,6 @@ ( module X ) where -import HaskellWorks.Data.Json.Succinct as X-import HaskellWorks.Data.Json.Token as X-import HaskellWorks.Data.Json.Type as X-import HaskellWorks.Data.Json.Value as X+import HaskellWorks.Data.Json.Token as X+import HaskellWorks.Data.Json.Type as X+import HaskellWorks.Data.Json.Value as X
src/HaskellWorks/Data/Json/CharLike.hs view
@@ -2,7 +2,7 @@ import Data.Word import Data.Word8-import HaskellWorks.Data.Json.Conduit.Words+import HaskellWorks.Data.Json.Internal.Words class JsonCharLike c where isLeadingDigit2 :: c -> Bool
− src/HaskellWorks/Data/Json/Conduit.hs
@@ -1,170 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}--module HaskellWorks.Data.Json.Conduit- ( blankedJsonToInterestBits- , byteStringToBits- , blankedJsonToBalancedParens- , blankedJsonToBalancedParens2- , compressWordAsBit- , interestingWord8s- ) where--import Control.Monad-import Data.Array.Unboxed as A-import Data.ByteString as BS-import Data.Conduit-import Data.Int-import Data.Word-import Data.Word8-import HaskellWorks.Data.Bits.BitWise-import Prelude as P--import qualified Data.Bits as BITS--interestingWord8s :: A.UArray Word8 Word8-interestingWord8s = A.array (0, 255) [- (w, if w == _bracketleft || w == _braceleft || w == _parenleft || w == _t || w == _f || w == _n || w == _1- then 1- else 0)- | w <- [0 .. 255]]--blankedJsonToInterestBits :: Monad m => ConduitT BS.ByteString BS.ByteString m ()-blankedJsonToInterestBits = blankedJsonToInterestBits' ""--padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString-padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs)- where gen :: ByteString -> Maybe (Word8, ByteString)- gen cs = case BS.uncons cs of- Just (c, ds) -> Just (c, ds)- Nothing -> Just (w, BS.empty)--blankedJsonToInterestBits' :: Monad m => BS.ByteString -> ConduitT BS.ByteString BS.ByteString m ()-blankedJsonToInterestBits' rs = do- mbs <- await- case mbs of- Just bs -> do- let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs- let lencs = BS.length cs- let q = lencs + 7 `quot` 8- let (ds, es) = BS.splitAt (q * 8) cs- let (fs, _) = BS.unfoldrN q gen ds- yield fs- blankedJsonToInterestBits' es- Nothing -> return ()- where gen :: ByteString -> Maybe (Word8, ByteString)- gen as = if BS.length as == 0- then Nothing- else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 as))- , BS.drop 8 as- )--blankedJsonToBalancedParens :: Monad m => ConduitT BS.ByteString Bool m ()-blankedJsonToBalancedParens = do- mbs <- await- case mbs of- Just bs -> blankedJsonToBalancedParens' bs- Nothing -> return ()--blankedJsonToBalancedParens' :: Monad m => BS.ByteString -> ConduitT BS.ByteString Bool m ()-blankedJsonToBalancedParens' bs = case BS.uncons bs of- Just (c, cs) -> do- case c of- d | d == _braceleft -> yield True- d | d == _braceright -> yield False- d | d == _bracketleft -> yield True- d | d == _bracketright -> yield False- d | d == _parenleft -> yield True- d | d == _parenright -> yield False- d | d == _t -> yield True >> yield False- d | d == _f -> yield True >> yield False- d | d == _1 -> yield True >> yield False- d | d == _n -> yield True >> yield False- _ -> return ()- blankedJsonToBalancedParens' cs- Nothing -> return ()--repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)-repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS)- where abBS = BS.concat [aBS, bBS]- abLen = BS.length abBS- cLen = (abLen `div` 8) * 8--compressWordAsBit :: Monad m => ConduitT BS.ByteString BS.ByteString m ()-compressWordAsBit = compressWordAsBit' BS.empty--compressWordAsBit' :: Monad m => BS.ByteString -> ConduitT BS.ByteString BS.ByteString m ()-compressWordAsBit' aBS = do- mbBS <- await- case mbBS of- Just bBS -> do- let (cBS, dBS) = repartitionMod8 aBS bBS- let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS- yield cs- compressWordAsBit' dBS- Nothing -> do- let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS- yield cs- where gen :: ByteString -> Maybe (Word8, ByteString)- gen xs = if BS.length xs == 0- then Nothing- else Just ( BS.foldr (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (padRight 0 8 (BS.take 8 xs))- , BS.drop 8 xs- )--blankedJsonToBalancedParens2 :: Monad m => ConduitT BS.ByteString BS.ByteString m ()-blankedJsonToBalancedParens2 = do- mbs <- await- case mbs of- Just bs -> do- let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)- yield cs- blankedJsonToBalancedParens2- Nothing -> return ()- where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))- gen (Just True , bs) = Just (0xFF, (Nothing, bs))- gen (Just False , bs) = Just (0x00, (Nothing, bs))- gen (Nothing , bs) = case BS.uncons bs of- Just (c, cs) -> case balancedParensOf c of- MiniN -> gen (Nothing , cs)- MiniT -> Just (0xFF, (Nothing , cs))- MiniF -> Just (0x00, (Nothing , cs))- MiniTF -> Just (0xFF, (Just False , cs))- Nothing -> Nothing--data MiniBP = MiniN | MiniT | MiniF | MiniTF--balancedParensOf :: Word8 -> MiniBP-balancedParensOf c = case c of- d | d == _braceleft -> MiniT- d | d == _braceright -> MiniF- d | d == _bracketleft -> MiniT- d | d == _bracketright -> MiniF- d | d == _parenleft -> MiniT- d | d == _parenright -> MiniF- d | d == _t -> MiniTF- d | d == _f -> MiniTF- d | d == _1 -> MiniTF- d | d == _n -> MiniTF- _ -> MiniN--yieldBitsOfWord8 :: Monad m => Word8 -> ConduitT BS.ByteString Bool m ()-yieldBitsOfWord8 w = do- yield ((w .&. BITS.bit 0) /= 0)- yield ((w .&. BITS.bit 1) /= 0)- yield ((w .&. BITS.bit 2) /= 0)- yield ((w .&. BITS.bit 3) /= 0)- yield ((w .&. BITS.bit 4) /= 0)- yield ((w .&. BITS.bit 5) /= 0)- yield ((w .&. BITS.bit 6) /= 0)- yield ((w .&. BITS.bit 7) /= 0)--yieldBitsofWord8s :: Monad m => [Word8] -> ConduitT BS.ByteString Bool m ()-yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) (return ())--byteStringToBits :: Monad m => ConduitT BS.ByteString Bool m ()-byteStringToBits = do- mbs <- await- case mbs of- Just bs -> yieldBitsofWord8s (BS.unpack bs) >> byteStringToBits- Nothing -> return ()
− src/HaskellWorks/Data/Json/Conduit/Blank.hs
@@ -1,62 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module HaskellWorks.Data.Json.Conduit.Blank- ( blankJson- ) where--import Control.Monad-import Control.Monad.Trans.Resource (MonadThrow)-import Data.ByteString as BS-import Data.Conduit-import Data.Word-import Data.Word8-import HaskellWorks.Data.Json.Conduit.Words-import Prelude as P--data BlankState- = Escaped- | InJson- | InString- | InNumber- | InIdent--blankJson :: MonadThrow m => ConduitT BS.ByteString BS.ByteString m ()-blankJson = blankJson' InJson--blankJson' :: MonadThrow m => BlankState -> ConduitT BS.ByteString BS.ByteString m ()-blankJson' lastState = do- mbs <- await- case mbs of- Just bs -> do- let (!cs, Just (!nextState, _)) = unfoldrN (BS.length bs) blankByteString (lastState, bs)- yield cs- blankJson' nextState- Nothing -> return ()- where- blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))- blankByteString (InJson, bs) = case BS.uncons bs of- Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs))- Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))- Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs))- Just (!c, !cs) -> Just (c , (InJson , cs))- Nothing -> Nothing- blankByteString (InString, bs) = case BS.uncons bs of- Just (!c, !cs) | c == _backslash -> Just (_space , (Escaped , cs))- Just (!c, !cs) | c == _quotedbl -> Just (_parenright , (InJson , cs))- Just (_ , !cs) -> Just (_space , (InString , cs))- Nothing -> Nothing- blankByteString (Escaped, bs) = case BS.uncons bs of- Just (_, !cs) -> Just (_space, (InString, cs))- Nothing -> Nothing- blankByteString (InNumber, bs) = case BS.uncons bs of- Just (!c, !cs) | isTrailingDigit c -> Just (_0 , (InNumber , cs))- Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))- Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs))- Just (!c, !cs) -> Just (c , (InJson , cs))- Nothing -> Nothing- blankByteString (InIdent, bs) = case BS.uncons bs of- Just (!c, !cs) | isAlphabetic c -> Just (_underscore , (InIdent , cs))- Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs))- Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))- Just (!c, !cs) -> Just (c , (InJson , cs))- Nothing -> Nothing
− src/HaskellWorks/Data/Json/Conduit/Words.hs
@@ -1,13 +0,0 @@-module HaskellWorks.Data.Json.Conduit.Words where--import Data.Word-import Data.Word8--isLeadingDigit :: Word8 -> Bool-isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9)--isTrailingDigit :: Word8 -> Bool-isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e--isAlphabetic :: Word8 -> Bool-isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)
+ src/HaskellWorks/Data/Json/Internal/Blank.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Json.Internal.Blank+ ( blankJson+ ) where++import Data.ByteString as BS+import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Internal.Words+import Prelude as P++data BlankState+ = Escaped+ | InJson+ | InString+ | InNumber+ | InIdent++blankJson :: [BS.ByteString] -> [BS.ByteString]+blankJson = blankJson' InJson++blankJson' :: BlankState -> [BS.ByteString] -> [BS.ByteString]+blankJson' lastState as = case as of+ (bs:bss) ->+ let (!cs, Just (!nextState, _)) = unfoldrN (BS.length bs) blankByteString (lastState, bs) in+ cs:blankJson' nextState bss+ [] -> []+ where+ blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))+ blankByteString (InJson, bs) = case BS.uncons bs of+ Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs))+ Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))+ Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs))+ Just (!c, !cs) -> Just (c , (InJson , cs))+ Nothing -> Nothing+ blankByteString (InString, bs) = case BS.uncons bs of+ Just (!c, !cs) | c == _backslash -> Just (_space , (Escaped , cs))+ Just (!c, !cs) | c == _quotedbl -> Just (_parenright , (InJson , cs))+ Just (_ , !cs) -> Just (_space , (InString , cs))+ Nothing -> Nothing+ blankByteString (Escaped, bs) = case BS.uncons bs of+ Just (_, !cs) -> Just (_space, (InString, cs))+ Nothing -> Nothing+ blankByteString (InNumber, bs) = case BS.uncons bs of+ Just (!c, !cs) | isTrailingDigit c -> Just (_0 , (InNumber , cs))+ Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))+ Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs))+ Just (!c, !cs) -> Just (c , (InJson , cs))+ Nothing -> Nothing+ blankByteString (InIdent, bs) = case BS.uncons bs of+ Just (!c, !cs) | isAlphabetic c -> Just (_underscore , (InIdent , cs))+ Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs))+ Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs))+ Just (!c, !cs) -> Just (c , (InJson , cs))+ Nothing -> Nothing
+ src/HaskellWorks/Data/Json/Internal/MakeIndex.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module HaskellWorks.Data.Json.Internal.MakeIndex+ ( blankedJsonToInterestBits+ , byteStringToBits+ , blankedJsonToBalancedParens+ , blankedJsonToBalancedParens2+ , compressWordAsBit+ , interestingWord8s+ ) where++import Control.Monad+import Data.Array.Unboxed ((!))+import Data.ByteString (ByteString)+import Data.Int+import Data.Word+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import Prelude as P++import qualified Data.Array.Unboxed as A+import qualified Data.Bits as BITS+import qualified Data.ByteString as BS++interestingWord8s :: A.UArray Word8 Word8+interestingWord8s = A.array (0, 255) [+ (w, if w == _bracketleft || w == _braceleft || w == _parenleft || w == _t || w == _f || w == _n || w == _1+ then 1+ else 0)+ | w <- [0 .. 255]]++blankedJsonToInterestBits :: [BS.ByteString] -> [BS.ByteString]+blankedJsonToInterestBits = blankedJsonToInterestBits' ""++padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString+padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs)+ where gen :: ByteString -> Maybe (Word8, ByteString)+ gen cs = case BS.uncons cs of+ Just (c, ds) -> Just (c, ds)+ Nothing -> Just (w, BS.empty)++blankedJsonToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]+blankedJsonToInterestBits' rs as = case as of+ (bs:bss) ->+ let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs in+ let lencs = BS.length cs in+ let q = lencs + 7 `quot` 8 in+ let (ds, es) = BS.splitAt (q * 8) cs in+ let (fs, _) = BS.unfoldrN q gen ds in+ fs:blankedJsonToInterestBits' es bss+ [] -> []+ where gen :: ByteString -> Maybe (Word8, ByteString)+ gen ds = if BS.length ds == 0+ then Nothing+ else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 ds))+ , BS.drop 8 ds+ )++blankedJsonToBalancedParens :: [BS.ByteString] -> [Bool]+blankedJsonToBalancedParens (as) = case as of+ (bs:bss) -> blankedJsonToBalancedParens' bs bss []+ [] -> []++blankedJsonToBalancedParens' :: BS.ByteString -> [BS.ByteString] -> ([Bool] -> [Bool])+blankedJsonToBalancedParens' bs = case BS.uncons bs of+ Just (c, cs) -> do+ let t = case c of+ d | d == _braceleft -> (True:)+ d | d == _braceright -> (False:)+ d | d == _bracketleft -> (True:)+ d | d == _bracketright -> (False:)+ d | d == _parenleft -> (True:)+ d | d == _parenright -> (False:)+ d | d == _t -> (True:) . (False:)+ d | d == _f -> (True:) . (False:)+ d | d == _1 -> (True:) . (False:)+ d | d == _n -> (True:) . (False:)+ _ -> id+ (t .) . blankedJsonToBalancedParens' cs+ Nothing -> const id++repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)+repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS)+ where abBS = BS.concat [aBS, bBS]+ abLen = BS.length abBS+ cLen = (abLen `div` 8) * 8++compressWordAsBit :: [BS.ByteString] -> [BS.ByteString]+compressWordAsBit = compressWordAsBit' BS.empty++compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]+compressWordAsBit' aBS as = case as of+ (bBS:bBSs) ->+ let (cBS, dBS) = repartitionMod8 aBS bBS in+ let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS in+ cs:compressWordAsBit' dBS bBSs+ [] -> do+ let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS+ [cs]+ where gen :: ByteString -> Maybe (Word8, ByteString)+ gen xs = if BS.length xs == 0+ then Nothing+ else Just ( BS.foldr (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (padRight 0 8 (BS.take 8 xs))+ , BS.drop 8 xs+ )++blankedJsonToBalancedParens2 :: [BS.ByteString] -> [BS.ByteString]+blankedJsonToBalancedParens2 as = case as of+ (bs:bss) ->+ let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs) in+ cs:blankedJsonToBalancedParens2 bss+ [] -> []+ where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))+ gen (Just True , bs) = Just (0xFF, (Nothing, bs))+ gen (Just False , bs) = Just (0x00, (Nothing, bs))+ gen (Nothing , bs) = case BS.uncons bs of+ Just (c, cs) -> case balancedParensOf c of+ MiniN -> gen (Nothing , cs)+ MiniT -> Just (0xFF, (Nothing , cs))+ MiniF -> Just (0x00, (Nothing , cs))+ MiniTF -> Just (0xFF, (Just False , cs))+ Nothing -> Nothing++data MiniBP = MiniN | MiniT | MiniF | MiniTF++balancedParensOf :: Word8 -> MiniBP+balancedParensOf c = case c of+ d | d == _braceleft -> MiniT+ d | d == _braceright -> MiniF+ d | d == _bracketleft -> MiniT+ d | d == _bracketright -> MiniF+ d | d == _parenleft -> MiniT+ d | d == _parenright -> MiniF+ d | d == _t -> MiniTF+ d | d == _f -> MiniTF+ d | d == _1 -> MiniTF+ d | d == _n -> MiniTF+ _ -> MiniN++yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool]+yieldBitsOfWord8 w =+ (((w .&. BITS.bit 0) /= 0):) .+ (((w .&. BITS.bit 1) /= 0):) .+ (((w .&. BITS.bit 2) /= 0):) .+ (((w .&. BITS.bit 3) /= 0):) .+ (((w .&. BITS.bit 4) /= 0):) .+ (((w .&. BITS.bit 5) /= 0):) .+ (((w .&. BITS.bit 6) /= 0):) .+ (((w .&. BITS.bit 7) /= 0):)++yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool]+yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) id++byteStringToBits :: [BS.ByteString] -> [Bool] -> [Bool]+byteStringToBits as = case as of+ (bs:bss) -> yieldBitsofWord8s (BS.unpack bs) . byteStringToBits bss+ [] -> id
+ src/HaskellWorks/Data/Json/Internal/Words.hs view
@@ -0,0 +1,13 @@+module HaskellWorks.Data.Json.Internal.Words where++import Data.Word+import Data.Word8++isLeadingDigit :: Word8 -> Bool+isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9)++isTrailingDigit :: Word8 -> Bool+isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e++isAlphabetic :: Word8 -> Bool+isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)
src/HaskellWorks/Data/Json/LightJson.hs view
@@ -17,8 +17,8 @@ import HaskellWorks.Data.Drop import HaskellWorks.Data.Entry import HaskellWorks.Data.Json.CharLike-import HaskellWorks.Data.Json.Conduit.Words-import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Json.Internal.Words+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Micro import HaskellWorks.Data.Mini import HaskellWorks.Data.MQuery@@ -29,7 +29,7 @@ import HaskellWorks.Data.Row import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons-import Prelude hiding (drop)+import Prelude hiding (drop) import Text.PrettyPrint.ANSI.Leijen import qualified Data.Attoparsec.ByteString.Char8 as ABC
src/HaskellWorks/Data/Json/Load.hs view
@@ -25,7 +25,7 @@ import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.PartialValue-import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Json.Succinct.Index import HaskellWorks.Data.Json.Succinct.PartialIndex import HaskellWorks.Data.Json.Value
src/HaskellWorks/Data/Json/LoadCursor.hs view
@@ -22,7 +22,7 @@ import HaskellWorks.Data.FromByteString import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Json.Succinct.Index import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.CsPoppy
src/HaskellWorks/Data/Json/PartialValue.hs view
@@ -24,7 +24,7 @@ import HaskellWorks.Data.AtLeastSize import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Entry-import HaskellWorks.Data.Json.Succinct.Cursor+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Json.Succinct.PartialIndex import HaskellWorks.Data.Json.Value.Internal import HaskellWorks.Data.Micro
− src/HaskellWorks/Data/Json/Succinct.hs
@@ -1,5 +0,0 @@-module HaskellWorks.Data.Json.Succinct- ( module X- ) where--import HaskellWorks.Data.Json.Succinct.Cursor as X
− src/HaskellWorks/Data/Json/Succinct/Cursor.hs
@@ -1,7 +0,0 @@--module HaskellWorks.Data.Json.Succinct.Cursor- ( module X- ) where--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
@@ -9,11 +9,9 @@ ) where import Control.Applicative-import Data.Conduit import Data.Word import HaskellWorks.Data.BalancedParens as BP-import HaskellWorks.Data.Conduit.List-import HaskellWorks.Data.Json.Conduit+import HaskellWorks.Data.Json.Internal.MakeIndex import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import qualified Data.ByteString as BS@@ -29,24 +27,24 @@ {-# INLINE genBitWordsForever #-} instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens [Bool])) where- fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (runListConduit blankedJsonToBalancedParens bj))+ fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (blankedJsonToBalancedParens bj)) instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))- where bpBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 .| compressWordAsBit) (getBlankedJson bj))+ where bpBS = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj)) newLen = (BS.length bpBS + 7) `div` 8 * 8 instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))- where bpBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 .| compressWordAsBit) (getBlankedJson bj))+ where bpBS = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj)) newLen = (BS.length bpBS + 7) `div` 8 * 8 instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))- where bpBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 .| compressWordAsBit) (getBlankedJson bj))+ where bpBS = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj)) newLen = (BS.length bpBS + 7) `div` 8 * 8 instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where fromBlankedJson bj = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS)))- where bpBS = BS.concat (runListConduit (blankedJsonToBalancedParens2 .| compressWordAsBit) (getBlankedJson bj))+ where bpBS = BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson bj)) newLen = (BS.length bpBS + 7) `div` 8 * 8
src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs view
@@ -6,9 +6,8 @@ ) where import HaskellWorks.Data.ByteString-import HaskellWorks.Data.Conduit.List import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Conduit.Blank+import HaskellWorks.Data.Json.Internal.Blank import qualified Data.ByteString as BS @@ -21,4 +20,4 @@ fromBlankedJson :: BlankedJson -> a instance FromByteString BlankedJson where- fromByteString bs = BlankedJson (runListConduit blankJson (chunkedBy 4064 bs))+ fromByteString bs = BlankedJson (blankJson (chunkedBy 4064 bs))
src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs view
@@ -12,9 +12,8 @@ import Data.ByteString.Internal import Data.Word import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Conduit.List import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Conduit+import HaskellWorks.Data.Json.Internal.MakeIndex import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import HaskellWorks.Data.RankSelect.Poppy512 @@ -27,7 +26,7 @@ getJsonInterestBits (JsonInterestBits a) = a blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString-blankedJsonBssToInterestBitsBs bss = BS.concat $ runListConduit blankedJsonToInterestBits bss+blankedJsonBssToInterestBitsBs bss = BS.concat $ blankedJsonToInterestBits bss genInterest :: ByteString -> Maybe (Word8, ByteString) genInterest = BS.uncons@@ -36,7 +35,7 @@ genInterestForever bs = BS.uncons bs <|> Just (0, bs) instance FromBlankedJson (JsonInterestBits (BitShown [Bool])) where- fromBlankedJson = JsonInterestBits . fromByteString . BS.concat . runListConduit blankedJsonToInterestBits . getBlankedJson+ fromBlankedJson = JsonInterestBits . fromByteString . BS.concat . blankedJsonToInterestBits . getBlankedJson instance FromBlankedJson (JsonInterestBits (BitShown BS.ByteString)) where fromBlankedJson = JsonInterestBits . BitShown . BS.unfoldr genInterest . blankedJsonBssToInterestBitsBs . getBlankedJson
src/HaskellWorks/Data/Json/Succinct/Index.hs view
@@ -12,14 +12,14 @@ import HaskellWorks.Data.Drop import HaskellWorks.Data.Json.CharLike import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons-import Prelude hiding (drop)+import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified Data.List as L
src/HaskellWorks/Data/Json/Succinct/PartialIndex.hs view
@@ -11,14 +11,14 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop import HaskellWorks.Data.Json.CharLike-import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons-import Prelude hiding (drop)+import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified Data.List as L
src/HaskellWorks/Data/Json/Token/Tokenize.hs view
@@ -24,22 +24,22 @@ import qualified Data.Attoparsec.Types as T import qualified Data.ByteString as BS -hexDigitNumeric :: P.Parser t => T.Parser t Int+hexDigitNumeric :: P.Parser t u => T.Parser t Int hexDigitNumeric = do c <- satisfyChar (\c -> '0' <= c && c <= '9') return $ ord c - ord '0' -hexDigitAlphaLower :: P.Parser t => T.Parser t Int+hexDigitAlphaLower :: P.Parser t u => T.Parser t Int hexDigitAlphaLower = do c <- satisfyChar (\c -> 'a' <= c && c <= 'z') return $ ord c - ord 'a' + 10 -hexDigitAlphaUpper :: P.Parser t => T.Parser t Int+hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int hexDigitAlphaUpper = do c <- satisfyChar (\c -> 'A' <= c && c <= 'Z') return $ ord c - ord 'A' + 10 -hexDigit :: P.Parser t => T.Parser t Int+hexDigit :: P.Parser t u => T.Parser t Int hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper class ParseJson t s d where
src/HaskellWorks/Data/Json/Type.hs view
@@ -11,12 +11,12 @@ import Data.Word8 import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop-import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1-import Prelude hiding (drop)+import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified HaskellWorks.Data.BalancedParens as BP
src/HaskellWorks/Data/Json/Value/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -16,25 +17,25 @@ import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.Attoparsec.Types as T -parseHexDigitNumeric :: P.Parser t => T.Parser t Int+parseHexDigitNumeric :: P.Parser t u => T.Parser t Int parseHexDigitNumeric = do c <- satisfyChar (\c -> '0' <= c && c <= '9') return $ ord c - ord '0' -parseHexDigitAlphaLower :: P.Parser t => T.Parser t Int+parseHexDigitAlphaLower :: P.Parser t u => T.Parser t Int parseHexDigitAlphaLower = do c <- satisfyChar (\c -> 'a' <= c && c <= 'z') return $ ord c - ord 'a' + 10 -parseHexDigitAlphaUpper :: P.Parser t => T.Parser t Int+parseHexDigitAlphaUpper :: P.Parser t u => T.Parser t Int parseHexDigitAlphaUpper = do c <- satisfyChar (\c -> 'A' <= c && c <= 'Z') return $ ord c - ord 'A' + 10 -parseHexDigit :: P.Parser t => T.Parser t Int+parseHexDigit :: P.Parser t u => T.Parser t Int parseHexDigit = parseHexDigitNumeric <|> parseHexDigitAlphaLower <|> parseHexDigitAlphaUpper -parseJsonString :: (P.Parser t, IsString t) => T.Parser t String+parseJsonString :: (P.Parser t u, IsString t) => T.Parser t String parseJsonString = do _ <- string "\"" value <- many (verbatimChar <|> escapedChar <|> escapedCode)
− test/HaskellWorks/Data/Json/Conduit/BlankSpec.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Json.Conduit.BlankSpec (spec) where--import HaskellWorks.Data.Conduit.List-import HaskellWorks.Data.Json.Conduit.Blank-import Test.Hspec--import qualified Data.ByteString as BS--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}--whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec-whenBlankedJsonShouldBe original expected = do- it (show original ++ " when blanked json should be " ++ show expected) $ do- BS.concat (runListConduit blankJson [original]) `shouldBe` expected--spec :: Spec-spec = describe "HaskellWorks.Data.Json.Conduit.BlankSpec" $ do- describe "Can blank json" $ do- "\"\"" `whenBlankedJsonShouldBe` "()"- "\"\\\\\"" `whenBlankedJsonShouldBe` "( )"- "\"\\\\\\\"" `whenBlankedJsonShouldBe` "( "- "\" \\\\\\\"" `whenBlankedJsonShouldBe` "( "- "\" \\n\\\\\"" `whenBlankedJsonShouldBe` "( )"- "" `whenBlankedJsonShouldBe` ""- "\"\"" `whenBlankedJsonShouldBe` "()"- "\" \"" `whenBlankedJsonShouldBe` "( )"- "\" a \"" `whenBlankedJsonShouldBe` "( )"- " \"a \" x" `whenBlankedJsonShouldBe` " ( ) x"- " \"\"\"\" " `whenBlankedJsonShouldBe` " ()() "- " [][] " `whenBlankedJsonShouldBe` " [][] "- " {}{} " `whenBlankedJsonShouldBe` " {}{} "- " \"a\"b\"c\"d" `whenBlankedJsonShouldBe` " ( )b( )d"- "" `whenBlankedJsonShouldBe` ""- "1" `whenBlankedJsonShouldBe` "1"- "11" `whenBlankedJsonShouldBe` "10"- "00" `whenBlankedJsonShouldBe` "10"- "00" `whenBlankedJsonShouldBe` "10"- "-0.12e+34" `whenBlankedJsonShouldBe` "100000000"- "10.12E-34 " `whenBlankedJsonShouldBe` "100000000 "- "10.12E-34 12" `whenBlankedJsonShouldBe` "100000000 10"- " 10.12E-34 -1" `whenBlankedJsonShouldBe` " 100000000 10"- "" `whenBlankedJsonShouldBe` ""- "a" `whenBlankedJsonShouldBe` "a"- "z" `whenBlankedJsonShouldBe` "z"- " Aaa " `whenBlankedJsonShouldBe` " A__ "- " Za def " `whenBlankedJsonShouldBe` " Z_ d__ "- "" `whenBlankedJsonShouldBe` ""- " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { ( ): 100, [(), t___], n___}"
test/HaskellWorks/Data/Json/CorpusSpec.hs view
@@ -17,7 +17,7 @@ import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import Test.Hspec import qualified Data.ByteString as BS
+ test/HaskellWorks/Data/Json/Internal/BlankSpec.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Internal.BlankSpec (spec) where++import HaskellWorks.Data.Json.Internal.Blank+import Test.Hspec++import qualified Data.ByteString as BS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec+whenBlankedJsonShouldBe original expected = do+ it (show original ++ " when blanked json should be " ++ show expected) $ do+ BS.concat (blankJson [original]) `shouldBe` expected++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Internal.BlankSpec" $ do+ describe "Can blank json" $ do+ "\"\"" `whenBlankedJsonShouldBe` "()"+ "\"\\\\\"" `whenBlankedJsonShouldBe` "( )"+ "\"\\\\\\\"" `whenBlankedJsonShouldBe` "( "+ "\" \\\\\\\"" `whenBlankedJsonShouldBe` "( "+ "\" \\n\\\\\"" `whenBlankedJsonShouldBe` "( )"+ "" `whenBlankedJsonShouldBe` ""+ "\"\"" `whenBlankedJsonShouldBe` "()"+ "\" \"" `whenBlankedJsonShouldBe` "( )"+ "\" a \"" `whenBlankedJsonShouldBe` "( )"+ " \"a \" x" `whenBlankedJsonShouldBe` " ( ) x"+ " \"\"\"\" " `whenBlankedJsonShouldBe` " ()() "+ " [][] " `whenBlankedJsonShouldBe` " [][] "+ " {}{} " `whenBlankedJsonShouldBe` " {}{} "+ " \"a\"b\"c\"d" `whenBlankedJsonShouldBe` " ( )b( )d"+ "" `whenBlankedJsonShouldBe` ""+ "1" `whenBlankedJsonShouldBe` "1"+ "11" `whenBlankedJsonShouldBe` "10"+ "00" `whenBlankedJsonShouldBe` "10"+ "00" `whenBlankedJsonShouldBe` "10"+ "-0.12e+34" `whenBlankedJsonShouldBe` "100000000"+ "10.12E-34 " `whenBlankedJsonShouldBe` "100000000 "+ "10.12E-34 12" `whenBlankedJsonShouldBe` "100000000 10"+ " 10.12E-34 -1" `whenBlankedJsonShouldBe` " 100000000 10"+ "" `whenBlankedJsonShouldBe` ""+ "a" `whenBlankedJsonShouldBe` "a"+ "z" `whenBlankedJsonShouldBe` "z"+ " Aaa " `whenBlankedJsonShouldBe` " A__ "+ " Za def " `whenBlankedJsonShouldBe` " Z_ d__ "+ "" `whenBlankedJsonShouldBe` ""+ " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { ( ): 100, [(), t___], n___}"
test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs view
@@ -3,11 +3,9 @@ module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec(spec) where -import Data.Conduit import Data.String import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Conduit.List-import HaskellWorks.Data.Json.Conduit+import HaskellWorks.Data.Json.Internal.MakeIndex import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import Test.Hspec @@ -19,9 +17,9 @@ spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec" $ do it "Blanking JSON should not contain strange characters 1" $ do let blankedJson = BlankedJson ["[ [],", "[]]"]- let bp = BitShown $ BS.concat (runListConduit blankedJsonToBalancedParens2 (getBlankedJson blankedJson))+ let bp = BitShown $ BS.concat (blankedJsonToBalancedParens2 (getBlankedJson blankedJson)) bp `shouldBe` fromString "11111111 11111111 00000000 11111111 00000000 00000000" it "Blanking JSON should not contain strange characters 2" $ do let blankedJson = BlankedJson ["[ [],", "[]]"]- let bp = BitShown $ BS.concat (runListConduit (blankedJsonToBalancedParens2 .| compressWordAsBit) (getBlankedJson blankedJson))+ let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens2) (getBlankedJson blankedJson)) bp `shouldBe` fromString "11010000"
test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs view
@@ -20,7 +20,8 @@ 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.Succinct.Cursor.Internal+import HaskellWorks.Data.Json.Succinct.Cursor.Token import HaskellWorks.Data.Json.Succinct.Index import HaskellWorks.Data.Json.Token import HaskellWorks.Data.RankSelect.Base.Rank0
test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs view
@@ -14,7 +14,7 @@ parseJsonToken' = BC.parseOnly parseJsonToken spec :: Spec-spec = describe "Data.Conduit.Succinct.JsonSpec" $ do+spec = describe "HaskellWorks.Data.Json.Token.TokenizeSpec" $ do describe "When parsing single token at beginning of text" $ do it "Empty Json should produce no bits" $ parseJsonToken' "" `shouldBe` Left "not enough input"
test/HaskellWorks/Data/Json/TypeSpec.hs view
@@ -19,7 +19,7 @@ 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.Succinct.Cursor.Internal import HaskellWorks.Data.Json.Type import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1
test/HaskellWorks/Data/Json/ValueSpec.hs view
@@ -20,7 +20,7 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.DecodeError-import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Succinct.Cursor.Internal import HaskellWorks.Data.Json.Succinct.Index import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.Base.Rank0