hw-succinct 0.0.0.4 → 0.0.0.5

raw patch · 59 files changed

+391/−3477 lines, 59 filesdep +hw-bitsdep ~basedep ~criteriondep ~vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hw-bits

Dependency ranges changed: base, criterion, vector

API changes (from Hackage documentation)

Files

• app/Main.hs +32/−5
• bench/Main.hs +34/−16
• hw-succinct.cabal +25/−63
• src/HaskellWorks/Data/Attoparsec/Final/IsChar.hs +14/−3
• src/HaskellWorks/Data/Attoparsec/Final/IsChar/Char.hs +0/−8
• src/HaskellWorks/Data/Attoparsec/Final/IsChar/Internal.hs +0/−12
• src/HaskellWorks/Data/Attoparsec/Final/Parser.hs +56/−3
• src/HaskellWorks/Data/Attoparsec/Final/Parser/ByteString.hs +0/−17
• src/HaskellWorks/Data/Attoparsec/Final/Parser/Internal.hs +0/−16
• src/HaskellWorks/Data/Attoparsec/Final/Parser/Text.hs +0/−16
• src/HaskellWorks/Data/Bits.hs +0/−16
• src/HaskellWorks/Data/Bits/BitLength.hs +0/−112
• src/HaskellWorks/Data/Bits/BitParse.hs +0/−127
• src/HaskellWorks/Data/Bits/BitRead.hs +0/−78
• src/HaskellWorks/Data/Bits/BitShow.hs +0/−104
• src/HaskellWorks/Data/Bits/BitShown.hs +0/−46
• src/HaskellWorks/Data/Bits/BitWise.hs +0/−213
• src/HaskellWorks/Data/Bits/BitWise/String.hs +0/−126
• src/HaskellWorks/Data/Bits/Conversion.hs +0/−127
• src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs +0/−82
• src/HaskellWorks/Data/Bits/FixedBitSize.hs +0/−30
• src/HaskellWorks/Data/Bits/FromBools.hs +0/−51
• src/HaskellWorks/Data/Bits/PopCount.hs +0/−19
• src/HaskellWorks/Data/Bits/PopCount/PopCount0.hs +0/−96
• src/HaskellWorks/Data/Bits/PopCount/PopCount1.hs +0/−11
• src/HaskellWorks/Data/Bits/PopCount/PopCount1/Broadword.hs +0/−111
• src/HaskellWorks/Data/Bits/PopCount/PopCount1/GHC.hs +0/−95
• src/HaskellWorks/Data/ByteString.hs +0/−11
• src/HaskellWorks/Data/Conduit/ByteString.hs +32/−0
• src/HaskellWorks/Data/Conduit/Json.hs +55/−72
• src/HaskellWorks/Data/Conduit/Json/Words.hs +6/−0
• src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec.hs +0/−29
• src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/Internal.hs +0/−196
• src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/LineColumn.hs +0/−84
• src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/Offset.hs +0/−79
• src/HaskellWorks/Data/FromByteString.hs +0/−8
• src/HaskellWorks/Data/FromForeignRegion.hs +0/−7
• src/HaskellWorks/Data/Json/Final/Tokenize.hs +0/−1
• src/HaskellWorks/Data/Json/Succinct.hs +1/−2
• src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs +22/−5
• src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs +6/−2
• src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +4/−5
• src/HaskellWorks/Data/Json/Succinct/Transform.hs +0/−18
• src/HaskellWorks/Data/Positioning.hs +0/−34
• src/HaskellWorks/Data/Search.hs +0/−12
• src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +35/−2
• src/HaskellWorks/Data/Vector/BoxedVectorLike.hs +0/−68
• src/HaskellWorks/Data/Vector/Storable/ByteString.hs +0/−38
• src/HaskellWorks/Data/Vector/StorableVectorLike.hs +0/−68
• src/HaskellWorks/Data/Vector/VectorLike.hs +0/−453
• src/HaskellWorks/Data/Word.hs +0/−40
• src/HaskellWorks/Function.hs +0/−6
• test/HaskellWorks/Data/Bits/FromBoolsSpec.hs +0/−157
• test/HaskellWorks/Data/Conduit/ByteStringSpec.hs +30/−0
• test/HaskellWorks/Data/Conduit/JsonSpec.hs +0/−108
• test/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/LineColumnSpec.hs +0/−171
• test/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/OffsetSpec.hs +0/−164
• test/HaskellWorks/Data/Json/Succinct/Cursor/InterestBitsSpec.hs +39/−0
• test/HaskellWorks/Data/Json/SuccinctSpec.hs +0/−34

