hw-conduit 0.0.0.10 → 0.0.0.11

raw patch · 6 files changed

+2/−333 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bench/Main.hs +1/−50
• hw-conduit.cabal +1/−6
• src/HaskellWorks/Data/Conduit/Json.hs +0/−155
• src/HaskellWorks/Data/Conduit/Json/Blank.hs +0/−63
• src/HaskellWorks/Data/Conduit/Json/Words.hs +0/−13
• test/HaskellWorks/Data/Conduit/Json/BlankSpec.hs +0/−46

@@ -3,17 +3,13 @@  module Main where -import           Control.Monad.Trans.Resource                        (MonadThrow) import           Criterion.Main import qualified Data.ByteString                                     as BS import qualified Data.ByteString.Internal                            as BSI-import           Data.Conduit                                        (Conduit, (=$=)) import qualified Data.Vector.Storable                                as DVS import           Data.Word import           Foreign import           HaskellWorks.Data.Conduit.ByteString-import           HaskellWorks.Data.Conduit.Json-import           HaskellWorks.Data.Conduit.Json.Blank import           HaskellWorks.Data.Conduit.List import           System.IO.MMap @@ -35,51 +31,6 @@   let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size   return bs -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 "Run blankJson                    "  (whnf (runCon blankJson                  ) bs)-    , bench "Run jsonToInterestBits3          "  (whnf (runCon jsonToInterestBits3        ) bs)-    ]-  ]--benchRankJson80Conduits :: [Benchmark]-benchRankJson80Conduits =-  [ env (setupEnvJson "/Users/jky/Downloads/part80.json") $ \bs -> bgroup "Json40"-    [ bench "Run blankJson                    "  (whnf (runCon blankJson                  ) bs)-    , bench "Run jsonToInterestBits3          "  (whnf (runCon jsonToInterestBits3        ) bs)-    ]-  ]--benchRankJsonBigConduits :: [Benchmark]-benchRankJsonBigConduits =-  [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"-    [ bench "Run blankJson                    "  (whnf (runCon blankJson                  ) bs)-    , bench "Run jsonToInterestBits3          "  (whnf (runCon jsonToInterestBits3        ) bs)-    ]-  ]--benchBlankedJsonToBalancedParens :: [Benchmark]-benchBlankedJsonToBalancedParens =-  [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "JsonBig"-    [ bench "blankedJsonToBalancedParens2" (whnf (runCon2 blankedJsonToBalancedParens) [bs])-    , bench "blankedJsonToBalancedParens2" (whnf (runCon3 blankedJsonToBalancedParens2) [bs])-    , bench "blankedJsonToBalancedParens2" (whnf (runCon3 (blankedJsonToBalancedParens2 =$= rechunk 4060)) [bs])-    ]-  ]- benchRechunk :: [Benchmark] benchRechunk =   [ env (setupEnvBss 4060 19968) $ \bss -> bgroup "Rank"@@ -88,4 +39,4 @@   ]  main :: IO ()-main = defaultMain benchRankJson40Conduits+main = defaultMain benchRechunk

@@ -1,5 +1,5 @@ name:                   hw-conduit-version:                0.0.0.10+version:                0.0.0.11 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-conduit#readme@@ -25,9 +25,6 @@ library   hs-source-dirs:       src   exposed-modules:      HaskellWorks.Data.Conduit.ByteString-                      , HaskellWorks.Data.Conduit.Json-                      , HaskellWorks.Data.Conduit.Json.Blank-                      , HaskellWorks.Data.Conduit.Json.Words                       , HaskellWorks.Data.Conduit.List   build-depends:        base              >= 4.7  && < 5                       , array@@ -45,7 +42,6 @@   hs-source-dirs:       test   main-is:              Spec.hs   other-modules:        HaskellWorks.Data.Conduit.ByteStringSpec-                      , HaskellWorks.Data.Conduit.Json.BlankSpec   build-depends:        base                       , bytestring                       , hspec@@ -69,5 +65,4 @@                       , criterion                       , hw-conduit                       , mmap-                      , resourcet                       , vector

@@ -1,155 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}--module HaskellWorks.Data.Conduit.Json-  ( 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 ()

@@ -1,63 +0,0 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Conduit.Json.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.Conduit.Json.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

@@ -1,13 +0,0 @@-module HaskellWorks.Data.Conduit.Json.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)

@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Conduit.Json.BlankSpec (spec) where--import qualified Data.ByteString                      as BS-import           HaskellWorks.Data.Conduit.Json.Blank-import           HaskellWorks.Data.Conduit.List-import           Test.Hspec--{-# 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.Conduit.Json.BlankSpec" $ do-  describe "Can blank json" $ do-    "\"\""                                `whenBlankedJsonShouldBe` "()"-    "\"\\\\\""                            `whenBlankedJsonShouldBe` "(  )"-    "\"\\\\\\\""                          `whenBlankedJsonShouldBe` "(    "-    "\" \\\\\\\""                         `whenBlankedJsonShouldBe` "(     "-    "\" \\n\\\\\""                        `whenBlankedJsonShouldBe` "(     )"-    ""                                    `whenBlankedJsonShouldBe` ""-    "\"\""                                `whenBlankedJsonShouldBe` "()"-    "\" \""                               `whenBlankedJsonShouldBe` "( )"-    "\" a \""                             `whenBlankedJsonShouldBe` "(   )"-    " \"a \" x"                           `whenBlankedJsonShouldBe` " (  ) x"-    " \"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___}"