hw-succinct 0.0.0.7 → 0.0.0.8
raw patch · 24 files changed
+18/−1520 lines, 24 filesdep +hw-conduitdep +hw-diagnosticsdep +hw-rankselectdep −arraydep −deepseqdep −ghc-primdep ~attoparsecdep ~conduitdep ~hspec
Dependencies added: hw-conduit, hw-diagnostics, hw-rankselect
Dependencies removed: array, deepseq, ghc-prim, lens, random, safe, word8
Dependency ranges changed: attoparsec, conduit, hspec, resourcet
Files
- README.md +1/−1
- bench/Main.hs +2/−32
- hw-succinct.cabal +15/−39
- src/HaskellWorks/Data/Conduit/ByteString.hs +0/−32
- src/HaskellWorks/Data/Conduit/Json.hs +0/−155
- src/HaskellWorks/Data/Conduit/Json/Blank.hs +0/−62
- src/HaskellWorks/Data/Conduit/Json/Words.hs +0/−94
- src/HaskellWorks/Data/Conduit/List.hs +0/−11
- src/HaskellWorks/Data/Succinct/BalancedParens.hs +0/−6
- src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs +0/−32
- src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +0/−138
- src/HaskellWorks/Data/Succinct/NearestNeighbour.hs +0/−14
- src/HaskellWorks/Data/Succinct/RankSelect.hs +0/−5
- src/HaskellWorks/Data/Succinct/RankSelect/Binary.hs +0/−5
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic.hs +0/−9
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs +0/−133
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1.hs +0/−169
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0.hs +0/−162
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs +0/−252
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +0/−55
- src/HaskellWorks/Data/Succinct/RankSelect/Internal.hs +0/−25
- src/HaskellWorks/Diagnostics/Time.hs +0/−13
- test/HaskellWorks/Data/Conduit/ByteStringSpec.hs +0/−30
- test/HaskellWorks/Data/Conduit/Json/BlankSpec.hs +0/−46
README.md view
@@ -1,4 +1,4 @@-# hw-bits+# hw-succinct [](https://circleci.com/gh/haskell-works/hw-succinct/tree/v0.0-branch) Conduits for tokenizing streams.
bench/Main.hs view
@@ -3,20 +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.Bits.BitShown-import HaskellWorks.Data.Conduit.ByteString-import HaskellWorks.Data.Conduit.Json-import HaskellWorks.Data.Conduit.Json.Blank-import HaskellWorks.Data.Conduit.List import HaskellWorks.Data.FromByteString import HaskellWorks.Data.Json.Succinct.Cursor import HaskellWorks.Data.Positioning@@ -45,18 +38,6 @@ 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]--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- benchRankSelect :: [Benchmark] benchRankSelect = [ env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"@@ -69,9 +50,7 @@ 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)- , bench "loadJson " (whnf loadJson bs)+ [ bench "loadJson " (whnf loadJson bs) ] ] @@ -92,16 +71,7 @@ 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)+ [ bench "loadJson" (whnf loadJson bs) ] ]
hw-succinct.cabal view
@@ -1,5 +1,5 @@ name: hw-succinct-version: 0.0.0.7+version: 0.0.0.8 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-succinct#readme@@ -23,7 +23,10 @@ , conduit , criterion , hw-bits+ , hw-conduit+ , hw-diagnostics , hw-prim+ , hw-rankselect , hw-succinct , mmap , resourcet@@ -33,11 +36,6 @@ library hs-source-dirs: src exposed-modules: HaskellWorks.Data.Attoparsec.Final.Parser- , HaskellWorks.Data.Conduit.ByteString- , HaskellWorks.Data.Conduit.Json- , HaskellWorks.Data.Conduit.Json.Blank- , HaskellWorks.Data.Conduit.Json.Words- , HaskellWorks.Data.Conduit.List , HaskellWorks.Data.Json.Final.Tokenize , HaskellWorks.Data.Json.Final.Tokenize.Internal , HaskellWorks.Data.Json.Succinct@@ -49,40 +47,17 @@ , HaskellWorks.Data.Json.Succinct.Cursor.Internal , HaskellWorks.Data.Json.Token , HaskellWorks.Data.Succinct- , HaskellWorks.Data.Succinct.BalancedParens- , HaskellWorks.Data.Succinct.BalancedParens.Internal- , HaskellWorks.Data.Succinct.BalancedParens.Simple- , HaskellWorks.Data.Succinct.NearestNeighbour- , HaskellWorks.Data.Succinct.RankSelect- , HaskellWorks.Data.Succinct.RankSelect.Binary- , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic- , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0- , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1- , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0- , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1- , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512- , HaskellWorks.Data.Succinct.RankSelect.Internal- , HaskellWorks.Diagnostics.Time build-depends: base >= 4.7 && < 5- , array- , attoparsec >= 0.10+ , attoparsec , bytestring- , conduit >= 1.1 && < 1.3- , deepseq < 1.5- , ghc-prim+ , conduit , hw-bits+ , hw-conduit , hw-prim- , lens- , mmap+ , hw-rankselect , 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@@ -93,8 +68,6 @@ main-is: Spec.hs other-modules: HaskellWorks.Data.Bits.BitReadSpec , HaskellWorks.Data.Bits.BitWiseSpec- , HaskellWorks.Data.Conduit.ByteStringSpec- , HaskellWorks.Data.Conduit.Json.BlankSpec , HaskellWorks.Data.Json.Final.TokenizeSpec , HaskellWorks.Data.Json.Succinct.CursorSpec , HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec@@ -108,17 +81,19 @@ , HaskellWorks.Data.Succinct.RankSelect.InternalSpec , HaskellWorks.Data.Succinct.SimpleSpec build-depends: base- , attoparsec >= 0.10+ , attoparsec , bytestring- , conduit >= 1.1 && < 1.3- , hspec >= 1.3+ , conduit+ , hspec , hw-bits+ , hw-conduit , hw-prim+ , hw-rankselect , hw-succinct , mmap , parsec , QuickCheck- , resourcet >= 1.1+ , resourcet , transformers , vector ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall@@ -140,6 +115,7 @@ , criterion , hw-bits , hw-prim+ , hw-rankselect , hw-succinct , mmap , resourcet
− src/HaskellWorks/Data/Conduit/ByteString.hs
@@ -1,32 +0,0 @@-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
@@ -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 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
@@ -1,62 +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 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
@@ -1,94 +0,0 @@-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
@@ -1,11 +0,0 @@--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
− src/HaskellWorks/Data/Succinct/BalancedParens.hs
@@ -1,6 +0,0 @@-module HaskellWorks.Data.Succinct.BalancedParens- ( module X- ) where--import HaskellWorks.Data.Succinct.BalancedParens.Internal as X-import HaskellWorks.Data.Succinct.BalancedParens.Simple as X
− src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs
@@ -1,32 +0,0 @@-module HaskellWorks.Data.Succinct.BalancedParens.Internal- ( BalancedParens(..)- , firstChild- , nextSibling- , parent- , depth- , subtreeSize- ) where--import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1--class BalancedParens v where- findOpen :: v -> Count -> Count- findClose :: v -> Count -> Count- enclose :: v -> Count -> Count--firstChild :: v -> Count -> Count-firstChild _ = (+ 1)--nextSibling :: BalancedParens v => v -> Count -> Count-nextSibling v p = findClose v p + 1--parent :: BalancedParens v => v -> Count -> Count-parent = enclose--depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Count-depth v p = let q = findOpen v p in rank1 v q - rank0 v q--subtreeSize :: BalancedParens v => v -> Count -> Count-subtreeSize v p = (findClose v p - p + 1) `quot` 2
− src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs
@@ -1,138 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module HaskellWorks.Data.Succinct.BalancedParens.Simple- ( SimpleBalancedParens(..)- , closeAt- , findOpen- , findClose- , findClose'- , openAt- ) where--import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.BalancedParens.Internal-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1-import Prelude as P--newtype SimpleBalancedParens a = SimpleBalancedParens a- deriving (BitLength, Eq, BitShow, TestBit, Rank0, Rank1, Select0, Select1)--instance Functor SimpleBalancedParens where- fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)- {-# INLINABLE fmap #-}--instance BitShow a => Show (SimpleBalancedParens a) where- show = bitShow--closeAt :: TestBit a => a -> Count -> Bool-closeAt v c = not (v .?. toPosition (c - 1))-{-# INLINABLE closeAt #-}--openAt :: TestBit a => a -> Count -> Bool-openAt v c = v .?. toPosition (c - 1)-{-# INLINABLE openAt #-}--require :: Bool -> String -> a -> a-require p msg v = if p then v else error msg-{-# INLINABLE require #-}--findOpen' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count-findOpen' c v p =- require (0 < p && p <= bitLength v) "Out of bounds" $- if v `openAt` p- then if c == 0- then p- else findOpen' (c - 1) v (p - 1)- else findOpen' (c + 1) v (p - 1)-{-# INLINABLE findOpen' #-}--findClose' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count-findClose' c v p =- require (1 < p && p <= bitLength v) "Out of bounds" $- if v `closeAt` p- then if c == 0- then p- else findClose' (c + 1) v (p + 1)- else findClose' (c - 1) v (p + 1)-{-# INLINABLE findClose' #-}--instance BalancedParens (SimpleBalancedParens [Bool]) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens (DVS.Vector Word8)) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens (DVS.Vector Word16)) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens (DVS.Vector Word32)) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens (DVS.Vector Word64)) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens Word8) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens Word16) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens Word32) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}--instance BalancedParens (SimpleBalancedParens Word64) where- findOpen v p = if v `openAt` p then p else findOpen' (Count 0) v (p - 1)- findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)- enclose = findOpen' (Count 1)- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- {-# INLINABLE enclose #-}
− src/HaskellWorks/Data/Succinct/NearestNeighbour.hs
@@ -1,14 +0,0 @@-module HaskellWorks.Data.Succinct.NearestNeighbour- ( bitPred- , bitSucc- ) where--import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1--bitPred :: (Rank1 v, Select1 v) => v -> Count -> Count-bitPred v p = select1 v (rank1 v p - 1)--bitSucc :: (Rank1 v, Select1 v) => v -> Count -> Count-bitSucc v p = select1 v (rank1 v p + 1)
− src/HaskellWorks/Data/Succinct/RankSelect.hs
@@ -1,5 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect- ( module X- ) where--import HaskellWorks.Data.Succinct.RankSelect.Internal as X
− src/HaskellWorks/Data/Succinct/RankSelect/Binary.hs
@@ -1,5 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect.Binary- ( module X- ) where--import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic as X
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic.hs
@@ -1,9 +0,0 @@--module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic- ( module X- ) where--import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0 as X-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 as X-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0 as X-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 as X
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs
@@ -1,133 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0- ( Rank0(..)- ) where--import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.ElemFixedBitSize-import HaskellWorks.Data.Bits.PopCount.PopCount0-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 as X-import HaskellWorks.Data.Vector.VectorLike-import Prelude as P--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--class Rank0 v where- rank0 :: v -> Count -> Count--deriving instance Rank0 a => Rank0 (BitShown a)--instance Rank0 Word8 where- rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}--instance Rank0 Word16 where- rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}--instance Rank0 Word32 where- rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}--instance Rank0 Word64 where- rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}--instance Rank0 [Bool] where- rank0 = go 0- where go r _ 0 = r- go r (False:bs) p = go (r + 1) bs (p - 1)- go r (True:bs) p = go r bs (p - 1)- go _ [] _ = error "Out of range"- {-# INLINABLE rank0 #-}--instance Rank0 [Word8] where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 [Word16] where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 [Word32] where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 [Word64] where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DV.Vector Word8) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DV.Vector Word16) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DV.Vector Word32) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DV.Vector Word64) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DVS.Vector Word8) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DVS.Vector Word16) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DVS.Vector Word32) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}--instance Rank0 (DVS.Vector Word64) where- rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank0 #-}
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1.hs
@@ -1,169 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1- ( Rank1(..)- ) where--import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.ElemFixedBitSize-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Vector.VectorLike-import Prelude as P--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--class Rank1 v where- rank1 :: v -> Count -> Count--deriving instance Rank1 a => Rank1 (BitShown a)--instance Rank1 Word8 where- rank1 _ 0 = 0- rank1 v s0 =- -- Shift out bits after given position.- let r0 = v .<. (8 - s0) in- -- Count set bits in parallel.- let r1 = (r0 .&. 0x55) + ((r0 .>. 1) .&. 0x55) in- let r2 = (r1 .&. 0x33) + ((r1 .>. 2) .&. 0x33) in- let r3 = (r2 .&. 0x0f) + ((r2 .>. 4) .&. 0x0f) in- let r4 = r3 `mod` 255 in- Count $ fromIntegral r4- {-# INLINABLE rank1 #-}--instance Rank1 Word16 where- rank1 _ 0 = 0- rank1 v s0 =- -- Shift out bits after given position.- let r0 = v .<. (16 - s0) in- -- Count set bits in parallel.- let r1 = (r0 .&. 0x5555) + ((r0 .>. 1) .&. 0x5555) in- let r2 = (r1 .&. 0x3333) + ((r1 .>. 2) .&. 0x3333) in- let r3 = (r2 .&. 0x0f0f) + ((r2 .>. 4) .&. 0x0f0f) in- let r4 = r3 `mod` 255 in- Count $ fromIntegral r4- {-# INLINABLE rank1 #-}--instance Rank1 Word32 where- rank1 _ 0 = 0- rank1 v s0 =- -- Shift out bits after given position.- let r0 = v .<. (32 - s0) in- -- Count set bits in parallel.- let r1 = (r0 .&. 0x55555555) + ((r0 .>. 1) .&. 0x55555555) in- let r2 = (r1 .&. 0x33333333) + ((r1 .>. 2) .&. 0x33333333) in- let r3 = (r2 .&. 0x0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f) in- let r4 = r3 `mod` 255 in- Count $ fromIntegral r4- {-# INLINABLE rank1 #-}--instance Rank1 Word64 where- rank1 _ 0 = 0- rank1 v s0 =- -- Shift out bits after given position.- let r0 = v .<. (64 - s0) in- -- Count set bits in parallel.- let r1 = (r0 .&. 0x5555555555555555) + ((r0 .>. 1) .&. 0x5555555555555555) in- let r2 = (r1 .&. 0x3333333333333333) + ((r1 .>. 2) .&. 0x3333333333333333) in- let r3 = (r2 .&. 0x0f0f0f0f0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f0f0f0f0f) in- let r4 = r3 `mod` 255 in- Count $ fromIntegral r4- {-# INLINABLE rank1 #-}--instance Rank1 [Bool] where- rank1 = go 0- where go r _ 0 = r- go r (True :bs) p = go (r + 1) bs (p - 1)- go r (False:bs) p = go r bs (p - 1)- go _ [] _ = error "Out of range"- {-# INLINABLE rank1 #-}--instance Rank1 [Word8] where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 [Word16] where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 [Word32] where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 [Word64] where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = take (fromIntegral q) v- maybeElem = v !! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DV.Vector Word8) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DV.Vector Word16) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DV.Vector Word32) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DV.Vector Word64) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DV.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DVS.Vector Word8) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DVS.Vector Word16) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DVS.Vector Word32) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}--instance Rank1 (DVS.Vector Word64) where- rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem- where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)- prefix = DVS.take (fromIntegral q) v- maybeElem = v !!! fromIntegral q- {-# INLINABLE rank1 #-}
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0.hs
@@ -1,162 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0- ( Select0(..)- ) where--import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.ElemFixedBitSize-import HaskellWorks.Data.Bits.PopCount.PopCount0-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1-import HaskellWorks.Data.Vector.VectorLike--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--class Select0 v where- select0 :: v -> Count -> Count--deriving instance Select0 a => Select0 (BitShown a)---- TODO: Implement NOT in terms of select for word-16-instance Select0 Word8 where- select0 v = select1 (comp v)- {-# INLINABLE select0 #-}--instance Select0 Word16 where- select0 v = select1 (comp v)- {-# INLINABLE select0 #-}--instance Select0 Word32 where- select0 v = select1 (comp v)- {-# INLINABLE select0 #-}--instance Select0 Word64 where- select0 v = select1 (comp v)- {-# INLINABLE select0 #-}--instance Select0 [Bool] where- select0 = go 0- where go r _ 0 = r- go r (False:bs) c = go (r + 1) bs (c - 1)- go r (True:bs) c = go (r + 1) bs c- go _ [] _ = error "Out of range"- {-# INLINABLE select0 #-}--instance Select0 [Word8] where- select0 v c = go v c 0- where go :: [Word8] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select0 #-}--instance Select0 [Word16] where- select0 v c = go v c 0- where go :: [Word16] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select0 #-}--instance Select0 [Word32] where- select0 v c = go v c 0- where go :: [Word32] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select0 #-}--instance Select0 [Word64] where- select0 v c = go v c 0- where go :: [Word64] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select0 #-}--instance Select0 (DV.Vector Word8) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DV.Vector Word16) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DV.Vector Word32) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DV.Vector Word64) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DVS.Vector Word8) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DVS.Vector Word16) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DVS.Vector Word32) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}--instance Select0 (DVS.Vector Word64) where- select0 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount0 w of- pc | d <= pc -> select0 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select0 #-}
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs
@@ -1,252 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1- ( Select1(..)- ) where--import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.ElemFixedBitSize-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Vector.VectorLike-import Prelude as P--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--class Select1 v where- select1 :: v -> Count -> Count--deriving instance Select1 a => Select1 (BitShown a)---- TODO: Implement NOT interms of select for word-16-instance Select1 Word8 where- select1 _ 0 = 0- select1 v p = select1 (fromIntegral v :: Word16) p- {-# INLINABLE select1 #-}---- TODO: Remove redundant code to optimise-instance Select1 Word16 where- select1 _ 0 = 0- select1 v rn =- -- Do a normal parallel bit count for a 64-bit integer,- -- but store all intermediate steps.- let a = (v .&. 0x5555) + ((v .>. 1) .&. 0x5555) in- let b = (a .&. 0x3333) + ((a .>. 2) .&. 0x3333) in- let c = (b .&. 0x0f0f) + ((b .>. 4) .&. 0x0f0f) in- let d = (c .&. 0x00ff) + ((c .>. 8) .&. 0x00ff) in- -- Now do branchless select!- let r0 = d + 1 - (fromIntegral (getCount rn) :: Word16) in- let s0 = 64 :: Word16 in- let t0 = (d .>. 32) + (d .>. 48) in- let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in- let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in- let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in- let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in- let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in- let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in- let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in- let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in- let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in- let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in- let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in- let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in- let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in- let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in- let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in- let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in- fromIntegral s6- {-# INLINABLE select1 #-}---- TODO: Remove redundant code to optimise-instance Select1 Word32 where- select1 _ 0 = 0- select1 v rn =- -- Do a normal parallel bit count for a 64-bit integer,- -- but store all intermediate steps.- let a = (v .&. 0x55555555) + ((v .>. 1) .&. 0x55555555) in- let b = (a .&. 0x33333333) + ((a .>. 2) .&. 0x33333333) in- let c = (b .&. 0x0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f) in- let d = (c .&. 0x00ff00ff) + ((c .>. 8) .&. 0x00ff00ff) in- let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff) in- -- Now do branchless select!- let r0 = e + 1 - (fromIntegral (getCount rn) :: Word32) in- let s0 = 64 :: Word32 in- let t0 = (d .>. 32) + (d .>. 48) in- let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in- let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in- let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in- let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in- let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in- let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in- let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in- let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in- let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in- let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in- let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in- let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in- let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in- let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in- let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in- let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in- fromIntegral s6- {-# INLINABLE select1 #-}--instance Select1 Word64 where- select1 _ 0 = 0- select1 v rn =- -- Do a normal parallel bit count for a 64-bit integer,- -- but store all intermediate steps.- let a = (v .&. 0x5555555555555555) + ((v .>. 1) .&. 0x5555555555555555) in- let b = (a .&. 0x3333333333333333) + ((a .>. 2) .&. 0x3333333333333333) in- let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f0f0f0f0f) in- let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>. 8) .&. 0x00ff00ff00ff00ff) in- let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff) in- let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff) in- -- Now do branchless select!- let r0 = f + 1 - fromIntegral (getCount rn) :: Word64 in- let s0 = 64 :: Word64 in- let t0 = (d .>. 32) + (d .>. 48) in- let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in- let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in- let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in- let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in- let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in- let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in- let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in- let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in- let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in- let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in- let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in- let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in- let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in- let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in- let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in- let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in- fromIntegral s6- {-# INLINABLE select1 #-}--instance Select1 [Bool] where- select1 = go 0- where go r _ 0 = r- go r (True :bs) c = go (r + 1) bs (c - 1)- go r (False:bs) c = go (r + 1) bs c- go _ [] _ = error "Out of range"- {-# INLINABLE select1 #-}--instance Select1 [Word8] where- select1 v c = go v c 0- where go :: [Word8] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}--instance Select1 [Word16] where- select1 v c = go v c 0- where go :: [Word16] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}--instance Select1 [Word32] where- select1 v c = go v c 0- where go :: [Word32] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}--instance Select1 [Word64] where- select1 v c = go v c 0- where go :: [Word64] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}--instance Select1 (DVS.Vector Word8) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DVS.Vector Word16) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DVS.Vector Word32) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DVS.Vector Word64) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DV.Vector Word8) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DV.Vector Word16) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DV.Vector Word32) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}--instance Select1 (DV.Vector Word64) where- select1 v c = go 0 c 0- where go _ 0 acc = acc- go n d acc = let w = (v !!! n) in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}
− src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs
@@ -1,55 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512- ( Poppy512(..)- , Rank1(..)- , makePoppy512- ) where--import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Search-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1-import HaskellWorks.Data.Vector.VectorLike--data Poppy512 = Poppy512- { poppy512Bits :: DVS.Vector Word64- , poppy512Index :: DVS.Vector Word64- } deriving (Eq, Show)--makePoppy512 :: DVS.Vector Word64 -> Poppy512-makePoppy512 v = Poppy512- { poppy512Bits = v- , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index- }- where gen512Index u = let indexN = DVS.length u - 1 in- if indexN == -1- then 0- else getCount (popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v))) + DVS.last u--instance BitRead Poppy512 where- bitRead = fmap makePoppy512 . bitRead--instance Rank1 Poppy512 where- rank1 (Poppy512 v i) p =- Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)--instance Rank0 Poppy512 where- rank0 (Poppy512 v i) p =- p `div` 512 * 512 - Count (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)--instance Select1 Poppy512 where- select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)- where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)- s = Count (i !!! q)- wordAt = (i !!!)--instance Select0 Poppy512 where- select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s)- where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)- s = Count (fromIntegral q * 512 - (i !!! q))- wordAt o = fromIntegral o * 512 - (i !!! o)
− src/HaskellWorks/Data/Succinct/RankSelect/Internal.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Succinct.RankSelect.Internal- ( -- * Rank & Select- Rank(..)- , Select(..)- ) where--import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic--class Eq a => Rank v a where- rank :: a -> v -> Count -> Count--class Eq a => Select v a where- select :: a -> v -> Count -> Count--instance Rank [Bool] Bool where- rank a = if a then rank1 else rank0- {-# INLINABLE rank #-}--instance Select [Bool] Bool where- select a = if a then select1 else select0- {-# INLINABLE select #-}
− src/HaskellWorks/Diagnostics/Time.hs
@@ -1,13 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module HaskellWorks.Diagnostics.Time where--import System.CPUTime--measure :: a -> IO a-measure a = do- start <- getCPUTime- let !b = a- end <- getCPUTime- print (end - start)- return b
− test/HaskellWorks/Data/Conduit/ByteStringSpec.hs
@@ -1,30 +0,0 @@-{-# 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
@@ -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___}"