@@ -12,12 +12,39 @@ import           HaskellWorks.Data.Json.Succinct.Cursor import           HaskellWorks.Data.Succinct.BalancedParens.Simple import           HaskellWorks.Diagnostics.Time+import           System.Mem +readJson :: String -> IO (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+readJson path = do+  bs <- BS.readFile path+  print "Read file"+  !cursor <- measure (fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  print "Created cursor"+  return cursor+ main :: IO () main = do-  bs <- BS.readFile "/Users/jky/Downloads/78mbs.json"-  !cursor <- measure (fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))-  print (jsonTokenAt (firstChild cursor))+  performGC+  !c0 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c1 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c2 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c3 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c4 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c5 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c6 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c7 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c8 <- readJson "/Users/jky/Downloads/78mbs.json"+  !c9 <- readJson "/Users/jky/Downloads/78mbs.json"+  print "Returned from readJson"+  performGC   threadDelay 100000000-  print (jsonTokenAt cursor)-  return ()+  print c0+  print c1+  print c2+  print c3+  print c4+  print c5+  print c6+  print c7+  print c8+  print c9

@@ -13,8 +13,7 @@ import           Data.Word import           Foreign import           HaskellWorks.Data.Bits.BitShown-import qualified HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword as PC1BW-import qualified HaskellWorks.Data.Bits.PopCount.PopCount1.GHC       as PC1GHC+import           HaskellWorks.Data.Conduit.ByteString import           HaskellWorks.Data.Conduit.Json import           HaskellWorks.Data.Conduit.Json.Blank import           HaskellWorks.Data.Conduit.List@@ -25,12 +24,18 @@ import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic import           System.IO.MMap -v :: DVS.Vector Word64-v = DVS.fromList (take 1000000 (cycle [maxBound, 0]))+setupEnvBs :: Int -> IO BS.ByteString+setupEnvBs n = return $ BS.pack (take n (cycle [maxBound, 0])) -setupEnv :: IO (DVS.Vector Word64)-setupEnv = return v+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@@ -43,23 +48,21 @@ runCon :: Conduit i [] BS.ByteString -> i -> BS.ByteString runCon con bs = BS.concat $ runListConduit con [bs] -jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString-jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits+runCon2 :: Conduit i [] o -> [i] -> [o]+runCon2 con is = let os = runListConduit con is in seq (length os) os -jsonToInterestBitsOld :: MonadThrow m => Conduit BS.ByteString m BS.ByteString-jsonToInterestBitsOld = textToJsonToken =$= jsonToken2Markers =$= markerToByteString+runCon3 :: Conduit i [] BS.ByteString -> [i] -> [BS.ByteString]+runCon3 con is = let os = runListConduit con is in seq (BS.length (last os)) os -runBlankedJsonToInterestBits :: BS.ByteString -> BS.ByteString-runBlankedJsonToInterestBits bs = BS.concat $ runListConduit blankedJsonToInterestBits [bs]+jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString+jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits  benchRankSelect :: [Benchmark] benchRankSelect =-  [ env setupEnv $ \bv -> bgroup "Rank"+  [ env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"     [ bench "Rank - Once"   (whnf (rank1    bv) 1)     , bench "Select - Once" (whnf (select1  bv) 1)     , bench "Rank - Many"   (nf   (map (getCount . rank1  bv)) [0, 1000..10000000])-    , bench "PopCnt1 Broadword - Once" (nf   (map (\n -> getCount (PC1BW.popCount1  (DVS.take n bv)))) [0, 1000..10000000])-    , bench "PopCnt1 GHC       - Once" (nf   (map (\n -> getCount (PC1GHC.popCount1 (DVS.take n bv)))) [0, 1000..10000000])     ]   ] @@ -68,7 +71,6 @@   [ 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 "Run jsonToInterestBitsOld        "  (whnf (runCon jsonToInterestBitsOld      ) bs)     , bench "loadJson                         "  (whnf  loadJson                            bs)     ]   ]@@ -84,6 +86,22 @@ benchRankJsonBigConduits =   [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"     [ bench "loadJson" (whnf loadJson 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)     ]   ] 

@@ -1,5 +1,5 @@ name:                   hw-succinct-version:                0.0.0.4+version:                0.0.0.5 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-succinct#readme@@ -18,53 +18,26 @@   hs-source-dirs:       app   main-is:              Main.hs   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2-  build-depends:        base            >= 4       && < 5   ,-                        bytestring                          ,-                        conduit                             ,-                        criterion       >= 1.1.0.0 && < 1.2 ,-                        hw-succinct                         ,-                        mmap                                ,-                        resourcet                           ,-                        vector          >= 0.6     && < 0.12+  build-depends:        base            >= 4+                      , bytestring+                      , conduit+                      , criterion+                      , hw-bits+                      , hw-succinct+                      , mmap+                      , resourcet+                      , vector   default-language:     Haskell2010  library   hs-source-dirs:       src   exposed-modules:      HaskellWorks.Data.Attoparsec.Final.IsChar-                      , HaskellWorks.Data.Attoparsec.Final.IsChar.Char-                      , HaskellWorks.Data.Attoparsec.Final.IsChar.Internal                       , HaskellWorks.Data.Attoparsec.Final.Parser-                      , HaskellWorks.Data.Attoparsec.Final.Parser.ByteString-                      , HaskellWorks.Data.Attoparsec.Final.Parser.Internal-                      , HaskellWorks.Data.Attoparsec.Final.Parser.Text-                      , HaskellWorks.Data.Bits-                      , HaskellWorks.Data.Bits.BitLength-                      , HaskellWorks.Data.Bits.BitParse-                      , HaskellWorks.Data.Bits.BitRead-                      , HaskellWorks.Data.Bits.BitShow-                      , HaskellWorks.Data.Bits.BitShown-                      , HaskellWorks.Data.Bits.BitWise-                      , HaskellWorks.Data.Bits.BitWise.String-                      , HaskellWorks.Data.Bits.Conversion-                      , HaskellWorks.Data.Bits.ElemFixedBitSize-                      , HaskellWorks.Data.Bits.FixedBitSize-                      , HaskellWorks.Data.Bits.FromBools-                      , HaskellWorks.Data.Bits.PopCount-                      , HaskellWorks.Data.Bits.PopCount.PopCount0-                      , HaskellWorks.Data.Bits.PopCount.PopCount1-                      , HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword-                      , HaskellWorks.Data.Bits.PopCount.PopCount1.GHC-                      , HaskellWorks.Data.ByteString+                      , HaskellWorks.Data.Conduit.ByteString                       , HaskellWorks.Data.Conduit.Json                       , HaskellWorks.Data.Conduit.Json.Blank                       , HaskellWorks.Data.Conduit.Json.Words                       , HaskellWorks.Data.Conduit.List-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Internal-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec.LineColumn-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Offset-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec-                      , HaskellWorks.Data.FromByteString-                      , HaskellWorks.Data.FromForeignRegion                       , HaskellWorks.Data.Json.Final.Tokenize                       , HaskellWorks.Data.Json.Final.Tokenize.Internal                       , HaskellWorks.Data.Json.Succinct@@ -74,10 +47,7 @@                       , HaskellWorks.Data.Json.Succinct.Cursor.CursorType                       , HaskellWorks.Data.Json.Succinct.Cursor.InterestBits                       , HaskellWorks.Data.Json.Succinct.Cursor.Internal-                      , HaskellWorks.Data.Json.Succinct.Transform                       , HaskellWorks.Data.Json.Token-                      , HaskellWorks.Data.Positioning-                      , HaskellWorks.Data.Search                       , HaskellWorks.Data.Succinct                       , HaskellWorks.Data.Succinct.BalancedParens                       , HaskellWorks.Data.Succinct.BalancedParens.Internal@@ -92,12 +62,6 @@                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512                       , HaskellWorks.Data.Succinct.RankSelect.Internal-                      , HaskellWorks.Data.Vector.BoxedVectorLike-                      , HaskellWorks.Data.Vector.Storable.ByteString-                      , HaskellWorks.Data.Vector.StorableVectorLike-                      , HaskellWorks.Data.Vector.VectorLike-                      , HaskellWorks.Data.Word-                      , HaskellWorks.Function                       , HaskellWorks.Diagnostics.Time   build-depends:        base                            >= 4.7  && < 5                       , array@@ -106,6 +70,7 @@                       , conduit                         >= 1.1  && < 1.3                       , deepseq                         <  1.5                       , ghc-prim+                      , hw-bits                       , lens                       , mmap                       , mono-traversable@@ -127,28 +92,26 @@   main-is:              Spec.hs   other-modules:        HaskellWorks.Data.Bits.BitReadSpec                       , HaskellWorks.Data.Bits.BitWiseSpec-                      , HaskellWorks.Data.Bits.FromBoolsSpec+                      , HaskellWorks.Data.Conduit.ByteStringSpec                       , HaskellWorks.Data.Conduit.Json.BlankSpec-                      , HaskellWorks.Data.Conduit.JsonSpec-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec.LineColumnSpec-                      , HaskellWorks.Data.Conduit.Tokenize.Attoparsec.OffsetSpec                       , HaskellWorks.Data.Json.Final.TokenizeSpec                       , HaskellWorks.Data.Json.Succinct.CursorSpec-                      , HaskellWorks.Data.Json.SuccinctSpec+                      , HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec                       , HaskellWorks.Data.Succinct.BalancedParensSpec-                      , HaskellWorks.Data.Succinct.RankSelect.InternalSpec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec+                      , HaskellWorks.Data.Succinct.RankSelect.InternalSpec                       , HaskellWorks.Data.Succinct.SimpleSpec   build-depends:        base                       , attoparsec                      >= 0.10                       , bytestring                       , conduit                         >= 1.1  && < 1.3                       , hspec                           >= 1.3+                      , hw-bits                       , hw-succinct                       , mmap                       , parsec@@ -169,13 +132,12 @@     Main-Is: Main.hs     GHC-Options: -O2 -Wall -msse4.2     Default-Language: Haskell2010-    Build-Depends:-        base            >= 4       && < 5   ,-        bytestring                          ,-        conduit                             ,-        criterion       >= 1.1.0.0 && < 1.2 ,-        hw-succinct                         ,-        mmap                                ,-        resourcet                           ,-        vector          >= 0.6     && < 0.12-+    Build-Depends:      base            >= 4       && < 5+                      , bytestring+                      , conduit+                      , criterion+                      , hw-bits+                      , hw-succinct+                      , mmap+                      , resourcet+                      , vector

@@ -1,6 +1,17 @@ module HaskellWorks.Data.Attoparsec.Final.IsChar-    ( module X+    ( IsChar(..)     ) where -import           HaskellWorks.Data.Attoparsec.Final.IsChar.Char     as X ()-import           HaskellWorks.Data.Attoparsec.Final.IsChar.Internal as X+import qualified Data.ByteString.Internal as BI+import           Data.Word8++class IsChar c where+  toChar :: c -> Char++instance IsChar Word8 where+  toChar = BI.w2c+  {-# INLINABLE toChar #-}++instance IsChar Char where+  toChar = id+  {-# INLINABLE toChar #-}

@@ -1,8 +0,0 @@-module HaskellWorks.Data.Attoparsec.Final.IsChar.Char-    ( IsChar(..)-    ) where--import HaskellWorks.Data.Attoparsec.Final.IsChar.Internal--instance IsChar Char where-  toChar = id

@@ -1,12 +0,0 @@-module HaskellWorks.Data.Attoparsec.Final.IsChar.Internal-    ( IsChar(..)-    ) where--import qualified Data.ByteString.Internal as BI-import           Data.Word8--class IsChar c where-  toChar :: c -> Char--instance IsChar Word8 where-  toChar = BI.w2c

@@ -1,5 +1,58 @@ module HaskellWorks.Data.Attoparsec.Final.Parser-    ( Parser(..)-    ) where+  ( Parser(..)+  ) where -import HaskellWorks.Data.Attoparsec.Final.Parser.Internal+import qualified Data.Attoparsec.ByteString                as ABS+import qualified Data.Attoparsec.ByteString.Char8          as BC+import qualified Data.Attoparsec.Text                      as AT+import qualified Data.Attoparsec.Types                     as T+import           Data.ByteString                           (ByteString)+import           Data.MonoTraversable+import           Data.Text                                 (Text)+import           HaskellWorks.Data.Attoparsec.Final.IsChar++class MonoTraversable t => Parser t where+  satisfy :: (Element t -> Bool) -> T.Parser t (Element t)+  satisfyWith :: (Element t -> a) -> (a -> Bool) -> T.Parser t a+  satisfyChar :: (Char -> Bool) -> T.Parser t Char+  string :: t -> T.Parser t t+  try :: T.Parser t a -> T.Parser t a+  char :: Char -> T.Parser t Char+  (<?>) :: T.Parser t Char -> String -> T.Parser t Char+  rational :: Fractional f => T.Parser t f++instance Parser ByteString where+  satisfy = ABS.satisfy+  satisfyWith = ABS.satisfyWith+  satisfyChar = ABS.satisfyWith toChar+  string = ABS.string+  try = ABS.try+  char = BC.char+  (<?>) = (BC.<?>)+  rational = BC.rational+  {-# INLINABLE satisfy     #-}+  {-# INLINABLE satisfyWith #-}+  {-# INLINABLE satisfyChar #-}+  {-# INLINABLE string      #-}+  {-# INLINABLE try         #-}+  {-# INLINABLE char        #-}+  {-# INLINABLE (<?>)       #-}+  {-# INLINABLE rational    #-}++instance Parser Text where+  satisfy = AT.satisfy+  satisfyWith = AT.satisfyWith+  satisfyChar = AT.satisfyWith toChar+  string = AT.string+  try = AT.try+  char = AT.char+  (<?>) = (AT.<?>)+  rational = AT.rational+  {-# INLINABLE satisfy     #-}+  {-# INLINABLE satisfyWith #-}+  {-# INLINABLE satisfyChar #-}+  {-# INLINABLE string      #-}+  {-# INLINABLE try         #-}+  {-# INLINABLE char        #-}+  {-# INLINABLE (<?>)       #-}+  {-# INLINABLE rational    #-}

@@ -1,17 +0,0 @@-module HaskellWorks.Data.Attoparsec.Final.Parser.ByteString where--import qualified Data.Attoparsec.ByteString                         as ABS-import qualified Data.Attoparsec.ByteString.Char8                   as BC-import           Data.ByteString                                    (ByteString)-import           HaskellWorks.Data.Attoparsec.Final.IsChar-import           HaskellWorks.Data.Attoparsec.Final.Parser.Internal--instance Parser ByteString where-  satisfy = ABS.satisfy-  satisfyWith = ABS.satisfyWith-  satisfyChar = ABS.satisfyWith toChar-  string = ABS.string-  try = ABS.try-  char = BC.char-  (<?>) = (BC.<?>)-  rational = BC.rational

@@ -1,16 +0,0 @@-module HaskellWorks.Data.Attoparsec.Final.Parser.Internal-    ( Parser(..)-    ) where--import qualified Data.Attoparsec.Types              as T-import           Data.MonoTraversable--class MonoTraversable t => Parser t where-  satisfy :: (Element t -> Bool) -> T.Parser t (Element t)-  satisfyWith :: (Element t -> a) -> (a -> Bool) -> T.Parser t a-  satisfyChar :: (Char -> Bool) -> T.Parser t Char-  string :: t -> T.Parser t t-  try :: T.Parser t a -> T.Parser t a-  char :: Char -> T.Parser t Char-  (<?>) :: T.Parser t Char -> String -> T.Parser t Char-  rational :: Fractional f => T.Parser t f

@@ -1,16 +0,0 @@-module HaskellWorks.Data.Attoparsec.Final.Parser.Text where--import qualified Data.Attoparsec.Text                               as AT-import           Data.Text                                          (Text)-import           HaskellWorks.Data.Attoparsec.Final.IsChar-import           HaskellWorks.Data.Attoparsec.Final.Parser.Internal--instance Parser Text where-  satisfy = AT.satisfy-  satisfyWith = AT.satisfyWith-  satisfyChar = AT.satisfyWith toChar-  string = AT.string-  try = AT.try-  char = AT.char-  (<?>) = (AT.<?>)-  rational = AT.rational

@@ -1,16 +0,0 @@--- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits-    ( module X-    ) where--import           HaskellWorks.Data.Bits.BitLength as X-import           HaskellWorks.Data.Bits.BitParse  as X-import           HaskellWorks.Data.Bits.BitRead   as X-import           HaskellWorks.Data.Bits.BitShow   as X-import           HaskellWorks.Data.Bits.BitShown  as X-import           HaskellWorks.Data.Bits.BitWise   as X-import           HaskellWorks.Data.Bits.PopCount  as X

@@ -1,112 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.BitLength-    ( -- * Bit map-      BitLength(..)-    , elemBitLength-    , elemBitEnd-    ) where--import qualified Data.Vector                         as DV-import qualified Data.Vector.Storable                as DVS-import           Data.Word-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Vector.VectorLike-import           Prelude                             as P--class BitLength v where-  bitLength :: v -> Count--  endPosition :: v -> Position-  endPosition = Position . fromIntegral . getCount . bitLength------------------------------------------------------------------------------------- Functions--elemBitLength :: (VectorLike v, BitLength (Elem v)) => v -> Count-elemBitLength v = bitLength (v !!! 0)--elemBitEnd :: (VectorLike v, BitLength (Elem v)) => v -> Position-elemBitEnd v = endPosition (v !!! 0)------------------------------------------------------------------------------------- Instances--instance BitLength Bool where-  bitLength _ = 1-  {-# INLINABLE bitLength #-}--instance BitLength [Bool] where-  bitLength = fromIntegral . P.length-  {-# INLINABLE bitLength #-}--instance BitLength Word8 where-  bitLength _ = 8-  {-# INLINABLE bitLength #-}--instance BitLength Word16 where-  bitLength _ = 16-  {-# INLINABLE bitLength #-}--instance BitLength Word32 where-  bitLength _ = 32-  {-# INLINABLE bitLength #-}--instance BitLength Word64 where-  bitLength _ = 64-  {-# INLINABLE bitLength #-}--instance BitLength [Word8] where-  bitLength v = fromIntegral (P.length v) * bitLength (head v)-  {-# INLINABLE bitLength #-}--instance BitLength [Word16] where-  bitLength v = fromIntegral (P.length v) * bitLength (head v)-  {-# INLINABLE bitLength #-}--instance BitLength [Word32] where-  bitLength v = fromIntegral (P.length v) * bitLength (head v)-  {-# INLINABLE bitLength #-}--instance BitLength [Word64] where-  bitLength v = fromIntegral (P.length v) * bitLength (head v)-  {-# INLINABLE bitLength #-}--instance BitLength (DV.Vector Word8) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DV.Vector Word16) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DV.Vector Word32) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DV.Vector Word64) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DVS.Vector Word8) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DVS.Vector Word16) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DVS.Vector Word32) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}--instance BitLength (DVS.Vector Word64) where-  bitLength v = vLength v * bitLength (v !!! 0)-  {-# INLINABLE bitLength #-}

@@ -1,127 +0,0 @@-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE ScopedTypeVariables #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.BitParse-  ( BitParse(..)-  ) where--import qualified Data.ByteString                  as BS-import qualified Data.Vector                      as DV-import qualified Data.Vector.Storable             as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitWise-import           Text.ParserCombinators.Parsec--class BitParse a where-  bitParse0       :: Parser a-  bitParse1       :: Parser a--p0 :: Parser Bool-p0 = char '1' >> return True--p1 :: Parser Bool-p1 = char '0' >> return False--instance BitParse Bool where-  bitParse0 = option False bitParse1-  bitParse1 = p0 <|> p1--instance BitParse Word8 where-  bitParse0 = option 0 bitParse1-  bitParse1 = do-    a :: Bool <- bitParse1-    b :: Bool <- bitParse0-    c :: Bool <- bitParse0-    d :: Bool <- bitParse0-    e :: Bool <- bitParse0-    f :: Bool <- bitParse0-    g :: Bool <- bitParse0-    h :: Bool <- bitParse0-    return $-      (if a then 0x01 else 0) .|.-      (if b then 0x02 else 0) .|.-      (if c then 0x04 else 0) .|.-      (if d then 0x08 else 0) .|.-      (if e then 0x10 else 0) .|.-      (if f then 0x20 else 0) .|.-      (if g then 0x40 else 0) .|.-      (if h then 0x80 else 0)--instance BitParse Word16 where-  bitParse0 = option 0 bitParse1-  bitParse1 = do-    (a :: Word8) <- bitParse1-    (b :: Word8) <- bitParse0-    return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance BitParse Word32 where-  bitParse0 = option 0 bitParse1-  bitParse1 = do-    (a :: Word16) <- bitParse1-    (b :: Word16) <- bitParse0-    return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance BitParse Word64 where-  bitParse0 = option 0 bitParse1-  bitParse1 = do-    (a :: Word32) <- bitParse1-    (b :: Word32) <- bitParse0-    return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance BitParse BS.ByteString where-  bitParse0 = fmap BS.pack bitParse0-  bitParse1 = fmap BS.pack bitParse1--instance BitParse [Word8] where-  bitParse0 = option [] bitParse1-  bitParse1 = many bitParse1--instance BitParse [Word16] where-  bitParse0 = option [] bitParse1-  bitParse1 = many bitParse1--instance BitParse [Word32] where-  bitParse0 = option [] bitParse1-  bitParse1 = many bitParse1--instance BitParse [Word64] where-  bitParse0 = option [] bitParse1-  bitParse1 = many bitParse1--instance BitParse (DV.Vector Word8) where-  bitParse0 = option DV.empty bitParse1-  bitParse1 = DV.fromList `fmap` bitParse0--instance BitParse (DV.Vector Word16) where-  bitParse0 = option DV.empty bitParse1-  bitParse1 = DV.fromList `fmap` bitParse0--instance BitParse (DV.Vector Word32) where-  bitParse0 = option DV.empty bitParse1-  bitParse1 = DV.fromList `fmap` bitParse0--instance BitParse (DV.Vector Word64) where-  bitParse0 = option DV.empty bitParse1-  bitParse1 = DV.fromList `fmap` bitParse0--instance BitParse (DVS.Vector Word8) where-  bitParse0 = option DVS.empty bitParse1-  bitParse1 = DVS.fromList `fmap` bitParse0--instance BitParse (DVS.Vector Word16) where-  bitParse0 = option DVS.empty bitParse1-  bitParse1 = DVS.fromList `fmap` bitParse0--instance BitParse (DVS.Vector Word32) where-  bitParse0 = option DVS.empty bitParse1-  bitParse1 = DVS.fromList `fmap` bitParse0--instance BitParse (DVS.Vector Word64) where-  bitParse0 = option DVS.empty bitParse1-  bitParse1 = DVS.fromList `fmap` bitParse0

@@ -1,78 +0,0 @@-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE UndecidableInstances #-}--module HaskellWorks.Data.Bits.BitRead-  ( BitRead(..)-  ) where--import qualified Data.ByteString                 as BS-import qualified Data.Vector                     as DV-import qualified Data.Vector.Storable            as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitParse-import           Text.ParserCombinators.Parsec--class BitRead a where-  bitRead :: String -> Maybe a--bitRead' :: BitParse a => String -> Maybe a-bitRead' = either (const Nothing) Just . parse bitParse0 "" . filter (/= ' ')--bitCharToBool :: Char -> Maybe Bool-bitCharToBool '1' = Just True-bitCharToBool '0' = Just False-bitCharToBool _   = Nothing--instance BitRead Word8 where-  bitRead = bitRead'--instance BitRead Word16 where-  bitRead = bitRead'--instance BitRead Word32 where-  bitRead = bitRead'--instance BitRead Word64 where-  bitRead = bitRead'--instance BitRead BS.ByteString where-  bitRead = bitRead'--instance BitRead [Word8] where-  bitRead = bitRead'--instance BitRead [Word16] where-  bitRead = bitRead'--instance BitRead [Word32] where-  bitRead = bitRead'--instance BitRead [Word64] where-  bitRead = bitRead'--instance BitRead (DV.Vector Word8) where-  bitRead = bitRead'--instance BitRead (DV.Vector Word16) where-  bitRead = bitRead'--instance BitRead (DV.Vector Word32) where-  bitRead = bitRead'--instance BitRead (DV.Vector Word64) where-  bitRead = bitRead'--instance BitRead (DVS.Vector Word8) where-  bitRead = bitRead'--instance BitRead (DVS.Vector Word16) where-  bitRead = bitRead'--instance BitRead (DVS.Vector Word32) where-  bitRead = bitRead'--instance BitRead (DVS.Vector Word64) where-  bitRead = bitRead'--instance BitRead [Bool] where-  bitRead = sequence . fmap bitCharToBool . filter (/= ' ')

@@ -1,104 +0,0 @@-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE ScopedTypeVariables #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.BitShow-  ( BitShow(..)-  , bitShow-  ) where--import qualified Data.ByteString                as BS-import qualified Data.Vector                    as DV-import qualified Data.Vector.Storable           as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Word--class BitShow a where-  bitShows :: a -> String -> String--instance BitShow Bool where-  bitShows a = ((if a then '1' else '0'):)--instance BitShow Word8 where-  bitShows w =-      (if w .?. 0 then ('1':) else ('0':))-    . (if w .?. 1 then ('1':) else ('0':))-    . (if w .?. 2 then ('1':) else ('0':))-    . (if w .?. 3 then ('1':) else ('0':))-    . (if w .?. 4 then ('1':) else ('0':))-    . (if w .?. 5 then ('1':) else ('0':))-    . (if w .?. 6 then ('1':) else ('0':))-    . (if w .?. 7 then ('1':) else ('0':))--instance BitShow Word16 where-  bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b--instance BitShow Word32 where-  bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b--instance BitShow Word64 where-  bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b--instance BitShow [Bool] where-  bitShows ws = ('\"':) . go (0 :: Int) ws . ('\"':)-    where go _ []     = id-          go _ [u]    = bitShows u-          go n (u:us) = bitShows u . maybePrependSeperatorat n . go (n + 1) us-          maybePrependSeperatorat n = if n `mod` 8 == 7 then (' ':) else id--instance BitShow BS.ByteString where-  bitShows bs | BS.length bs == 0 = id-  bitShows bs | BS.length bs == 1 = bitShows (BS.head bs)-  bitShows bs                     = bitShows (BS.head bs) . (' ':) . bitShows (BS.tail bs)--instance BitShow [Word8] where-  bitShows []     = id-  bitShows [w]    = bitShows w-  bitShows (w:ws) = bitShows w . (' ':) . bitShows ws--instance BitShow [Word16] where-  bitShows []     = id-  bitShows [w]    = bitShows w-  bitShows (w:ws) = bitShows w . (' ':) . bitShows ws--instance BitShow [Word32] where-  bitShows []     = id-  bitShows [w]    = bitShows w-  bitShows (w:ws) = bitShows w . (' ':) . bitShows ws--instance BitShow [Word64] where-  bitShows []     = id-  bitShows [w]    = bitShows w-  bitShows (w:ws) = bitShows w . (' ':) . bitShows ws--instance BitShow (DV.Vector Word8) where-  bitShows = bitShows . DV.toList--instance BitShow (DV.Vector Word16) where-  bitShows = bitShows . DV.toList--instance BitShow (DV.Vector Word32) where-  bitShows = bitShows . DV.toList--instance BitShow (DV.Vector Word64) where-  bitShows = bitShows . DV.toList--instance BitShow (DVS.Vector Word8) where-  bitShows = bitShows . DVS.toList--instance BitShow (DVS.Vector Word16) where-  bitShows = bitShows . DVS.toList--instance BitShow (DVS.Vector Word32) where-  bitShows = bitShows . DVS.toList--instance BitShow (DVS.Vector Word64) where-  bitShows = bitShows . DVS.toList--bitShow :: BitShow a => a -> String-bitShow a = bitShows a ""

@@ -1,46 +0,0 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving         #-}--module HaskellWorks.Data.Bits.BitShown-  ( BitShown(..)-  , bitShown-  ) where--import qualified Data.ByteString                  as BS-import           Data.Maybe-import           Data.String-import           Data.Word-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.FromByteString--newtype BitShown a = BitShown a deriving (Eq, BitRead, BitShow)--deriving instance Functor BitShown--instance BitRead a => IsString (BitShown a) where-  fromString = fromJust . bitRead--instance BitShow a => Show (BitShown a) where-  show a = bitShows a ""--bitShown :: BitShown a -> a-bitShown (BitShown a) = a--deriving instance TestBit a => TestBit (BitShown a)--instance FromByteString (BitShown [Bool]) where-  fromByteString = BitShown . BS.foldr gen []-    where gen :: Word8 -> [Bool] -> [Bool]-          gen w bs =-            (w .&. 0x01 /= 0) :-            (w .&. 0x02 /= 0) :-            (w .&. 0x04 /= 0) :-            (w .&. 0x08 /= 0) :-            (w .&. 0x10 /= 0) :-            (w .&. 0x20 /= 0) :-            (w .&. 0x40 /= 0) :-            (w .&. 0x80 /= 0) : bs

@@ -1,213 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.BitWise-    ( -- * Bit map-      BitWise(..)-    , Shift(..)-    , TestBit(..)-    ) where--import qualified Data.Bits                           as B-import qualified Data.Vector                         as DV-import qualified Data.Vector.Storable                as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Vector.VectorLike as VL-import           Prelude                             as P---- We pervasively use precedence to avoid excessive parentheses, and we use--- the same precedence conventions of the C programming language: arithmetic--- operators come first, ordered in the standard way, followed by shifts,--- followed by logical operators; ⊕ sits between | and &.-infixl 9 .?.-infixl 8 .<., .>.-infixl 7 .&.        -- Bitwise AND.  eg. ∧-infixl 6 .^.        -- Bitwise XOR.  eg. ⊕-infixl 5 .|.        -- Bitwise OR.   eg. ∨--class Shift a where-  (.<.) :: a -> Count -> a-  (.>.) :: a -> Count -> a--class TestBit a where-  (.?.) :: a -> Position -> Bool--class BitWise a where-  (.&.) :: a -> a -> a-  (.|.) :: a -> a -> a-  (.^.) :: a -> a -> a-  comp  :: a -> a-  all0s :: a-  all1s :: a------------------------------------------------------------------------------------- Instances--instance TestBit Bool where-  (.?.) w 0 = w-  (.?.) _ _ = error "Invalid bit index"-  {-# INLINABLE (.?.) #-}--instance TestBit [Bool] where-  (.?.) v p = v !! fromIntegral p-  {-# INLINABLE (.?.) #-}--instance TestBit Word8 where-  (.?.) w n = B.testBit w (fromIntegral (getPosition n))-  {-# INLINABLE (.?.) #-}--instance TestBit Word16 where-  (.?.) w n = B.testBit w (fromIntegral (getPosition n))-  {-# INLINABLE (.?.) #-}--instance TestBit Word32 where-  (.?.) w n = B.testBit w (fromIntegral (getPosition n))-  {-# INLINABLE (.?.) #-}--instance TestBit Word64 where-  (.?.) w n = B.testBit w (fromIntegral (getPosition n))-  {-# INLINABLE (.?.) #-}--instance TestBit (DV.Vector Word8) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DV.Vector Word16) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DV.Vector Word32) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DV.Vector Word64) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DVS.Vector Word8) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DVS.Vector Word16) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DVS.Vector Word32) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance TestBit (DVS.Vector Word64) where-  (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r-  {-# INLINABLE (.?.) #-}--instance BitWise Word8 where-  (.&.) = (B..&.)-  {-# INLINABLE (.&.) #-}--  (.|.) = (B..|.)-  {-# INLINABLE (.|.) #-}--  (.^.) = B.xor-  {-# INLINABLE (.^.) #-}--  comp  = B.complement-  {-# INLINABLE comp #-}--  all0s = 0-  {-# INLINABLE all0s #-}--  all1s = 0-  {-# INLINABLE all1s #-}--instance BitWise Word16 where-  (.&.) = (B..&.)-  {-# INLINABLE (.&.) #-}--  (.|.) = (B..|.)-  {-# INLINABLE (.|.) #-}--  (.^.) = B.xor-  {-# INLINABLE (.^.) #-}--  comp  = B.complement-  {-# INLINABLE comp #-}--  all0s = 0-  {-# INLINABLE all0s #-}--  all1s = 0-  {-# INLINABLE all1s #-}--instance BitWise Word32 where-  (.&.) = (B..&.)-  {-# INLINABLE (.&.) #-}--  (.|.) = (B..|.)-  {-# INLINABLE (.|.) #-}--  (.^.) = B.xor-  {-# INLINABLE (.^.) #-}--  comp  = B.complement-  {-# INLINABLE comp #-}--  all0s = 0-  {-# INLINABLE all0s #-}--  all1s = 0-  {-# INLINABLE all1s #-}--instance BitWise Word64 where-  (.&.) = (B..&.)-  {-# INLINABLE (.&.) #-}--  (.|.) = (B..|.)-  {-# INLINABLE (.|.) #-}--  (.^.) = B.xor-  {-# INLINABLE (.^.) #-}--  comp  = B.complement-  {-# INLINABLE comp #-}--  all0s = 0-  {-# INLINABLE all0s #-}--  all1s = 0-  {-# INLINABLE all1s #-}--instance Shift Word8  where-  (.<.) w n = B.shiftL w (fromIntegral n)-  {-# INLINABLE (.<.) #-}--  (.>.) w n = B.shiftR w (fromIntegral n)-  {-# INLINABLE (.>.) #-}--instance Shift Word16 where-  (.<.) w n = B.shiftL w (fromIntegral n)-  {-# INLINABLE (.<.) #-}--  (.>.) w n = B.shiftR w (fromIntegral n)-  {-# INLINABLE (.>.) #-}--instance Shift Word32 where-  (.<.) w n = B.shiftL w (fromIntegral n)-  {-# INLINABLE (.<.) #-}--  (.>.) w n = B.shiftR w (fromIntegral n)-  {-# INLINABLE (.>.) #-}--instance Shift Word64 where-  (.<.) w n = B.shiftL w (fromIntegral n)-  {-# INLINABLE (.<.) #-}--  (.>.) w n = B.shiftR w (fromIntegral n)-  {-# INLINABLE (.>.) #-}

@@ -1,126 +0,0 @@-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE UndecidableInstances #-}--module HaskellWorks.Data.Bits.BitWise.String-  ( AsBits(..)-  , FromBits(..)-  , bitsToString-  , bitsShows-  , fromBitsDiff-  , fromBitsDiffN-  , stringToBits-  ) where--import Data.Bits-import Data.Word--bitsDiff' :: FiniteBits a => a -> Int -> Int -> [Bool] -> [Bool]-bitsDiff' a n len bs-  | n < len   = testBit a n : bitsDiff' a (n + 1) len bs-  | n == len  = bs-  | otherwise = error "Invalid index"--bits :: AsBits a => a -> [Bool]-bits a = bitsDiff a []--bitsShows' :: [Bool] -> ShowS-bitsShows' [] s = s-bitsShows' (True :bs) s = '1':bitsShows' bs s-bitsShows' (False:bs) s = '0':bitsShows' bs s--bitsShows :: AsBits a => a -> ShowS-bitsShows = bitsShows' . bits--bitsToString :: AsBits a => a -> String-bitsToString bs = bitsShows bs ""---- unbits :: AsBits a => [Bool] -> (a, [Bool])--- unbits a =  _uu----- bitsUnshows :: AsBits a => String -> (a, String)--- bitsUnshows = bitsShows' . bits------ stringToBits :: AsBits a => String -> (a, String)--- stringToBits as = _u--class AsBits a where-  bitsDiff :: a -> [Bool] -> [Bool]--class FromBits a where-  fromBits1 :: [Bool] -> (Maybe a, [Bool])------------------------------------------------------------------------------------instance AsBits Bool where-  bitsDiff = (:)--instance AsBits Word8 where-  bitsDiff a = bitsDiff' a 0 (finiteBitSize a)--instance AsBits a => AsBits [a] where-  bitsDiff [] = id-  bitsDiff (x:xs) = bitsDiff x . bitsDiff xs--instance FromBits Bool where-  fromBits1 [] = (Nothing, [])-  fromBits1 (b:bs) = (Just b, bs)--instance FromBits Word8 where-  fromBits1 (a:b:c:d:e:f:g:h:bs) = (,)-    (Just $ if a then 0x01 else 0 .|.-            if b then 0x02 else 0 .|.-            if c then 0x04 else 0 .|.-            if d then 0x08 else 0 .|.-            if e then 0x10 else 0 .|.-            if f then 0x20 else 0 .|.-            if g then 0x40 else 0 .|.-            if h then 0x80 else 0)-    bs-  fromBits1 bs = (Nothing, bs)--instance FromBits Word16 where-  fromBits1 (a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:bs) = (,)-    (Just $ if a then 0x0001 else 0 .|.-            if b then 0x0002 else 0 .|.-            if c then 0x0004 else 0 .|.-            if d then 0x0008 else 0 .|.-            if e then 0x0010 else 0 .|.-            if f then 0x0020 else 0 .|.-            if g then 0x0040 else 0 .|.-            if h then 0x0080 else 0 .|.-            if i then 0x0100 else 0 .|.-            if j then 0x0200 else 0 .|.-            if k then 0x0400 else 0 .|.-            if l then 0x0800 else 0 .|.-            if m then 0x1000 else 0 .|.-            if n then 0x2000 else 0 .|.-            if o then 0x4000 else 0 .|.-            if p then 0x8000 else 0)-    bs-  fromBits1 bs = (Nothing, bs)--fromBitsDiff :: FromBits a => [Bool] -> ([a] -> [a], [Bool])-fromBitsDiff bs = case fromBits1 bs of-  (Nothing, rs) -> (id  ,              rs)-  (Just a , rs) -> case fromBitsDiff rs of-    (f, ss) -> ((a:) . f, ss)--fromBitsDiffN :: FromBits a => Int -> [Bool] -> ([a] -> [a], [Bool])-fromBitsDiffN n bs-  | n >  0    = case fromBits1 bs of-                  (Nothing, rs) -> (id  , rs)-                  (Just a , rs) -> case fromBitsDiffN (n - 1) rs of-                    (f, ss) -> ((a:) . f, ss)-  | n == 0    = (id, bs)-  | n <  0    = error "Invalid count"-  | null bs   = (id, [])-  | otherwise = error "Error"--stringToBits :: String -> [Bool]-stringToBits [] = []-stringToBits ('1' :xs) = True :stringToBits xs-stringToBits ('0' :xs) = False:stringToBits xs-stringToBits (' ' :xs) = stringToBits xs-stringToBits ('\n':xs) = stringToBits xs-stringToBits (_   :_ ) = error "Invalid bit"

@@ -1,127 +0,0 @@-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE UndecidableInstances #-}--module HaskellWorks.Data.Bits.Conversion-  ( AsBits(..)-  , FromBits(..)-  , bitsToString-  , bitsShows-  , fromBitsDiff-  , fromBitsDiffN-  , stringToBits-  )-  where--import Data.Bits-import Data.Word--bitsDiff' :: FiniteBits a => a -> Int -> Int -> [Bool] -> [Bool]-bitsDiff' a n len bs-  | n < len   = testBit a n : bitsDiff' a (n + 1) len bs-  | n == len  = bs-  | otherwise = error "Invalid index"--bits :: AsBits a => a -> [Bool]-bits a = bitsDiff a []--bitsShows' :: [Bool] -> ShowS-bitsShows' [] s = s-bitsShows' (True :bs) s = '1':bitsShows' bs s-bitsShows' (False:bs) s = '0':bitsShows' bs s--bitsShows :: AsBits a => a -> ShowS-bitsShows = bitsShows' . bits--bitsToString :: AsBits a => a -> String-bitsToString bs = bitsShows bs ""---- unbits :: AsBits a => [Bool] -> (a, [Bool])--- unbits a =  _uu----- bitsUnshows :: AsBits a => String -> (a, String)--- bitsUnshows = bitsShows' . bits------ stringToBits :: AsBits a => String -> (a, String)--- stringToBits as = _u--class AsBits a where-  bitsDiff :: a -> [Bool] -> [Bool]--class FromBits a where-  fromBits1 :: [Bool] -> (Maybe a, [Bool])------------------------------------------------------------------------------------instance AsBits Bool where-  bitsDiff = (:)--instance AsBits Word8 where-  bitsDiff a = bitsDiff' a 0 (finiteBitSize a)--instance AsBits a => AsBits [a] where-  bitsDiff [] = id-  bitsDiff (x:xs) = bitsDiff x . bitsDiff xs--instance FromBits Bool where-  fromBits1 [] = (Nothing, [])-  fromBits1 (b:bs) = (Just b, bs)--instance FromBits Word8 where-  fromBits1 (a:b:c:d:e:f:g:h:bs) = (,)-    (Just $ if a then 0x01 else 0 .|.-            if b then 0x02 else 0 .|.-            if c then 0x04 else 0 .|.-            if d then 0x08 else 0 .|.-            if e then 0x10 else 0 .|.-            if f then 0x20 else 0 .|.-            if g then 0x40 else 0 .|.-            if h then 0x80 else 0)-    bs-  fromBits1 bs = (Nothing, bs)--instance FromBits Word16 where-  fromBits1 (a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:bs) = (,)-    (Just $ if a then 0x0001 else 0 .|.-            if b then 0x0002 else 0 .|.-            if c then 0x0004 else 0 .|.-            if d then 0x0008 else 0 .|.-            if e then 0x0010 else 0 .|.-            if f then 0x0020 else 0 .|.-            if g then 0x0040 else 0 .|.-            if h then 0x0080 else 0 .|.-            if i then 0x0100 else 0 .|.-            if j then 0x0200 else 0 .|.-            if k then 0x0400 else 0 .|.-            if l then 0x0800 else 0 .|.-            if m then 0x1000 else 0 .|.-            if n then 0x2000 else 0 .|.-            if o then 0x4000 else 0 .|.-            if p then 0x8000 else 0)-    bs-  fromBits1 bs = (Nothing, bs)--fromBitsDiff :: FromBits a => [Bool] -> ([a] -> [a], [Bool])-fromBitsDiff bs = case fromBits1 bs of-  (Nothing, rs) -> (id  ,              rs)-  (Just a , rs) -> case fromBitsDiff rs of-    (f, ss) -> ((a:) . f, ss)--fromBitsDiffN :: FromBits a => Int -> [Bool] -> ([a] -> [a], [Bool])-fromBitsDiffN n bs-  | n >  0    = case fromBits1 bs of-                  (Nothing, rs) -> (id  , rs)-                  (Just a , rs) -> case fromBitsDiffN (n - 1) rs of-                    (f, ss) -> ((a:) . f, ss)-  | n == 0    = (id, bs)-  | n <  0    = error "Invalid count"-  | null bs   = (id, [])-  | otherwise = error "Error"--stringToBits :: String -> [Bool]-stringToBits [] = []-stringToBits ('1' :xs) = True :stringToBits xs-stringToBits ('0' :xs) = False:stringToBits xs-stringToBits (' ' :xs) = stringToBits xs-stringToBits ('\n':xs) = stringToBits xs-stringToBits (_   :_ ) = error "Invalid bit"

@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies      #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.--module HaskellWorks.Data.Bits.ElemFixedBitSize-    ( ElemFixedBitSize(..)-    ) where--import qualified Data.Vector                   as DV-import qualified Data.Vector.Storable          as DVS-import           Data.Word-import           HaskellWorks.Data.Positioning--class ElemFixedBitSize v where-  type Elem v-  elemFixedBitSize :: v -> Count--instance ElemFixedBitSize [Bool] where-  type Elem [Bool] = Bool-  elemFixedBitSize _ = 1--instance ElemFixedBitSize [Word8] where-  type Elem [Word8] = Word8-  elemFixedBitSize _ = 8--instance ElemFixedBitSize [Word16] where-  type Elem [Word16] = Word16-  elemFixedBitSize _ = 16--instance ElemFixedBitSize [Word32] where-  type Elem [Word32] = Word32-  elemFixedBitSize _ = 32--instance ElemFixedBitSize [Word64] where-  type Elem [Word64] = Word64-  elemFixedBitSize _ = 64--instance ElemFixedBitSize (DV.Vector Bool) where-  type Elem (DV.Vector Bool) = Bool-  elemFixedBitSize _ = 1--instance ElemFixedBitSize (DV.Vector Word8) where-  type Elem (DV.Vector Word8) = Word8-  elemFixedBitSize _ = 8--instance ElemFixedBitSize (DV.Vector Word16) where-  type Elem (DV.Vector Word16) = Word16-  elemFixedBitSize _ = 16--instance ElemFixedBitSize (DV.Vector Word32) where-  type Elem (DV.Vector Word32) = Word32-  elemFixedBitSize _ = 32--instance ElemFixedBitSize (DV.Vector Word64) where-  type Elem (DV.Vector Word64) = Word64-  elemFixedBitSize _ = 64--instance ElemFixedBitSize (DVS.Vector Bool) where-  type Elem (DVS.Vector Bool) = Bool-  elemFixedBitSize _ = 1--instance ElemFixedBitSize (DVS.Vector Word8) where-  type Elem (DVS.Vector Word8) = Word8-  elemFixedBitSize _ = 8--instance ElemFixedBitSize (DVS.Vector Word16) where-  type Elem (DVS.Vector Word16) = Word16-  elemFixedBitSize _ = 16--instance ElemFixedBitSize (DVS.Vector Word32) where-  type Elem (DVS.Vector Word32) = Word32-  elemFixedBitSize _ = 32--instance ElemFixedBitSize (DVS.Vector Word64) where-  type Elem (DVS.Vector Word64) = Word64-  elemFixedBitSize _ = 64-

@@ -1,30 +0,0 @@--- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.--module HaskellWorks.Data.Bits.FixedBitSize-    ( FixedBitSize(..)-    ) where--import           Data.Word-import           HaskellWorks.Data.Positioning--class FixedBitSize a where-  fixedBitSize :: a -> Count--instance FixedBitSize Bool where-  fixedBitSize _ = 1--instance FixedBitSize Word8 where-  fixedBitSize _ = 8--instance FixedBitSize Word16 where-  fixedBitSize _ = 16--instance FixedBitSize Word32 where-  fixedBitSize _ = 32--instance FixedBitSize Word64 where-  fixedBitSize _ = 64

@@ -1,51 +0,0 @@--- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.FromBools-    ( FromBools(..)-    ) where--import           Data.Word-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.FixedBitSize--class FromBools a where-  fromBools :: [Bool] -> Maybe (a, [Bool])--instance FromBools Word8 where-  fromBools [] = Nothing-  fromBools xs = go 0 0 xs-    where go _ w []        = Just (w, [])-          go n w (y:ys)-            | n < fixedBitSize w  = go (n + 1) (if y then w .|. (1 .<. n) else w) ys-            | n < 0               = error "Invalid index"-            | otherwise           = Just (w, y:ys)--instance FromBools Word16 where-  fromBools [] = Nothing-  fromBools xs = go 0 0 xs-    where go _ w []        = Just (w, [])-          go n w (y:ys)-            | n < fixedBitSize w  = go (n + 1) (if y then w .|. (1 .<. n) else w) ys-            | n < 0               = error "Invalid index"-            | otherwise           = Just (w, y:ys)--instance FromBools Word32 where-  fromBools [] = Nothing-  fromBools xs = go 0 0 xs-    where go _ w []        = Just (w, [])-          go n w (y:ys)-            | n < fixedBitSize w  = go (n + 1) (if y then w .|. (1 .<. n) else w) ys-            | n < 0               = error "Invalid index"-            | otherwise           = Just (w, y:ys)--instance FromBools Word64 where-  fromBools [] = Nothing-  fromBools xs = go 0 0 xs-    where go _ w []        = Just (w, [])-          go n w (y:ys)-            | n < fixedBitSize w  = go (n + 1) (if y then w .|. (1 .<. n) else w) ys-            | n < 0               = error "Invalid index"-            | otherwise           = Just (w, y:ys)

@@ -1,19 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.PopCount-    ( -- * Bit map-      PopCount(..)-    , module X-    ) where--import           HaskellWorks.Data.Bits.PopCount.PopCount0 as X-import           HaskellWorks.Data.Bits.PopCount.PopCount1 as X-import           HaskellWorks.Data.Positioning--class PopCount v e where-  popCount :: e -> v -> Count

@@ -1,96 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.PopCount.PopCount0-    ( PopCount0(..)-    ) where--import qualified Data.Vector                               as DV-import qualified Data.Vector.Storable                      as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.PopCount.PopCount1-import           HaskellWorks.Data.Positioning-import           Prelude                                   as P--class PopCount0 v where-  popCount0 :: v -> Count--instance PopCount0 Bool where-  popCount0 True  = 0-  popCount0 False = 1-  {-# INLINABLE popCount0 #-}--instance PopCount0 Word8 where-  popCount0 x0 = bitLength x0 - popCount1 x0-  {-# INLINABLE popCount0 #-}--instance PopCount0 Word16 where-  popCount0 x0 = bitLength x0 - popCount1 x0-  {-# INLINABLE popCount0 #-}--instance PopCount0 Word32 where-  popCount0 x0 = bitLength x0 - popCount1 x0-  {-# INLINABLE popCount0 #-}--instance PopCount0 Word64 where-  popCount0 x0 = bitLength x0 - popCount1 x0-  {-# INLINABLE popCount0 #-}--instance PopCount0 [Bool] where-  popCount0 = P.sum . fmap popCount0-  {-# INLINABLE popCount0 #-}--instance PopCount0 [Word8] where-  popCount0 = P.sum . fmap popCount0-  {-# INLINABLE popCount0 #-}--instance PopCount0 [Word16] where-  popCount0 = P.sum . fmap popCount0-  {-# INLINABLE popCount0 #-}--instance PopCount0 [Word32] where-  popCount0 = P.sum . fmap popCount0-  {-# INLINABLE popCount0 #-}--instance PopCount0 [Word64] where-  popCount0 = P.sum . fmap popCount0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DV.Vector Word8) where-  popCount0 = DV.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DV.Vector Word16) where-  popCount0 = DV.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DV.Vector Word32) where-  popCount0 = DV.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DV.Vector Word64) where-  popCount0 = DV.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DVS.Vector Word8) where-  popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DVS.Vector Word16) where-  popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DVS.Vector Word32) where-  popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}--instance PopCount0 (DVS.Vector Word64) where-  popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0-  {-# INLINABLE popCount0 #-}

@@ -1,11 +0,0 @@---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.PopCount.PopCount1-    ( module X-    ) where--import           HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword as X

@@ -1,111 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword-    ( PopCount1(..)-    ) where--import qualified Data.Vector                    as DV-import qualified Data.Vector.Storable           as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Positioning-import           Prelude                        as P--class PopCount1 v where-  popCount1 :: v -> Count--instance PopCount1 Bool where-  popCount1 True  = 1-  popCount1 False = 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word8 where-  popCount1 x0 = Count (fromIntegral x3)-    where-      x1 = x0 - ((x0 .&. 0xaa) .>. 1)-      x2 = (x1 .&. 0x33) + ((x1 .>. 2) .&. 0x33)-      x3 = (x2 + (x2 .>. 4)) .&. 0x0f-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word16 where-  popCount1 x0 = Count (fromIntegral ((x3 * 0x0101) .>. 8))-    where-      x1 = x0 - ((x0 .&. 0xaaaa) .>. 1)-      x2 = (x1 .&. 0x3333) + ((x1 .>. 2) .&. 0x3333)-      x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word32 where-  popCount1 x0 = Count (fromIntegral ((x3 * 0x01010101) .>. 24))-    where-      x1 = x0 - ((x0 .&. 0xaaaaaaaa) .>. 1)-      x2 = (x1 .&. 0x33333333) + ((x1 .>. 2) .&. 0x33333333)-      x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f0f0f-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word64 where-  popCount1 x0 = Count ((x3 * 0x0101010101010101) .>. 56)-    where-      x1 = x0 - ((x0 .&. 0xaaaaaaaaaaaaaaaa) .>. 1)-      x2 = (x1 .&. 0x3333333333333333) + ((x1 .>. 2) .&. 0x3333333333333333)-      x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Bool] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word8] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word16] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word32] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word64] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word8) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word16) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word32) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word64) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word8) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word16) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word32) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word64) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}

