hw-json 0.0.0.1 → 0.0.0.2
raw patch · 9 files changed
+270/−9 lines, 9 filesdep +arraydep ~hw-conduit
Dependencies added: array
Dependency ranges changed: hw-conduit
Files
- bench/Main.hs +28/−4
- hw-json.cabal +7/−1
- src/HaskellWorks/Data/Json/Conduit.hs +155/−0
- src/HaskellWorks/Data/Json/Conduit/Blank.hs +63/−0
- src/HaskellWorks/Data/Json/Conduit/Words.hs +13/−0
- src/HaskellWorks/Data/Json/Extract.hs +1/−1
- src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +1/−1
- src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs +1/−1
- src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs +1/−1
bench/Main.hs view
@@ -4,13 +4,18 @@ 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.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 HaskellWorks.Data.Positioning import HaskellWorks.Data.Succinct.BalancedParens.Simple@@ -47,31 +52,50 @@ ] ] +runCon :: Conduit i [] BS.ByteString -> i -> BS.ByteString+runCon con bs = BS.concat $ runListConduit con [bs]++runCon2 :: Conduit i [] o -> [i] -> [o]+runCon2 con is = let os = runListConduit con is in seq (length os) os++runCon3 :: Conduit i [] BS.ByteString -> [i] -> [BS.ByteString]+runCon3 con is = let os = runListConduit con is in seq (BS.length (last os)) os++jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString+jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits+ benchRankJson40Conduits :: [Benchmark] benchRankJson40Conduits = [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "Json40"- [ bench "loadJson " (whnf loadJson bs)+ [ bench "Run blankJson " (whnf (runCon blankJson ) bs)+ , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)+ , bench "loadJson " (whnf loadJson bs) ] ] benchRankJson80Conduits :: [Benchmark] benchRankJson80Conduits = [ env (setupEnvJson "/Users/jky/Downloads/part80.json") $ \bs -> bgroup "Json40"- [ bench "loadJson" (whnf loadJson bs)+ [ bench "Run blankJson " (whnf (runCon blankJson ) bs)+ , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)+ , bench "loadJson" (whnf loadJson bs) ] ] benchRankJsonBigConduits :: [Benchmark] benchRankJsonBigConduits = [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"- [ bench "loadJson" (whnf loadJson bs)+ [ bench "Run blankJson " (whnf (runCon blankJson ) bs)+ , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs)+ , bench "loadJson" (whnf loadJson bs) ] ] benchBlankedJsonToBalancedParens :: [Benchmark] benchBlankedJsonToBalancedParens = [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "JsonBig"- [ bench "loadJson" (whnf loadJson bs)+ [ bench "blankedJsonToBalancedParens2" (whnf (runCon2 blankedJsonToBalancedParens) [bs])+ , bench "blankedJsonToBalancedParens2" (whnf (runCon3 blankedJsonToBalancedParens2) [bs]) ] ]
hw-json.cabal view
@@ -1,5 +1,5 @@ name: hw-json-version: 0.0.0.1+version: 0.0.0.2 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-json#readme@@ -36,6 +36,9 @@ library hs-source-dirs: src exposed-modules: HaskellWorks.Data.Json+ , HaskellWorks.Data.Json.Conduit+ , HaskellWorks.Data.Json.Conduit.Blank+ , HaskellWorks.Data.Json.Conduit.Words , HaskellWorks.Data.Json.Extract , HaskellWorks.Data.Json.Succinct , HaskellWorks.Data.Json.Succinct.Cursor@@ -52,6 +55,7 @@ , HaskellWorks.Data.Json.Type , HaskellWorks.Data.Json.Value build-depends: base >= 4.7 && < 5+ , array , attoparsec , bytestring , conduit@@ -62,6 +66,7 @@ , hw-prim , hw-rankselect , mono-traversable+ , resourcet , text , vector , word8@@ -110,6 +115,7 @@ , conduit , criterion , hw-bits+ , hw-conduit , hw-json , hw-prim , hw-rankselect
+ src/HaskellWorks/Data/Json/Conduit.hs view
@@ -0,0 +1,155 @@+{-# 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 qualified Data.Bits as BITS+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++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 => Conduit BS.ByteString m 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' :: Monad m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString+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 => Conduit BS.ByteString m Bool+blankedJsonToBalancedParens = do+ mbs <- await+ case mbs of+ Just bs -> blankedJsonToBalancedParens' bs+ Nothing -> return ()++blankedJsonToBalancedParens' :: Monad m => BS.ByteString -> Conduit BS.ByteString m Bool+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 ()++compressWordAsBit :: Monad m => Conduit BS.ByteString m BS.ByteString+compressWordAsBit = do+ mbs <- await+ case mbs of+ Just bs -> do+ let (cs, _) = BS.unfoldrN (BS.length bs + 7 `div` 8) gen bs+ yield cs+ Nothing -> return ()+ 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 => Conduit BS.ByteString m BS.ByteString+blankedJsonToBalancedParens2 = do+ mbs <- await+ case mbs of+ Just bs -> do+ let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)+ yield cs+ 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 -> Conduit BS.ByteString m Bool+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] -> Conduit BS.ByteString m Bool+yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) (return ())++byteStringToBits :: Monad m => Conduit BS.ByteString m Bool+byteStringToBits = do+ mbs <- await+ case mbs of+ Just bs -> yieldBitsofWord8s (BS.unpack bs) >> byteStringToBits+ Nothing -> return ()
+ src/HaskellWorks/Data/Json/Conduit/Blank.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++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 => Conduit BS.ByteString m BS.ByteString+blankJson = blankJson' InJson++blankJson' :: MonadThrow m => BlankState -> Conduit BS.ByteString m BS.ByteString+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 view
@@ -0,0 +1,13 @@+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/Extract.hs view
@@ -6,7 +6,7 @@ import qualified Data.ByteString as BS import Data.Word8-import HaskellWorks.Data.Conduit.Json.Words+import HaskellWorks.Data.Json.Conduit.Words import HaskellWorks.Data.Json.Type data ExtractJsonState
src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs view
@@ -13,8 +13,8 @@ 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.Conduit import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import HaskellWorks.Data.Succinct.BalancedParens as BP
src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs view
@@ -7,9 +7,9 @@ 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+import HaskellWorks.Data.Json.Conduit.Blank newtype BlankedJson = BlankedJson [BS.ByteString] deriving (Eq, Show)
src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs view
@@ -14,9 +14,9 @@ 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.Conduit import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512