hw-conduit (empty) → 0.0.0.6
raw patch · 15 files changed
+696/−0 lines, 15 filesdep +QuickCheckdep +arraydep +attoparsecsetup-changed
Dependencies added: QuickCheck, array, attoparsec, base, bytestring, conduit, criterion, deepseq, ghc-prim, hspec, hw-bits, hw-conduit, hw-prim, lens, mmap, mono-traversable, parsec, random, resourcet, safe, text, transformers, vector, word8
Files
- LICENSE +30/−0
- README.md +4/−0
- Setup.hs +2/−0
- app/Main.hs +4/−0
- bench/Main.hs +91/−0
- hw-conduit.cabal +106/−0
- src/HaskellWorks/Data/Conduit/ByteString.hs +32/−0
- src/HaskellWorks/Data/Conduit/Json.hs +155/−0
- src/HaskellWorks/Data/Conduit/Json/Blank.hs +62/−0
- src/HaskellWorks/Data/Conduit/Json/Words.hs +94/−0
- src/HaskellWorks/Data/Conduit/List.hs +11/−0
- test/HaskellWorks/Data/Conduit/ByteStringSpec.hs +30/−0
- test/HaskellWorks/Data/Conduit/Json/BlankSpec.hs +46/−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,4 @@+# hw-conduit+[](https://circleci.com/gh/haskell-works/hw-conduit)++Extra facilities for conduits.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Hello world"
+ bench/Main.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++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++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++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"+ [ bench "Rechunk" (whnf (runListConduit (rechunk 1000)) bss)+ ]+ ]++main :: IO ()+main = defaultMain benchRankJson40Conduits
+ hw-conduit.cabal view
@@ -0,0 +1,106 @@+name: hw-conduit+version: 0.0.0.6+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/hw-conduit#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-conduit-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-prim+ , hw-conduit+ , mmap+ , resourcet+ , vector+ default-language: Haskell2010++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+ , attoparsec >= 0.10+ , bytestring+ , conduit >= 1.1 && < 1.3+ , deepseq < 1.5+ , ghc-prim+ , hw-bits+ , hw-prim+ , lens+ , mmap+ , mono-traversable+ , parsec+ , QuickCheck+ , random+ , resourcet >= 1.1+ , safe+ , text+ , vector+ , word8++ default-language: Haskell2010+ ghc-options: -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2++test-suite hw-conduit-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.Conduit.ByteStringSpec+ , HaskellWorks.Data.Conduit.Json.BlankSpec+ build-depends: base+ , attoparsec >= 0.10+ , bytestring+ , conduit >= 1.1 && < 1.3+ , hspec >= 1.3+ , hw-bits+ , hw-prim+ , hw-conduit+ , mmap+ , parsec+ , QuickCheck+ , resourcet >= 1.1+ , 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-conduit++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-prim+ , hw-conduit+ , mmap+ , resourcet+ , vector
+ src/HaskellWorks/Data/Conduit/ByteString.hs view
@@ -0,0 +1,32 @@+module HaskellWorks.Data.Conduit.ByteString+ ( rechunk+ ) where++import Control.Monad+import qualified Data.ByteString as BS+import Data.Conduit++rechunk :: Monad m => Int -> Conduit BS.ByteString m BS.ByteString+rechunk = rechunk' BS.empty++rechunk' :: Monad m => BS.ByteString -> Int -> Conduit BS.ByteString m BS.ByteString+rechunk' as n | BS.length as >= n = do+ yield (BS.take n as)+ rechunk' (BS.drop n as) n+rechunk' as n = do+ mbss <- slurp (n - BS.length as)+ case mbss of+ Just bss -> do+ let bs = BS.concat (as : bss)+ yield (BS.take n bs)+ rechunk' (BS.drop n bs) n+ Nothing -> unless (BS.null as) $ yield as++slurp :: Monad m => Int -> ConduitM BS.ByteString BS.ByteString m (Maybe [BS.ByteString])+slurp = go []+ where go rs n | n > 0 = do+ mbs <- await+ case mbs of+ Just bs -> go (bs : rs) (n - BS.length bs)+ Nothing -> if null rs then return Nothing else return (Just (reverse rs))+ go rs _ = if null rs then return Nothing else return (Just (reverse rs))
+ src/HaskellWorks/Data/Conduit/Json.hs view
@@ -0,0 +1,155 @@+{-# 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 HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Conduit.Json.Words+import Prelude as P++interestingWord8s :: A.UArray Word8 Word8+interestingWord8s = A.array (0, 255) [+ (w, if w == wOpenBracket || w == wOpenBrace || w == wOpenParen || w == wt || w == wf || w == wn || w == w1+ 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 == wOpenBrace -> yield True+ d | d == wCloseBrace -> yield False+ d | d == wOpenBracket -> yield True+ d | d == wCloseBracket -> yield False+ d | d == wOpenParen -> yield True+ d | d == wCloseParen -> yield False+ d | d == wt -> yield True >> yield False+ d | d == wf -> yield True >> yield False+ d | d == w1 -> yield True >> yield False+ d | d == wn -> 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 (wFF, (Nothing, bs))+ gen (Just False , bs) = Just (w00, (Nothing, bs))+ gen (Nothing , bs) = case BS.uncons bs of+ Just (c, cs) -> case balancedParensOf c of+ MiniN -> gen (Nothing , cs)+ MiniT -> Just (wFF, (Nothing , cs))+ MiniF -> Just (w00, (Nothing , cs))+ MiniTF -> Just (wFF, (Just False , cs))+ Nothing -> Nothing++data MiniBP = MiniN | MiniT | MiniF | MiniTF++balancedParensOf :: Word8 -> MiniBP+balancedParensOf c = case c of+ d | d == wOpenBrace -> MiniT+ d | d == wCloseBrace -> MiniF+ d | d == wOpenBracket -> MiniT+ d | d == wCloseBracket -> MiniF+ d | d == wOpenParen -> MiniT+ d | d == wCloseParen -> MiniF+ d | d == wt -> MiniTF+ d | d == wf -> MiniTF+ d | d == w1 -> MiniTF+ d | d == wn -> 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/Conduit/Json/Blank.hs view
@@ -0,0 +1,62 @@+{-# 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 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 (w1 , (InNumber , cs))+ Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (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 == wBackslash -> Just (wSpace , (Escaped , cs))+ Just (!c, !cs) | c == wDoubleQuote -> Just (wCloseParen, (InJson , cs))+ Just (_ , !cs) -> Just (wSpace , (InString , cs))+ Nothing -> Nothing+ blankByteString (Escaped, bs) = case BS.uncons bs of+ Just (_, !cs) -> Just (wSpace, (InString, cs))+ Nothing -> Nothing+ blankByteString (InNumber, bs) = case BS.uncons bs of+ Just (!c, !cs) | isTrailingDigit c -> Just (w0 , (InNumber , cs))+ Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (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 (wUnderscore, (InIdent , cs))+ Just (!c, !cs) | isLeadingDigit c -> Just (w1 , (InNumber , cs))+ Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (InString , cs))+ Just (!c, !cs) -> Just (c , (InJson , cs))+ Nothing -> Nothing
+ src/HaskellWorks/Data/Conduit/Json/Words.hs view
@@ -0,0 +1,94 @@+module HaskellWorks.Data.Conduit.Json.Words where++import Data.Char+import Data.Word++wBackslash :: Word8+wBackslash = fromIntegral (ord '\\')++wDoubleQuote :: Word8+wDoubleQuote = fromIntegral (ord '"')++wUnderscore :: Word8+wUnderscore = fromIntegral (ord '_')++wSpace :: Word8+wSpace = fromIntegral (ord ' ')++wOpenParen :: Word8+wOpenParen = fromIntegral (ord '(')++wCloseParen :: Word8+wCloseParen = fromIntegral (ord ')')++wOpenBracket :: Word8+wOpenBracket = fromIntegral (ord '[')++wCloseBracket :: Word8+wCloseBracket = fromIntegral (ord ']')++wOpenBrace :: Word8+wOpenBrace = fromIntegral (ord '{')++wCloseBrace :: Word8+wCloseBrace = fromIntegral (ord '}')++wPlus :: Word8+wPlus = fromIntegral (ord '+')++wA :: Word8+wA = fromIntegral (ord 'A')++wa :: Word8+wa = fromIntegral (ord 'a')++we :: Word8+we = fromIntegral (ord 'e')++wE :: Word8+wE = fromIntegral (ord 'E')++wf :: Word8+wf = fromIntegral (ord 'f')++wn :: Word8+wn = fromIntegral (ord 'n')++wt :: Word8+wt = fromIntegral (ord 't')++wz :: Word8+wz = fromIntegral (ord 'z')++wZ :: Word8+wZ = fromIntegral (ord 'Z')++wDot :: Word8+wDot = fromIntegral (ord '.')++wMinus :: Word8+wMinus = fromIntegral (ord '-')++w0 :: Word8+w0 = fromIntegral (ord '0')++w1 :: Word8+w1 = fromIntegral (ord '1')++w9 :: Word8+w9 = fromIntegral (ord '9')++w00 :: Word8+w00 = fromIntegral (ord '0')++wFF :: Word8+wFF = fromIntegral (ord '\255')++isLeadingDigit :: Word8 -> Bool+isLeadingDigit w = w == wMinus || (w >= w0 && w <= w9)++isTrailingDigit :: Word8 -> Bool+isTrailingDigit w = w == wPlus || w == wMinus || (w >= w0 && w <= w9) || w == wDot || w == wE || w == we++isAlphabetic :: Word8 -> Bool+isAlphabetic w = (w >= wA && w <= wZ) || (w >= wa && w <= wz)
+ src/HaskellWorks/Data/Conduit/List.hs view
@@ -0,0 +1,11 @@++module HaskellWorks.Data.Conduit.List+ ( runListConduit+ ) where++import Data.Conduit+import Data.Conduit.List as CL+import Prelude as P++runListConduit :: Conduit i [] o -> [i] -> [o]+runListConduit c is = P.concat $ sourceList is =$ c $$ consume
+ test/HaskellWorks/Data/Conduit/ByteStringSpec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Conduit.ByteStringSpec (spec) where++import HaskellWorks.Data.Conduit.ByteString+import HaskellWorks.Data.Conduit.List+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Conduit.ByteStringSpec" $ do+ it "Can rechunk bytestrings" $ do+ runListConduit (rechunk 1) [] `shouldBe` []+ runListConduit (rechunk 1) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["0", "1", "2", "3", "4", "5"]+ runListConduit (rechunk 2) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["01", "23", "45"]+ runListConduit (rechunk 3) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["012", "345"]+ runListConduit (rechunk 4) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["0123", "45"]+ runListConduit (rechunk 5) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["01234", "5"]+ runListConduit (rechunk 6) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["012345"]+ runListConduit (rechunk 7) ["0", "1", "2", "3", "4", "5"] `shouldBe` ["012345"]+ runListConduit (rechunk 1) ["01", "23", "", "45", "67"] `shouldBe` ["0", "1", "2", "3", "4", "5", "6", "7"]+ runListConduit (rechunk 2) ["01", "23", "", "45", "67"] `shouldBe` ["01", "23", "45", "67"]+ runListConduit (rechunk 3) ["01", "23", "", "45", "67"] `shouldBe` ["012", "345", "67"]+ runListConduit (rechunk 4) ["01", "23", "", "45", "67"] `shouldBe` ["0123", "4567"]+ runListConduit (rechunk 5) ["01", "23", "", "45", "67"] `shouldBe` ["01234", "567"]+ runListConduit (rechunk 6) ["01", "23", "", "45", "67"] `shouldBe` ["012345", "67"]+ runListConduit (rechunk 7) ["01", "23", "", "45", "67"] `shouldBe` ["0123456", "7"]+ runListConduit (rechunk 8) ["01", "23", "", "45", "67"] `shouldBe` ["01234567"]+ runListConduit (rechunk 9) ["01", "23", "", "45", "67"] `shouldBe` ["01234567"]
+ test/HaskellWorks/Data/Conduit/Json/BlankSpec.hs view
@@ -0,0 +1,46 @@+{-# 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___}"
+ 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;"+ }+ }+}