@@ -1,95 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}---- |--- Copyright: 2016 John Ky--- License: MIT------ Succinct operations.-module HaskellWorks.Data.Bits.PopCount.PopCount1.GHC-    ( PopCount1(..)-    ) where--import qualified Data.Bits                     as DB-import qualified Data.Vector                   as DV-import qualified Data.Vector.Storable          as DVS-import           Data.Word-import           HaskellWorks.Data.Positioning-import           Prelude                       as P--class PopCount1 v where-  popCount1 :: v -> Count--instance PopCount1 Bool where-  popCount1 True  = 1-  popCount1 False = 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word8 where-  popCount1 = fromIntegral . DB.popCount-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word16 where-  popCount1 = fromIntegral . DB.popCount-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word32 where-  popCount1 = fromIntegral . DB.popCount-  {-# INLINABLE popCount1 #-}--instance PopCount1 Word64 where-  popCount1 = fromIntegral . DB.popCount-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Bool] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word8] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word16] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word32] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 [Word64] where-  popCount1 = P.sum . fmap popCount1-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word8) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word16) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word32) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DV.Vector Word64) where-  popCount1 = DV.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word8) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word16) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word32) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}--instance PopCount1 (DVS.Vector Word64) where-  popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0-  {-# INLINABLE popCount1 #-}

@@ -1,11 +0,0 @@-module HaskellWorks.Data.ByteString-  ( chunkedBy-  ) where--import qualified Data.ByteString as BS--chunkedBy :: Int -> BS.ByteString -> [BS.ByteString]-chunkedBy n bs = if BS.length bs == 0-  then []-  else case BS.splitAt n bs of-    (as, zs) -> as : chunkedBy n zs

@@ -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))

@@ -4,29 +4,22 @@ module HaskellWorks.Data.Conduit.Json   ( blankedJsonToInterestBits   , byteStringToBits-  , markerToByteString   , blankedJsonToBalancedParens-  , jsonToken2Markers-  , textToJsonToken+  , blankedJsonToBalancedParens2+  , compressWordAsBit   , interestingWord8s-  , jsonToken2BalancedParens   ) where  import           Control.Monad-import           Control.Monad.Trans.Resource                         (MonadThrow)-import           Data.Array.Unboxed                                   as A-import qualified Data.Bits                                            as BITS-import           Data.ByteString                                      as BS+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           HaskellWorks.Data.Conduit.Tokenize.Attoparsec-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Offset-import           HaskellWorks.Data.Json.Final.Tokenize-import           HaskellWorks.Data.Json.Token-import           Prelude                                              as P+import           Prelude                              as P  interestingWord8s :: A.UArray Word8 Word8 interestingWord8s = A.array (0, 255) [@@ -65,64 +58,6 @@                     , BS.drop 8 as                     ) -markerToByteString' :: Monad m => Int64 -> Word8 -> Conduit Int64 m BS.ByteString-markerToByteString' a v = do-  mo <- await-  case mo of-    Just o -> if o < (a + 8)-      then markerToByteString' a (BITS.bit (fromIntegral (o - a)) .|. v)-      else do-        yield $ BS.singleton v-        leftover o-        markerToByteString' (a + 8) 0-    Nothing -> when (v /= 0) $ yield $ BS.singleton v--markerToByteString :: Monad m => Conduit Int64 m BS.ByteString-markerToByteString = markerToByteString' 0 0--textToJsonToken :: MonadThrow m => Conduit BS.ByteString m (ParseDelta Offset, JsonToken)-textToJsonToken = conduitParser (Offset 0) parseJsonToken--jsonToken2Markers :: Monad m => Conduit (ParseDelta Offset, JsonToken) m Int64-jsonToken2Markers = do-  mi <- await-  case mi of-    Just (ParseDelta (Offset start) _, token) -> do-      case token of-        JsonTokenBraceL     -> yield $ fromIntegral start-        JsonTokenBraceR     -> return ()-        JsonTokenBracketL   -> yield $ fromIntegral start-        JsonTokenBracketR   -> return ()-        JsonTokenComma      -> return ()-        JsonTokenColon      -> return ()-        JsonTokenWhitespace -> return ()-        JsonTokenString _   -> yield $ fromIntegral start-        JsonTokenBoolean _  -> yield $ fromIntegral start-        JsonTokenNumber _   -> yield $ fromIntegral start-        JsonTokenNull       -> yield $ fromIntegral start-      jsonToken2Markers-    Nothing -> return ()--jsonToken2BalancedParens :: Monad m => Conduit (ParseDelta Offset, JsonToken) m Bool-jsonToken2BalancedParens = do-  mi <- await-  case mi of-    Just (ParseDelta (Offset _) _, token) -> do-      case token of-        JsonTokenBraceL     -> yield True-        JsonTokenBraceR     -> yield False-        JsonTokenBracketL   -> yield True-        JsonTokenBracketR   -> yield False-        JsonTokenComma      -> return ()-        JsonTokenColon      -> return ()-        JsonTokenWhitespace -> return ()-        JsonTokenString _   -> yield True >> yield False-        JsonTokenBoolean _  -> yield True >> yield False-        JsonTokenNumber _   -> yield True >> yield False-        JsonTokenNull       -> yield True >> yield False-      jsonToken2BalancedParens-    Nothing -> return ()- blankedJsonToBalancedParens :: Monad m => Conduit BS.ByteString m Bool blankedJsonToBalancedParens = do   mbs <- await@@ -148,7 +83,55 @@     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

@@ -78,6 +78,12 @@ 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) 

@@ -1,29 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}---- |--- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin--- License: MIT------ Conduits for tokenizing streams.------ This code was taken from attoparsec-enumerator and adapted for conduits.-module HaskellWorks.Data.Conduit.Tokenize.Attoparsec-    ( -- * Sink-      sinkParser-    , sinkParserEither-      -- * Conduit-    , conduitParser-    , conduitParserEither--      -- * Types-    , ParseError (..)-    , ParseDelta (..)-      -- * Classes-    , AttoparsecInput(..)-    , AttoparsecState(..)-    ) where--import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Internal

@@ -1,196 +0,0 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}---- |--- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin--- License: MIT------ Consume attoparsec parsers via conduit.------ This code was taken from attoparsec-enumerator and adapted for conduits.-module HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Internal-    ( -- * Sink-      sinkParser-    , sinkParserEither-      -- * Conduit-    , conduitParser-    , conduitParserEither--      -- * Types-    , ParseError (..)-    , ParseDelta (..)-      -- * Classes-    , AttoparsecInput(..)-    , AttoparsecState(..)-    ) where--import           Control.Exception            (Exception)-import           Control.Monad                (unless)-import           Control.Monad.Trans.Resource (MonadThrow, monadThrow)-import qualified Data.Attoparsec.ByteString-import qualified Data.Attoparsec.Text-import qualified Data.Attoparsec.Types        as A-import qualified Data.ByteString              as B-import           Data.Conduit-import qualified Data.Text                    as T-import qualified Data.Text.Internal           as TI-import           Data.Typeable                (Typeable)-import           Prelude                      hiding (lines)---- | The context and message from a 'A.Fail' value.-data ParseError s = ParseError-    { errorContexts :: [String]-    , errorMessage  :: String-    , errorPosition :: s-    } | DivergentParser-    deriving (Show, Typeable)---- | The before and after state of a single parse in a conduit stream.-data ParseDelta s = ParseDelta-    { before :: !s-    , after  :: !s-    }-    deriving (Eq, Ord)---- | A class of types which may be consumed by an Attoparsec parser.-class AttoparsecInput a where-    parseA :: A.Parser a b -> a -> A.IResult a b-    feedA :: A.IResult a b -> a -> A.IResult a b-    empty :: a-    isNull :: a -> Bool-    notEmpty :: [a] -> [a]--    -- | Return the beginning of the first input with the length of-    -- the second input removed. Assumes the second string is shorter-    -- than the first.-    stripFromEnd :: a -> a -> a---- | A class of types and states which may be consumed by an Attoparsec parser.-class AttoparsecState a s where-    getState :: a -> s-    modState :: AttoparsecInput a => a -> s -> s--instance AttoparsecInput B.ByteString where-    parseA = Data.Attoparsec.ByteString.parse-    feedA = Data.Attoparsec.ByteString.feed-    empty = B.empty-    isNull = B.null-    notEmpty = filter (not . B.null)-    stripFromEnd b1 b2 = B.take (B.length b1 - B.length b2) b1--instance AttoparsecInput T.Text where-    parseA = Data.Attoparsec.Text.parse-    feedA = Data.Attoparsec.Text.feed-    empty = T.empty-    isNull = T.null-    notEmpty = filter (not . T.null)-    stripFromEnd (TI.Text arr1 off1 len1) (TI.Text _ _ len2) =-        TI.text arr1 off1 (len1 - len2)---- | Convert an Attoparsec 'A.Parser' into a 'Sink'. The parser will--- be streamed bytes until it returns 'A.Done' or 'A.Fail'.------ If parsing fails, a 'ParseError' will be thrown with 'monadThrow'.------ Since 0.5.0-sinkParser :: (AttoparsecInput a, AttoparsecState a s, MonadThrow m, Exception (ParseError s)) => s -> A.Parser a b -> Consumer a m b-sinkParser s = fmap snd . sinkParserPosErr s---- | Same as 'sinkParser', but we return an 'Either' type instead--- of raising an exception.------ Since 1.1.5-sinkParserEither :: (AttoparsecInput a, AttoparsecState a s, Monad m) => s -> A.Parser a b -> Consumer a m (Either (ParseError s) b)-sinkParserEither s = (fmap.fmap) snd . sinkParserPos s---- | Consume a stream of parsed tokens, returning both the token and--- the position it appears at. This function will raise a 'ParseError'--- on bad input.------ Since 0.5.0-conduitParser :: (AttoparsecInput a, AttoparsecState a s, MonadThrow m, Exception (ParseError s)) => s -> A.Parser a b -> Conduit a m (ParseDelta s, b)-conduitParser s parser = conduit s-       where-         conduit !pos = await >>= maybe (return ()) go-             where-               go x = do-                   leftover x-                   (!pos', !res) <- sinkParserPosErr pos parser-                   yield (ParseDelta pos pos', res)-                   conduit pos'-{-# INLINABLE conduitParser #-}---- | Same as 'conduitParser', but we return an 'Either' type instead--- of raising an exception.-conduitParserEither-    :: (Monad m, AttoparsecInput a, AttoparsecState a s)-    => s-    -> A.Parser a b-    -> Conduit a m (Either (ParseError s) (ParseDelta s, b))-conduitParserEither s parser = conduit s-  where-    conduit !pos = await >>= maybe (return ()) go-      where-        go x = do-          leftover x-          eres <- sinkParserPos pos parser-          case eres of-            Left e -> yield $ Left e-            Right (!pos', !res) -> do-              yield $! Right (ParseDelta pos pos', res)-              conduit pos'-{-# INLINABLE conduitParserEither #-}--sinkParserPosErr-    :: (AttoparsecInput a, AttoparsecState a s, MonadThrow m, Exception (ParseError s))-    => s-    -> A.Parser a b-    -> Consumer a m (s, b)-sinkParserPosErr s p = sinkParserPos s p >>= f-    where-      f (Left e) = monadThrow e-      f (Right a) = return a-{-# INLINABLE sinkParserPosErr #-}--sinkParserPos-    :: (AttoparsecInput a, AttoparsecState a s, Monad m)-    => s-    -> A.Parser a b-    -> Consumer a m (Either (ParseError s) (s, b))-sinkParserPos s p = sink empty s (parseA p)-  where-    -- sink :: a -> s -> (a -> A.IResult a b) -> Consumer a m (Either (ParseError s) (s, b))-    sink prev pos parser = await >>= maybe close push-      where-        push c-            | isNull c  = sink prev pos parser-            | otherwise = go False c $ parser c--        close = go True prev (feedA (parser empty) empty)--        go end c (A.Done lo x) = do-            let pos'-                    | end       = pos-                    | otherwise = modState prev pos-                y = stripFromEnd c lo-                pos'' = modState y pos'-            unless (isNull lo) $ leftover lo-            pos'' `seq` return $! Right (pos'', x)-        go end c (A.Fail rest contexts msg) =-            let x = stripFromEnd c rest-                pos'-                    | end       = pos-                    | otherwise = modState prev pos-                pos'' = modState x pos'-             in pos'' `seq` return $! Left (ParseError contexts msg pos'')-        go end c (A.Partial parser')-            | end       = return $! Left DivergentParser-            | otherwise =-                pos' `seq` sink c pos' parser'-              where-                pos' = modState prev pos--{-# INLINABLE sinkParserPos #-}

@@ -1,84 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin--- License: MIT------ Conduits for tokenizing streams.------ This code was taken from attoparsec-enumerator and adapted for conduits.-module HaskellWorks.Data.Conduit.Tokenize.Attoparsec.LineColumn-    ( Position (..)-    ) where--import           Control.Exception                                      (Exception)-import           Control.Monad.Trans.Resource                           (MonadThrow)-import qualified Data.Attoparsec.Types                                  as A-import qualified Data.ByteString                                        as B-import           Data.Conduit-import qualified Data.Text                                              as T-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Internal-import           Prelude                                                hiding (lines)--data Position = Position-    { posLine :: {-# UNPACK #-} !Int-    , posCol  :: {-# UNPACK #-} !Int-    }-    deriving (Eq, Ord)--instance Show Position where-    show (Position l c) = show l ++ ':' : show c--instance Exception (ParseError Position)--instance Show (ParseDelta Position) where-    show (ParseDelta s e) = show s ++ '-' : show e--instance AttoparsecState B.ByteString Position where-    getState = B.foldl' f (Position 0 0)-      where-        f (Position l c) ch | ch == 10 = Position (l + 1) 0-                            | otherwise = Position l (c + 1)-    modState x (Position lines cols) =-        lines' `seq` cols' `seq` Position lines' cols'-      where-        Position dlines dcols = getState x-        lines' = lines + dlines-        cols' = (if dlines > 0 then 1 else cols) + dcols--instance AttoparsecState T.Text Position where-    getState = T.foldl' f (Position 0 0)-      where-        f (Position l c) ch | ch == '\n' = Position (l + 1) 0-                            | otherwise = Position l (c + 1)-    modState x (Position lines cols) =-        lines' `seq` cols' `seq` Position lines' cols'-      where-        Position dlines dcols = getState x-        lines' = lines + dlines-        cols' = (if dlines > 0 then 1 else cols) + dcols--{-# SPECIALIZE conduitParser-                  :: MonadThrow m-                  => Position-                  -> A.Parser T.Text b-                  -> Conduit T.Text m (ParseDelta Position, b) #-}--{-# SPECIALIZE conduitParser-                  :: MonadThrow m-                  => Position-                  -> A.Parser B.ByteString b-                  -> Conduit B.ByteString m (ParseDelta Position, b) #-}--{-# SPECIALIZE conduitParserEither-                  :: Monad m-                  => Position-                  -> A.Parser T.Text b-                  -> Conduit T.Text m (Either (ParseError Position) (ParseDelta Position, b)) #-}--{-# SPECIALIZE conduitParserEither-                  :: Monad m-                  => Position-                  -> A.Parser B.ByteString b-                  -> Conduit B.ByteString m (Either (ParseError Position) (ParseDelta Position, b)) #-}

@@ -1,79 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin--- License: MIT------ Conduits for tokenizing streams.------ This code was taken from attoparsec-enumerator and adapted for conduits.-module HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Offset-    ( Offset (..)-    ) where--import           Control.Exception                                      (Exception)-import           Control.Monad.Trans.Resource                           (MonadThrow)-import qualified Data.Attoparsec.Types                                  as A-import qualified Data.ByteString                                        as B-import           Data.Conduit-import           Data.Int-import qualified Data.Text                                              as T-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Internal-import           Prelude                                                hiding (lines)--data Offset = Offset-    { pos :: {-# UNPACK #-} !Int64-    }-    deriving (Eq, Ord)--instance Show Offset where-    show (Offset c) = show c--instance Exception (ParseError Offset)--instance Show (ParseDelta Offset) where-    show (ParseDelta s e) = show s ++ '-' : show e--instance AttoparsecState B.ByteString Offset where-    getState = B.foldl' f (Offset 0)-      where-        f (Offset c) _ = Offset (c + 1)-    modState x (Offset cols) = cols' `seq` Offset cols'-      where-        Offset dcols = getState x-        cols' = cols + dcols--instance AttoparsecState T.Text Offset where-    getState = T.foldl' f (Offset 0)-      where-        f (Offset c) _ = Offset (c + 1)-    modState x (Offset cols) =-        cols' `seq` Offset cols'-      where-        Offset dcols = getState x-        cols' = cols + dcols--{-# SPECIALIZE conduitParser-                  :: MonadThrow m-                  => Offset-                  -> A.Parser T.Text b-                  -> Conduit T.Text m (ParseDelta Offset, b) #-}--{-# SPECIALIZE conduitParser-                  :: MonadThrow m-                  => Offset-                  -> A.Parser B.ByteString b-                  -> Conduit B.ByteString m (ParseDelta Offset, b) #-}--{-# SPECIALIZE conduitParserEither-                  :: Monad m-                  => Offset-                  -> A.Parser T.Text b-                  -> Conduit T.Text m (Either (ParseError Offset) (ParseDelta Offset, b)) #-}--{-# SPECIALIZE conduitParserEither-                  :: Monad m-                  => Offset-                  -> A.Parser B.ByteString b-                  -> Conduit B.ByteString m (Either (ParseError Offset) (ParseDelta Offset, b)) #-}

@@ -1,8 +0,0 @@-module HaskellWorks.Data.FromByteString-  ( FromByteString(..)-  ) where--import           Data.ByteString.Internal--class FromByteString a where-  fromByteString :: ByteString -> a

@@ -1,7 +0,0 @@-module HaskellWorks.Data.FromForeignRegion where--import           Data.Word-import           Foreign.ForeignPtr--class FromForeignRegion a where-  fromForeignRegion :: (ForeignPtr Word8, Int, Int) -> a

@@ -2,5 +2,4 @@     ( parseJsonToken     ) where -import           HaskellWorks.Data.Attoparsec.Final.Parser.ByteString () import           HaskellWorks.Data.Json.Final.Tokenize.Internal

@@ -2,5 +2,4 @@   ( module X   ) where -import HaskellWorks.Data.Json.Succinct.Cursor     as X-import HaskellWorks.Data.Json.Succinct.Transform  as X+import           HaskellWorks.Data.Json.Succinct.Cursor as X

@@ -8,9 +8,11 @@   , getJsonBalancedParens   ) where +import           Control.Applicative+import qualified Data.ByteString                                    as BS+import           Data.Conduit import qualified Data.Vector.Storable                               as DVS import           Data.Word-import           HaskellWorks.Data.Bits.FromBools import           HaskellWorks.Data.Conduit.Json import           HaskellWorks.Data.Conduit.List import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson@@ -21,14 +23,29 @@ getJsonBalancedParens :: JsonBalancedParens a -> a getJsonBalancedParens (JsonBalancedParens a) = a +genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString)+genBitWordsForever bs = BS.uncons bs <|> Just (0, bs)+{-# INLINABLE genBitWordsForever #-}++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens [Bool])) where+  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (runListConduit blankedJsonToBalancedParens bj))+ instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where-  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))+  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where-  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))+  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where-  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))+  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where-  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))+  fromBlankedJson bj    = JsonBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))+    where interestBS    = BS.concat (runListConduit (blankedJsonToBalancedParens2 =$= compressWordAsBit) (getBlankedJson bj))+          newLen        = (BS.length interestBS + 7) `div` 8 * 8

@@ -16,6 +16,7 @@ import           HaskellWorks.Data.Bits.BitShown import           HaskellWorks.Data.Conduit.Json import           HaskellWorks.Data.Conduit.List+import           HaskellWorks.Data.FromByteString import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 @@ -33,11 +34,14 @@ genInterestForever :: ByteString -> Maybe (Word8, ByteString) genInterestForever bs = BS.uncons bs <|> Just (0, bs) +instance FromBlankedJson (JsonInterestBits (BitShown [Bool])) where+  fromBlankedJson = JsonInterestBits . fromByteString . BS.concat . runListConduit blankedJsonToInterestBits . getBlankedJson+ instance FromBlankedJson (JsonInterestBits (BitShown BS.ByteString)) where-  fromBlankedJson (BlankedJson bj) = JsonInterestBits (BitShown (BS.unfoldr genInterest (blankedJsonBssToInterestBitsBs bj)))+  fromBlankedJson = JsonInterestBits . BitShown . BS.unfoldr genInterest . blankedJsonBssToInterestBitsBs . getBlankedJson  instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word8))) where-  fromBlankedJson (BlankedJson bj) = JsonInterestBits (BitShown (DVS.unfoldr genInterest (blankedJsonBssToInterestBitsBs bj)))+  fromBlankedJson = JsonInterestBits . BitShown . DVS.unfoldr genInterest . blankedJsonBssToInterestBitsBs . getBlankedJson  instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word16))) where   fromBlankedJson bj = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))

@@ -20,7 +20,6 @@ import           HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import           HaskellWorks.Data.Json.Succinct.Cursor.InterestBits-import           HaskellWorks.Data.Json.Succinct.Transform import           HaskellWorks.Data.Positioning import           HaskellWorks.Data.Succinct.BalancedParens             as BP import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512@@ -49,11 +48,11 @@   fromString s = JsonCursor     { cursorText      = s     , cursorRank      = 1-    , balancedParens  = SimpleBalancedParens (jsonToInterestBalancedParens [bs])-    , interests       = BitShown interests'+    , interests       = getJsonInterestBits (fromBlankedJson blankedJson)+    , balancedParens  = getJsonBalancedParens (fromBlankedJson blankedJson)     }-    where bs          = BSC.pack s :: BS.ByteString-          interests'  = jsonToInterestBits [bs]+    where blankedJson :: BlankedJson+          blankedJson = fromByteString (BSC.pack s)  instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where   fromString = fromByteString . BSC.pack

@@ -1,18 +0,0 @@-module HaskellWorks.Data.Json.Succinct.Transform-  ( jsonToInterestBits-  , jsonToInterestBalancedParens-  ) where--import qualified Data.ByteString                      as BS-import           Data.Conduit-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Conduit.Json-import           HaskellWorks.Data.Conduit.Json.Blank-import           HaskellWorks.Data.Conduit.List-import           HaskellWorks.Data.FromByteString--jsonToInterestBits :: [BS.ByteString] -> [Bool]-jsonToInterestBits json = bitShown (fromByteString (BS.concat $ runListConduit (blankJson =$= blankedJsonToInterestBits) json))--jsonToInterestBalancedParens :: [BS.ByteString] -> [Bool]-jsonToInterestBalancedParens = runListConduit (blankJson =$= blankedJsonToBalancedParens)

@@ -1,34 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module HaskellWorks.Data.Positioning-  ( Count(..)-  , Position(..)-  , lastPositionOf-  , toCount-  , toPosition-  ) where--import           Data.Int-import           Data.Word-import           System.Random--newtype Count = Count { getCount :: Word64 }-  deriving (Eq, Num, Ord, Enum, Integral, Real, Random)--instance Show Count where-    show (Count w64) = show w64--newtype Position = Position { getPosition :: Int64 }-  deriving (Eq, Num, Ord, Enum, Real, Integral)--instance Show Position where-    show (Position n) = show n--toPosition :: Count -> Position-toPosition (Count n) = Position (fromIntegral n)--toCount :: Position -> Count-toCount (Position n) = Count (fromIntegral n)--lastPositionOf :: Count -> Position-lastPositionOf (Count c)  = Position (fromIntegral c - 1)

@@ -1,12 +0,0 @@-module HaskellWorks.Data.Search-    ( binarySearch-    ) where--binarySearch :: (Ord a, Integral n) => a -> (n -> a) -> n -> n -> n-binarySearch w f p q = if p + 1 >= q-  then p-  else let m = p + q `div` 2 in-    if w <= f m-      then binarySearch w f p m-      else binarySearch w f m q-{-# INLINABLE binarySearch #-}

@@ -28,18 +28,22 @@  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 .?. lastPositionOf c)+closeAt v c = not (v .?. toPosition (c - 1))+{-# INLINABLE closeAt #-}  openAt :: TestBit a => a -> Count -> Bool-openAt v c = v .?. lastPositionOf c+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 =@@ -49,6 +53,7 @@       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 =@@ -58,48 +63,76 @@       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   #-}

@@ -1,68 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Vector.BoxedVectorLike-  ( BoxedVectorLike(..)-  ) where--import qualified Data.Vector      as DV-import           Data.Word-import           Foreign.Storable--class BoxedVectorLike v e where-  bImap :: (Int -> a -> b) -> v a -> v b-  bMap :: (a -> b) -> v a -> v b-  bUnfoldr :: (Storable a) => (b -> Maybe (a, b)) -> b -> v a-  bUnfoldrN :: (Storable a) => Int -> (b -> Maybe (a, b)) -> b -> v a--instance BoxedVectorLike DV.Vector Word8 where-  bImap = DV.imap-  {-# INLINABLE bImap #-}--  bMap = DV.map-  {-# INLINABLE bMap #-}--  bUnfoldr = DV.unfoldr-  {-# INLINABLE bUnfoldr #-}--  bUnfoldrN = DV.unfoldrN-  {-# INLINABLE bUnfoldrN #-}--instance BoxedVectorLike DV.Vector Word16 where-  bImap = DV.imap-  {-# INLINABLE bImap #-}--  bMap = DV.map-  {-# INLINABLE bMap #-}--  bUnfoldr = DV.unfoldr-  {-# INLINABLE bUnfoldr #-}--  bUnfoldrN = DV.unfoldrN-  {-# INLINABLE bUnfoldrN #-}--instance BoxedVectorLike DV.Vector Word32 where-  bImap = DV.imap-  {-# INLINABLE bImap #-}--  bMap = DV.map-  {-# INLINABLE bMap #-}--  bUnfoldr = DV.unfoldr-  {-# INLINABLE bUnfoldr #-}--  bUnfoldrN = DV.unfoldrN-  {-# INLINABLE bUnfoldrN #-}--instance BoxedVectorLike DV.Vector Word64 where-  bImap = DV.imap-  {-# INLINABLE bImap #-}--  bMap = DV.map-  {-# INLINABLE bMap #-}--  bUnfoldr = DV.unfoldr-  {-# INLINABLE bUnfoldr #-}--  bUnfoldrN = DV.unfoldrN-  {-# INLINABLE bUnfoldrN #-}

@@ -1,38 +0,0 @@--- from spool---- | Convert between @ByteString@ and @Vector.Storable@--- without copying.-module HaskellWorks.Data.Vector.Storable.ByteString-    ( -- | See also the caveats mentioned in the package's-      -- top-level documentation.-      byteStringToVector-    , vectorToByteString-    ) where--import qualified Data.ByteString          as BS-import qualified Data.ByteString.Internal as BS-import qualified Data.Vector.Storable     as V--import           Foreign.ForeignPtr-import           Foreign.Storable--sizeOfElem :: (Storable a) => V.Vector a -> Int-sizeOfElem vec = sizeOf (undefined `asTypeOf` V.head vec)---- | Convert a @'BS.ByteString'@ to a @'V.Vector'@.------ This function can produce @'Vector'@s which do not obey--- architectural alignment requirements.  On @x86@ this should--- not be an issue.-byteStringToVector :: (Storable a) => BS.ByteString -> V.Vector a-byteStringToVector bs = vec where-    vec = V.unsafeFromForeignPtr (castForeignPtr fptr) (scale off) (scale len)-    (fptr, off, len) = BS.toForeignPtr bs-    scale = (`div` sizeOfElem vec)---- | Convert a @'V.Vector'@ to a @'BS.ByteString'@.-vectorToByteString :: (Storable a) => V.Vector a -> BS.ByteString-vectorToByteString vec-  = BS.fromForeignPtr (castForeignPtr fptr) (scale off) (scale len) where-    (fptr, off, len) = V.unsafeToForeignPtr vec-    scale = (* sizeOfElem vec)

@@ -1,68 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Vector.StorableVectorLike-  ( StorableVectorLike(..)-  ) where--import qualified Data.Vector.Storable as DVS-import           Data.Word-import           Foreign.Storable--class StorableVectorLike v e where-  sImap :: (Storable a, Storable b) => (Int -> a -> b) -> v a -> v b-  sMap :: (Storable a, Storable b) => (a -> b) -> v a -> v b-  sUnfoldr :: (Storable a) => (b -> Maybe (a, b)) -> b -> v a-  sUnfoldrN :: (Storable a) => Int -> (b -> Maybe (a, b)) -> b -> v a--instance StorableVectorLike DVS.Vector Word8 where-  sImap = DVS.imap-  {-# INLINABLE sImap #-}--  sMap = DVS.map-  {-# INLINABLE sMap #-}--  sUnfoldr = DVS.unfoldr-  {-# INLINABLE sUnfoldr #-}--  sUnfoldrN = DVS.unfoldrN-  {-# INLINABLE sUnfoldrN #-}--instance StorableVectorLike DVS.Vector Word16 where-  sImap = DVS.imap-  {-# INLINABLE sImap #-}--  sMap = DVS.map-  {-# INLINABLE sMap #-}--  sUnfoldr = DVS.unfoldr-  {-# INLINABLE sUnfoldr #-}--  sUnfoldrN = DVS.unfoldrN-  {-# INLINABLE sUnfoldrN #-}--instance StorableVectorLike DVS.Vector Word32 where-  sImap = DVS.imap-  {-# INLINABLE sImap #-}--  sMap = DVS.map-  {-# INLINABLE sMap #-}--  sUnfoldr = DVS.unfoldr-  {-# INLINABLE sUnfoldr #-}--  sUnfoldrN = DVS.unfoldrN-  {-# INLINABLE sUnfoldrN #-}--instance StorableVectorLike DVS.Vector Word64 where-  sImap = DVS.imap-  {-# INLINABLE sImap #-}--  sMap = DVS.map-  {-# INLINABLE sMap #-}--  sUnfoldr = DVS.unfoldr-  {-# INLINABLE sUnfoldr #-}--  sUnfoldrN = DVS.unfoldrN-  {-# INLINABLE sUnfoldrN #-}

@@ -1,453 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}--module HaskellWorks.Data.Vector.VectorLike-  ( VectorLike(..)-  ) where--import qualified Data.ByteString               as BS-import qualified Data.Vector                   as DV-import qualified Data.Vector.Storable          as DVS-import           Data.Word-import           HaskellWorks.Data.Positioning--class VectorLike v where-  type Elem v--  vToList :: v -> [Elem v]-  vFromList :: [Elem v] -> v-  (!!!) :: v -> Position -> Elem v-  vConcat :: [v] -> v-  vEmpty :: v-  vFilter :: (Elem v -> Bool) -> v -> v-  vGenerate :: Int -> (Int -> Elem v) -> v-  vLength :: v -> Count-  vSnoc :: v -> Elem v -> v-  vDrop :: Count -> v -> v-  vTake :: Count -> v -> v-  vIndex :: v -> Position -> Elem v-  vSlice :: Position -> Position -> v -> v---instance VectorLike String where-  type Elem String = Char--  vToList = id-  {-# INLINABLE vToList #-}--  vFromList = id-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v !! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = concat-  {-# INLINABLE vConcat #-}--  vEmpty = ""-  {-# INLINABLE vEmpty #-}--  vFilter = filter-  {-# INLINABLE vFilter #-}--  vGenerate n f = f `fmap` [0 .. (n - 1)]-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . length-  {-# INLINABLE vLength #-}--  vSnoc v c = v ++ [c]-  {-# INLINABLE vSnoc #-}--  vDrop = drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = v !! fromIntegral i-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = take (fromIntegral j) . drop (fromIntegral i)-  {-# INLINABLE vSlice #-}--instance VectorLike BS.ByteString where-  type Elem BS.ByteString = Word8--  vToList = BS.unpack-  {-# INLINABLE vToList #-}--  vFromList = BS.pack-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v `BS.index` fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = BS.concat-  {-# INLINABLE vConcat #-}--  vEmpty = BS.empty-  {-# INLINABLE vEmpty #-}--  vFilter = BS.filter-  {-# INLINABLE vFilter #-}--  vGenerate n f = fst (BS.unfoldrN n go 0)-    where go i = if i /= n then Just (f i, i + 1) else Nothing-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . BS.length-  {-# INLINABLE vLength #-}--  vSnoc = BS.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = BS.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = BS.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = BS.index v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = BS.take (fromIntegral j) . BS.drop (fromIntegral i)-  {-# INLINABLE vSlice #-}--instance VectorLike (DV.Vector Word8) where-  type Elem (DV.Vector Word8) = Word8--  vToList = DV.toList-  {-# INLINABLE vToList #-}--  vFromList = DV.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DV.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DV.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DV.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DV.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DV.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DV.length-  {-# INLINABLE vLength #-}--  vSnoc = DV.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DV.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DV.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}---instance VectorLike (DV.Vector Word16) where-  type Elem (DV.Vector Word16) = Word16--  vToList = DV.toList-  {-# INLINABLE vToList #-}--  vFromList = DV.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DV.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DV.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DV.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DV.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DV.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DV.length-  {-# INLINABLE vLength #-}--  vSnoc = DV.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DV.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DV.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DV.Vector Word32) where-  type Elem (DV.Vector Word32) = Word32--  vToList = DV.toList-  {-# INLINABLE vToList #-}--  vFromList = DV.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DV.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DV.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DV.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DV.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DV.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DV.length-  {-# INLINABLE vLength #-}--  vSnoc = DV.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DV.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DV.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DV.Vector Word64) where-  type Elem (DV.Vector Word64) = Word64--  vToList = DV.toList-  {-# INLINABLE vToList #-}--  vFromList = DV.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DV.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DV.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DV.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DV.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DV.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DV.length-  {-# INLINABLE vLength #-}--  vSnoc = DV.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DV.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DV.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DVS.Vector Word8) where-  type Elem (DVS.Vector Word8) = Word8--  vToList = DVS.toList-  {-# INLINABLE vToList #-}--  vFromList = DVS.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DVS.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DVS.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DVS.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DVS.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DVS.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DVS.length-  {-# INLINABLE vLength #-}--  vSnoc = DVS.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DVS.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DVS.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DVS.Vector Word16) where-  type Elem (DVS.Vector Word16) = Word16--  vToList = DVS.toList-  {-# INLINABLE vToList #-}--  vFromList = DVS.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DVS.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DVS.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DVS.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DVS.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DVS.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DVS.length-  {-# INLINABLE vLength #-}--  vSnoc = DVS.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DVS.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DVS.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DVS.Vector Word32) where-  type Elem (DVS.Vector Word32) = Word32--  vToList = DVS.toList-  {-# INLINABLE vToList #-}--  vFromList = DVS.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DVS.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DVS.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DVS.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DVS.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DVS.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DVS.length-  {-# INLINABLE vLength #-}--  vSnoc = DVS.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DVS.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DVS.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}--instance VectorLike (DVS.Vector Word64) where-  type Elem (DVS.Vector Word64) = Word64--  vToList = DVS.toList-  {-# INLINABLE vToList #-}--  vFromList = DVS.fromList-  {-# INLINABLE vFromList #-}--  (!!!) v (Position i) = v DVS.! fromIntegral i-  {-# INLINABLE (!!!) #-}--  vConcat = DVS.concat-  {-# INLINABLE vConcat #-}--  vEmpty = DVS.empty-  {-# INLINABLE vEmpty #-}--  vFilter = DVS.filter-  {-# INLINABLE vFilter #-}--  vGenerate = DVS.generate-  {-# INLINABLE vGenerate #-}--  vLength = Count . fromIntegral . DVS.length-  {-# INLINABLE vLength #-}--  vSnoc = DVS.snoc-  {-# INLINABLE vSnoc #-}--  vDrop = DVS.drop . fromIntegral-  {-# INLINABLE vDrop #-}--  vTake = DVS.take . fromIntegral-  {-# INLINABLE vTake #-}--  vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)-  {-# INLINABLE vIndex #-}--  vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)-  {-# INLINABLE vSlice #-}

@@ -1,40 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}--module HaskellWorks.Data.Word where--import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitWise--class WordConcat a where-  type DoubleWords a-  leConcat :: a -> a -> DoubleWords a--class WordSplit a where-  type HalfWords a-  leSplit :: a -> (HalfWords a, HalfWords a)--instance WordConcat Word8 where-  type DoubleWords Word8 = Word16-  leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance WordConcat Word16 where-  type DoubleWords Word16 = Word32-  leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance WordConcat Word32 where-  type DoubleWords Word32 = Word64-  leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a--instance WordSplit Word64 where-  type HalfWords Word64 = Word32-  leSplit a = (fromIntegral a, fromIntegral (a .>. 32))--instance WordSplit Word32 where-  type HalfWords Word32 = Word16-  leSplit a = (fromIntegral a, fromIntegral (a .>. 16))--instance WordSplit Word16 where-  type HalfWords Word16 = Word8-  leSplit a = (fromIntegral a, fromIntegral (a .>. 8))

@@ -1,6 +0,0 @@-module HaskellWorks.Function-  ( applyN-  ) where--applyN :: (a -> a) -> Int -> a -> a-applyN f n = foldl (.) id (replicate (fromIntegral n) f)

@@ -1,157 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Bits.FromBoolsSpec (spec) where--import           Data.Word-import           HaskellWorks.Data.Bits.FromBools-import           Test.Hspec--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Bits.FromBoolsSpec" $ do-  describe "for Word8" $ do-    it "fromBool works for 0 bits" $ do-      let result = fromBools [] :: Maybe (Word8, [Bool])-      result `shouldBe` Nothing-    it "fromBool works for 4 bits" $ do-      let result = fromBools  [ True, False, True, False] :: Maybe (Word8, [Bool])-      result `shouldBe` Just (0x5, [])-    it "fromBool works for 8 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              ] :: Maybe (Word8, [Bool])-      result `shouldBe` Just (0x55, [])-    it "fromBool works for 12 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word8, [Bool])-      result `shouldBe` Just (0x55, [True, False, True, False])-  describe "for Word16" $ do-    it "fromBool works for 0 bits" $ do-      let result = fromBools [] :: Maybe (Word16, [Bool])-      result `shouldBe` Nothing-    it "fromBool works for 4 bits" $ do-      let result = fromBools  [ True, False, True, False-                              ] :: Maybe (Word16, [Bool])-      result `shouldBe` Just (0x5, [])-    it "fromBool works for 8 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              ] :: Maybe (Word16, [Bool])-      result `shouldBe` Just (0x55, [])-    it "fromBool works for 12 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word16, [Bool])-      result `shouldBe` Just (0x555, [])-    it "fromBool works for 16 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              ] :: Maybe (Word16, [Bool])-      result `shouldBe` Just (0x5555, [])-    it "fromBool works for 20 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word16, [Bool])-      result `shouldBe` Just (0x5555, [True, False, True, False])-  describe "for Word32" $ do-    it "fromBool works for 0 bits" $ do-      let result = fromBools [] :: Maybe (Word32, [Bool])-      result `shouldBe` Nothing-    it "fromBool works for 4 bits" $ do-      let result = fromBools  [ True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x5, [])-    it "fromBool works for 8 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x55, [])-    it "fromBool works for 12 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x555, [])-    it "fromBool works for 20 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x55555, [])-    it "fromBool works for 32 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x55555555, [])-    it "fromBool works for 36 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word32, [Bool])-      result `shouldBe` Just (0x55555555, [True, False, True, False])-  describe "for Word64" $ do-    it "fromBool works for 0 bits" $ do-      let result = fromBools [] :: Maybe (Word64, [Bool])-      result `shouldBe` Nothing-    it "fromBool works for 4 bits" $ do-      let result = fromBools  [ True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x5, [])-    it "fromBool works for 8 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x55, [])-    it "fromBool works for 12 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x555, [])-    it "fromBool works for 20 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x55555, [])-    it "fromBool works for 32 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x55555555, [])-    it "fromBool works for 36 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x555555555, [])-    it "fromBool works for 64 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x5555555555555555, [])-    it "fromBool works for 68 bits" $ do-      let result = fromBools  [ True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False, True, False, True, False-                              , True, False, True, False-                              ] :: Maybe (Word64, [Bool])-      result `shouldBe` Just (0x5555555555555555, [True, False, True, False])

@@ -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"]

@@ -1,108 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Conduit.JsonSpec (spec) where--import           Data.ByteString                                      as BS-import           Data.Conduit-import           Data.Int-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.Conversion-import           HaskellWorks.Data.Conduit.Json-import           HaskellWorks.Data.Conduit.List-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Offset-import           HaskellWorks.Data.Json.Token-import           Test.Hspec--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}--markerToBits :: [Int64] -> [Bool]-markerToBits = runListConduit (markerToByteString =$= byteStringToBits)--jsonToBits :: [ByteString] -> [Bool]-jsonToBits = runListConduit (textToJsonToken =$= jsonToken2Markers =$= markerToByteString =$= byteStringToBits)--jsonToken2Markers2 :: [(ParseDelta Offset, JsonToken)] -> [Int64]-jsonToken2Markers2 = runListConduit jsonToken2Markers--blankedJsonToInterestBits2 :: ByteString -> BitShown ByteString-blankedJsonToInterestBits2 bs = BitShown (BS.concat (runListConduit blankedJsonToInterestBits [bs]))--spec :: Spec-spec = describe "Data.Conduit.Succinct.JsonSpec" $ do-  it "No markers should produce no bits" $-    markerToBits [] `shouldBe` []-  it "One marker < 8 should produce one byte with one bit set" $ do-    markerToBits [0] `shouldBe` stringToBits "10000000"-    markerToBits [1] `shouldBe` stringToBits "01000000"-    markerToBits [2] `shouldBe` stringToBits "00100000"-    markerToBits [3] `shouldBe` stringToBits "00010000"-    markerToBits [4] `shouldBe` stringToBits "00001000"-    markerToBits [5] `shouldBe` stringToBits "00000100"-    markerToBits [6] `shouldBe` stringToBits "00000010"-    markerToBits [7] `shouldBe` stringToBits "00000001"-  it "One 8 <= marker < 16 should produce one byte empty byte and another byte with one bit set" $ do-    markerToBits [ 8] `shouldBe` stringToBits "00000000 10000000"-    markerToBits [ 9] `shouldBe` stringToBits "00000000 01000000"-    markerToBits [10] `shouldBe` stringToBits "00000000 00100000"-    markerToBits [11] `shouldBe` stringToBits "00000000 00010000"-    markerToBits [12] `shouldBe` stringToBits "00000000 00001000"-    markerToBits [13] `shouldBe` stringToBits "00000000 00000100"-    markerToBits [14] `shouldBe` stringToBits "00000000 00000010"-    markerToBits [15] `shouldBe` stringToBits "00000000 00000001"-  it "All markers 0 .. 7 should produce one full byte" $-    markerToBits [0, 1, 2, 3, 4, 5, 6, 7] `shouldBe` stringToBits "11111111"-  it "All markers 0 .. 7 except 1 should produce one almost full byte" $ do-    markerToBits [1, 2, 3, 4, 5, 6, 7] `shouldBe` stringToBits "01111111"-    markerToBits [0, 2, 3, 4, 5, 6, 7] `shouldBe` stringToBits "10111111"-    markerToBits [0, 1, 3, 4, 5, 6, 7] `shouldBe` stringToBits "11011111"-    markerToBits [0, 1, 2, 4, 5, 6, 7] `shouldBe` stringToBits "11101111"-    markerToBits [0, 1, 2, 3, 5, 6, 7] `shouldBe` stringToBits "11110111"-    markerToBits [0, 1, 2, 3, 4, 6, 7] `shouldBe` stringToBits "11111011"-    markerToBits [0, 1, 2, 3, 4, 5, 7] `shouldBe` stringToBits "11111101"-    markerToBits [0, 1, 2, 3, 4, 5, 6] `shouldBe` stringToBits "11111110"-  it "All markers 0 .. 8 should produce one almost full byte and one near empty byte" $-    markerToBits [0, 1, 2, 3, 4, 5, 6, 7, 8] `shouldBe` stringToBits "11111111 10000000"-  it "Matching bits for bytes" $-    runListConduit byteStringToBits [pack [0x80], pack [0xff], pack [0x01]] `shouldBe`-      stringToBits "00000001 11111111 10000000"-  it "Every interesting token should produce a marker" $-    jsonToken2Markers2 [-      (ParseDelta (Offset 0) (Offset 1), JsonTokenBraceL),-      (ParseDelta (Offset 1) (Offset 2), JsonTokenBraceL),-      (ParseDelta (Offset 2) (Offset 3), JsonTokenBraceR),-      (ParseDelta (Offset 3) (Offset 4), JsonTokenBraceR)] `shouldBe` [0, 1]-  describe "When converting Json to tokens to markers to bits" $ do-    it "Empty Json should produce no bits" $-      jsonToBits [""] `shouldBe` []-    it "Spaces and newlines should produce no bits" $-      jsonToBits ["  \n \r \t "] `shouldBe` []-    it "number at beginning should produce one bit" $-      jsonToBits ["1234 "] `shouldBe` stringToBits "10000000"-    it "false at beginning should produce one bit" $-      jsonToBits ["false "] `shouldBe` stringToBits "10000000"-    it "true at beginning should produce one bit" $-      jsonToBits ["true "] `shouldBe` stringToBits "10000000"-    it "string at beginning should produce one bit" $-      jsonToBits ["\"hello\" "] `shouldBe` stringToBits "10000000"-    it "string at beginning should produce one bit" $-      jsonToBits ["\"\\\"\" "] `shouldBe` stringToBits "10000000"-    it "left brace at beginning should produce one bit" $-      jsonToBits ["{ "] `shouldBe` stringToBits "10000000"-    it "right brace at beginning should produce one bit" $-      jsonToBits ["} "] `shouldBe` stringToBits ""-    it "left bracket at beginning should produce one bit" $-      jsonToBits ["[ "] `shouldBe` stringToBits "10000000"-    it "right bracket at beginning should produce one bit" $-      jsonToBits ["] "] `shouldBe` stringToBits ""-    it "right bracket at beginning should produce one bit" $-      jsonToBits [": "] `shouldBe` stringToBits ""-    it "right bracket at beginning should produce one bit" $-      jsonToBits [", "] `shouldBe` stringToBits ""-    it "Four consecutive braces should produce four bits" $-      jsonToBits ["{{}}"] `shouldBe` stringToBits "11000000"-    it "Four spread out braces should produce four spread out bits" $-      jsonToBits [" { { } } "] `shouldBe` stringToBits "01010000"-  describe "Can convert blanked json to Json interest bits" $ do-    it "where blanked json is \" { (  ): 100, [(), t___], n___}\"" $ do-      blankedJsonToInterestBits2 " { (  ): 100, [(), t___], n___}" `shouldBe` "01010000 01000011 00010000 00100000"

@@ -1,171 +0,0 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections     #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}--module HaskellWorks.Data.Conduit.Tokenize.Attoparsec.LineColumnSpec (spec) where--import           Control.Applicative                                      ((<|>))-import           Control.Exception                                        (fromException)-import           Control.Monad-import           Control.Monad.Trans.Resource                             (runExceptionT)-import qualified Data.Attoparsec.ByteString.Char8-import qualified Data.Attoparsec.Text-import           Data.Conduit-import qualified Data.Conduit.List                                        as CL-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.LineColumn-import           Test.Hspec--spec :: Spec-spec = describe "Data.Conduit.Tokenize.Attoparsec.LineColumnSpec" $ do-    describe "error position" $ do-        it "works for text" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badLine = 4-                badCol = 6-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works for bytestring" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badLine = 4-                badCol = 6-                parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works in last chunk" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badLine = 6-                badCol = 5-                parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works in last chunk" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"]-                badLine = 6-                badCol = 6-                parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works after new line in text" $ do-            let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]-                badLine = 5-                badCol = 1-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works after new line in bytestring" $ do-            let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]-                badLine = 5-                badCol = 1-                parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol-        it "works for first line" $ do-            let input = ["aab\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badLine = 1-                badCol = 3-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Position 1 1) parser-                sink' = sinkParserEither (Position 1 1) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Position badLine badCol-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Position badLine badCol--    describe "conduitParser" $ do-        it "parses a repeated stream" $ do-            let input = ["aaa\n", "aaa\naaa\n", "aaa\n"]-                parser = Data.Attoparsec.Text.string "aaa" <* Data.Attoparsec.Text.endOfLine-                sink = conduitParserEither (Position 1 1) parser =$= CL.consume-            (Right ea) <- runExceptionT $ CL.sourceList input $$ sink-            let chk a = case a of-                          Left{} -> False-                          Right (_, xs) -> xs == "aaa"-                chkp l = (ParseDelta (Position l 1) (Position (l+1) 1))-            forM_ ea $ \ a -> a `shouldSatisfy` chk :: Expectation-            forM_ (zip ea [1..]) $ \ (Right (pos, _), l) -> pos `shouldBe` chkp l-            length ea `shouldBe` 4--        it "positions on first line" $ do-            results <- yield "hihihi\nhihi"-                $$ conduitParser (Position 1 1) (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi")-                =$ CL.consume-            let f (a, b, c, d, e) = (ParseDelta (Position a b) (Position c d), e)-            results `shouldBe` map f-                [ (1, 1, 1, 3, "hi")-                , (1, 3, 1, 5, "hi")-                , (1, 5, 1, 7, "hi")--                , (1, 7, 2, 1, "\n")--                , (2, 1, 2, 3, "hi")-                , (2, 3, 2, 5, "hi")-                ]

@@ -1,164 +0,0 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections     #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}--module HaskellWorks.Data.Conduit.Tokenize.Attoparsec.OffsetSpec (spec) where--import           Control.Applicative                                  ((<|>))-import           Control.Exception                                    (fromException)-import           Control.Monad-import           Control.Monad.Trans.Resource                         (runExceptionT)-import qualified Data.Attoparsec.ByteString.Char8-import qualified Data.Attoparsec.Text-import           Data.Conduit-import qualified Data.Conduit.List                                    as CL-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec-import           HaskellWorks.Data.Conduit.Tokenize.Attoparsec.Offset-import           Test.Hspec--spec :: Spec-spec = describe "Data.Conduit.Tokenize.Attoparsec.OffsetSpec" $ do-    describe "error position" $ do-        it "works for text" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badOffset = 15-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works for bytestring" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badOffset = 15-                parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works in last chunk" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badOffset = 22-                parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works in last chunk" $ do-            let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"]-                badOffset = 22-                parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works after new line in text" $ do-            let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]-                badOffset = 15-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works after new line in bytestring" $ do-            let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]-                badOffset = 15-                parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset-        it "works for first line" $ do-            let input = ["aab\na", "aaa\n\n", "aaa", "aab\n\naaaa"]-                badOffset = 2-                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)-                sink = sinkParser (Offset 0) parser-                sink' = sinkParserEither (Offset 0) parser-            ea <- runExceptionT $ CL.sourceList input $$ sink-            case ea of-                Left e ->-                    case fromException e of-                        Just pe -> do-                            errorPosition pe `shouldBe` Offset badOffset-            ea' <- CL.sourceList input $$ sink'-            case ea' of-                Left pe ->-                    errorPosition pe `shouldBe` Offset badOffset--    describe "conduitParser" $ do-        it "parses a repeated stream" $ do-            let input = ["aaa\n", "aaa\naaa\n", "aaa\n"]-                parser = Data.Attoparsec.Text.string "aaa" <* Data.Attoparsec.Text.endOfLine-                sink = conduitParserEither (Offset 0) parser =$= CL.consume-            (Right ea) <- runExceptionT $ CL.sourceList input $$ sink-            let chk a = case a of-                          Left{} -> False-                          Right (_, xs) -> xs == "aaa"-                chkp l = (ParseDelta (Offset l) (Offset (l + 4)))-            forM_ ea $ \ a -> a `shouldSatisfy` chk :: Expectation-            forM_ (zip ea [0,4..]) $ \ (Right (pos2, _), l) -> pos2 `shouldBe` chkp l-            length ea `shouldBe` 4--        it "positions on first line" $ do-            results <- yield "hihihi\nhihi"-                $$ conduitParser (Offset 0) (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi")-                =$ CL.consume-            let f (b, d, e) = (ParseDelta (Offset b) (Offset d), e)-            results `shouldBe` map f-                [ (0,  2, "hi")-                , (2,  4, "hi")-                , (4,  6, "hi")--                , (6,  7, "\n")--                , (7,  9, "hi")-                , (9, 11, "hi")-                ]

@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+++module HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec(spec) where++import qualified Data.ByteString                                     as BS+import           Data.String+import qualified Data.Vector.Storable                                as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.FromByteString+import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import           HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++interestBitsOf :: FromBlankedJson (JsonInterestBits a) => BS.ByteString -> a+interestBitsOf = getJsonInterestBits . fromBlankedJson . fromByteString++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec" $ do+  it "Evaluating interest bits" $ do+    (interestBitsOf ""            :: BitShown (DVS.Vector Word8)) `shouldBe` fromString ""+    (interestBitsOf "  \n \r \t " :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"+    (interestBitsOf "1234 "       :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "false "      :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "true "       :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "\"hello\" "  :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "\"\\\"\" "   :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "{ "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "} "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"+    (interestBitsOf "[ "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "10000000"+    (interestBitsOf "] "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"+    (interestBitsOf ": "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"+    (interestBitsOf ", "          :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "00000000"+    (interestBitsOf "{{}}"        :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "11000000"+    (interestBitsOf " { { } } "   :: BitShown (DVS.Vector Word8)) `shouldBe` fromString "01010000 00000000"

@@ -1,34 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Json.SuccinctSpec where--import           Data.Maybe-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Conduit.Json-import           HaskellWorks.Data.Conduit.List-import           HaskellWorks.Data.Json.Succinct-import           Test.Hspec--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Json.SuccinctSpec" $ do-  describe "When running markerToByteString" $ do-    it "Marker at zero gives \"\1\"" $-      runListConduit markerToByteString [0] `shouldBe` ["\1"]-    it "Marker at [0, 1, 2, 3, 4, 5, 6, 7] gives \"\\255\"" $-      runListConduit markerToByteString [0, 1, 2, 3, 4, 5, 6, 7] `shouldBe` ["\255"]-    it "Marker at [0, 9, 18, 27, 36] gives \"\\255\"" $-      runListConduit markerToByteString [0, 9, 18, 27, 36] `shouldBe` ["\1", "\2", "\4", "\8", "\16"]-    it "Marker at [0, 9, 27, 36] gives \"\\255\"" $-      runListConduit markerToByteString [0, 9, 27, 36] `shouldBe` ["\1", "\2", "\0", "\8", "\16"]-    it "Marker at [0, 36] gives \"\\255\"" $-      runListConduit markerToByteString [0, 36] `shouldBe` ["\1", "\0", "\0", "\0", "\16"]-  describe "jsonToInterestBalancedParens" $ do-    it "produces the correct interest bits for {\"field\": 1}" $-      jsonToInterestBalancedParens ["{\"field\": 1}"] `shouldBe` fromJust (bitRead "110100")-  describe "jsonToInterestBits" $ do-    it "produces the correct interest bits for {\"field\": 1}" $-      jsonToInterestBits ["{\"field\": 1}"] `shouldBe` fromJust (bitRead "1100000000100000")