packages feed

hw-succinct (empty) → 0.0.0.1

raw patch · 95 files changed

+6757/−0 lines, 95 filesdep +QuickCheckdep +arraydep +attoparsecsetup-changed

Dependencies added: QuickCheck, array, attoparsec, base, bytestring, conduit, criterion, deepseq, ghc-prim, hspec, hw-succinct, lens, mmap, mono-traversable, parsec, random, resourcet, safe, text, transformers, vector, word8

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,101 @@+# hw-succinct+[![Circle CI](https://circleci.com/gh/haskell-works/hw-succinct.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-succinct)+Conduits for tokenizing streams.++`hw-succinct` is a succinct JSON parsing library.  It uses succinct data-structures to allow traversal of+large JSON strings with minimal memory overhead.++It is currently considered experimental.++For an example, see [`app/Main.hs`](../master/app/Main.hs)++## Prerequisites+* Install `haskell-stack`.+* Install `hlint` (eg. `stack install hlint`)++## Building++Run the following in the shell:++    git clone git@github.com:haskell-works/hw-succinct.git+    cd hw-succinct+    stack setup+    stack build+    stack test+    stack ghci --ghc-options -XOverloadedStrings \+      --main-is hw-succinct:exe:hw-succinct-example++## Memory benchmark++### Parsing large Json files in Scala with Argonaut++          S0U       EU           OU       MU     CCSU CMD+    --------- --------- ----------- -------- -------- ---------------------------------------------------------------+          0.0  80,526.3    76,163.6 72,338.6 13,058.6 sbt console+          0.0 536,660.4    76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._+          0.0 552,389.1    76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json"+          0.0 634,066.5    76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int])+          0.0 644,552.3    76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json")+          0.0 655,038.1    76,163.6 72,338.6 13,058.6 is.read(array)+    294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array)+    285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json)+                        ***********++### Parsing large Json files in Haskell with Aeson++    Mem (MB) CMD+    -------- ---------------------------------------------------------+         302 import Data.Aeson+         302 import qualified  Data.ByteString.Lazy as BSL+         302 json78m <- BSL.readFile "/Users/jky/Downloads/78mbs.json"+        1400 let !x = decode json78m :: Maybe Value++### Parsing large Json files in Haskell with hw-succinct++    Mem (MB) CMD+    -------- ---------------------------------------------------------+         274 import Foreign+         274 import qualified Data.Vector.Storable as DVS+         274 import qualified Data.ByteString as BS+         274 import System.IO.MMap+         274 import Data.Word+         274 (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing+         601 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))++## Examples++    import Foreign+    import qualified Data.Vector.Storable as DVS+    import qualified Data.ByteString as BS+    import qualified Data.ByteString.Internal as BSI+    import System.IO.MMap+    import Data.Word+    import System.CPUTime+    (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing+    cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+    let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+    x <- measure $ jsonBsToInterestBs bs+    let !y = runListConduit [bs] (unescape' "")++    import Foreign+    import qualified Data.Vector.Storable as DVS+    import qualified Data.ByteString as BS+    import qualified Data.ByteString.Internal as BSI+    import System.IO.MMap+    import Data.Word+    import System.CPUTime+    (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/part40.json" ReadOnly Nothing+    let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+    x <- measure $ BS.concat $ runListConduit [bs] (blankJson =$= blankedJsonToInterestBits)+    x <- measure $ jsonBsToInterestBs bs+    +    jsonTokenAt $ J.nextSibling $ J.firstChild $ J.nextSibling $ J.firstChild $ J.firstChild  cursor++## References+* [Original Pull Request](https://github.com/snoyberg/conduit/pull/244)+* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf)+* [Conduit Overview](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/conduit-overview)+++## Special mentions+* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = print "Hello world"
+ bench/Main.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Control.Monad.Trans.Resource                        (MonadThrow)+import           Criterion.Main+import qualified Data.ByteString                                     as BS+import qualified Data.ByteString.Internal                            as BSI+import           Data.Conduit                                        (Conduit,+                                                                      (=$=))+import qualified Data.Vector.Storable                                as DVS+import           Data.Word+import           Foreign+import           HaskellWorks.Data.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.Json+import           HaskellWorks.Data.Conduit.Json.Blank+import           HaskellWorks.Data.Conduit.List+import           HaskellWorks.Data.FromByteString+import           HaskellWorks.Data.Json.Succinct.Cursor+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.BalancedParens.Simple+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+import           System.IO.MMap++v :: DVS.Vector Word64+v = DVS.fromList (take 1000000 (cycle [maxBound, 0]))++setupEnv :: IO (DVS.Vector Word64)+setupEnv = return v++setupEnvJson :: FilePath -> IO BS.ByteString+setupEnvJson filepath = do+  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing+  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+  return bs++loadJson :: BS.ByteString -> JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+loadJson bs = fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))++runCon :: Conduit i [] BS.ByteString -> i -> BS.ByteString+runCon con bs = BS.concat $ runListConduit con [bs]++jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString+jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits++jsonToInterestBitsOld :: MonadThrow m => Conduit BS.ByteString m BS.ByteString+jsonToInterestBitsOld = textToJsonToken =$= jsonToken2Markers =$= markerToByteString++runBlankedJsonToInterestBits :: BS.ByteString -> BS.ByteString+runBlankedJsonToInterestBits bs = BS.concat $ runListConduit blankedJsonToInterestBits [bs]++benchRankSelect :: [Benchmark]+benchRankSelect =+  [ env setupEnv $ \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])+    ]+  ]++benchRankJson40Conduits :: [Benchmark]+benchRankJson40Conduits =+  [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "Json40"+    [ bench "Run blankJson                    "  (whnf (runCon blankJson                  ) bs)+    , bench "Run jsonToInterestBits3          "  (whnf (runCon jsonToInterestBits3        ) bs)+    , bench "Run jsonToInterestBitsOld        "  (whnf (runCon jsonToInterestBitsOld      ) bs)+    , bench "loadJson                         "  (whnf  loadJson                            bs)+    ]+  ]++benchRankJson80Conduits :: [Benchmark]+benchRankJson80Conduits =+  [ env (setupEnvJson "/Users/jky/Downloads/part80.json") $ \bs -> bgroup "Json40"+    [ bench "loadJson" (whnf loadJson bs)+    ]+  ]++benchRankJsonBigConduits :: [Benchmark]+benchRankJsonBigConduits =+  [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"+    [ bench "loadJson" (whnf loadJson bs)+    ]+  ]++main :: IO ()+main = defaultMain benchRankJson40Conduits
+ hw-succinct.cabal view
@@ -0,0 +1,177 @@+name:                   hw-succinct+version:                0.0.0.1+synopsis:               Conduits for tokenizing streams.+description:            Please see README.md+homepage:               http://github.com/haskell-works/hw-succinct#readme+license:                BSD3+license-file:           LICENSE+author:                 John Ky+maintainer:             newhoggy@gmail.com+copyright:              2016 John Ky+category:               Data, Conduit+build-type:             Simple+extra-source-files:     README.md+cabal-version:          >= 1.10++executable hw-succinct-example+  hs-source-dirs:       app+  main-is:              Main.hs+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N+  build-depends:        base+                      , attoparsec                      >= 0.10+                      , conduit                         >= 1.1  && < 1.3+                      , hw-succinct+                      , resourcet                       >= 1.1+  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.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+                      , HaskellWorks.Data.Json.Succinct.Cursor+                      , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens+                      , HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+                      , 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+                      , HaskellWorks.Data.Succinct.BalancedParens.Simple+                      , HaskellWorks.Data.Succinct.NearestNeighbour+                      , HaskellWorks.Data.Succinct.RankSelect+                      , HaskellWorks.Data.Succinct.RankSelect.Binary+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+                      , HaskellWorks.Data.Succinct.RankSelect.Internal+                      , HaskellWorks.Data.Time+                      , HaskellWorks.Data.Vector.BoxedVectorLike+                      , HaskellWorks.Data.Vector.Storable.ByteString+                      , HaskellWorks.Data.Vector.StorableVectorLike+                      , HaskellWorks.Data.Vector.VectorLike+                      , HaskellWorks.Function+                      , HaskellWorks.Data.Word+  build-depends:        base                            >= 4.7  && < 5+                      , array+                      , attoparsec                      >= 0.10+                      , bytestring+                      , conduit                         >= 1.1  && < 1.3+                      , deepseq                         <  1.5+                      , ghc-prim+                      , lens+                      , mmap+                      , mono-traversable+                      , parsec+                      , QuickCheck+                      , random+                      , resourcet                       >= 1.1+                      , safe+                      , text+                      , vector+                      , word8++  default-language:     Haskell2010+  ghc-options:          -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2++test-suite hw-succinct-test+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       test+  main-is:              Spec.hs+  other-modules:        HaskellWorks.Data.Bits.BitReadSpec+                      , HaskellWorks.Data.Bits.BitWiseSpec+                      , HaskellWorks.Data.Bits.FromBoolsSpec+                      , 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.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.SimpleSpec+  build-depends:        base+                      , attoparsec                      >= 0.10+                      , bytestring+                      , conduit                         >= 1.1  && < 1.3+                      , hspec                           >= 1.3+                      , hw-succinct+                      , mmap+                      , parsec+                      , QuickCheck+                      , resourcet                       >= 1.1+                      , transformers+                      , vector+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:     Haskell2010++source-repository head+  type:     git+  location: https://github.com/haskell-works/hw-succinct++benchmark bench+    Type: exitcode-stdio-1.0+    HS-Source-Dirs: bench+    Main-Is: Main.hs+    GHC-Options: -O2 -Wall -msse4.2+    Default-Language: Haskell2010+    Build-Depends:+        base            >= 4       && < 5   ,+        bytestring                          ,+        conduit                             ,+        criterion       >= 1.1.0.0 && < 1.2 ,+        hw-succinct                         ,+        mmap                                ,+        resourcet                           ,+        vector          >= 0.6     && < 0.12+
+ src/HaskellWorks/Data/Attoparsec/Final/IsChar.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Attoparsec.Final.IsChar+    ( module X+    ) where++import           HaskellWorks.Data.Attoparsec.Final.IsChar.Char     as X ()+import           HaskellWorks.Data.Attoparsec.Final.IsChar.Internal as X
+ src/HaskellWorks/Data/Attoparsec/Final/IsChar/Char.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.Attoparsec.Final.IsChar.Char+    ( IsChar(..)+    ) where++import HaskellWorks.Data.Attoparsec.Final.IsChar.Internal++instance IsChar Char where+  toChar = id
+ src/HaskellWorks/Data/Attoparsec/Final/IsChar/Internal.hs view
@@ -0,0 +1,12 @@+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
+ src/HaskellWorks/Data/Attoparsec/Final/Parser.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Attoparsec.Final.Parser+    ( Parser(..)+    ) where++import HaskellWorks.Data.Attoparsec.Final.Parser.Internal
+ src/HaskellWorks/Data/Attoparsec/Final/Parser/ByteString.hs view
@@ -0,0 +1,17 @@+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
+ src/HaskellWorks/Data/Attoparsec/Final/Parser/Internal.hs view
@@ -0,0 +1,16 @@+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
+ src/HaskellWorks/Data/Attoparsec/Final/Parser/Text.hs view
@@ -0,0 +1,16 @@+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
+ src/HaskellWorks/Data/Bits.hs view
@@ -0,0 +1,16 @@+-- |+-- 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
+ src/HaskellWorks/Data/Bits/BitLength.hs view
@@ -0,0 +1,112 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Bits/BitParse.hs view
@@ -0,0 +1,127 @@+{-# 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
+ src/HaskellWorks/Data/Bits/BitRead.hs view
@@ -0,0 +1,78 @@+{-# 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 (/= ' ')
+ src/HaskellWorks/Data/Bits/BitShow.hs view
@@ -0,0 +1,104 @@+{-# 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 ""
+ src/HaskellWorks/Data/Bits/BitShown.hs view
@@ -0,0 +1,46 @@+{-# 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
+ src/HaskellWorks/Data/Bits/BitWise.hs view
@@ -0,0 +1,213 @@+{-# 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 (.>.) #-}
+ src/HaskellWorks/Data/Bits/BitWise/String.hs view
@@ -0,0 +1,126 @@+{-# 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"
+ src/HaskellWorks/Data/Bits/Conversion.hs view
@@ -0,0 +1,127 @@+{-# 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"
+ src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs view
@@ -0,0 +1,82 @@+{-# 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+
+ src/HaskellWorks/Data/Bits/FixedBitSize.hs view
@@ -0,0 +1,30 @@+-- |+-- 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
+ src/HaskellWorks/Data/Bits/FromBools.hs view
@@ -0,0 +1,51 @@+-- |+-- 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)
+ src/HaskellWorks/Data/Bits/PopCount.hs view
@@ -0,0 +1,19 @@+{-# 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
+ src/HaskellWorks/Data/Bits/PopCount/PopCount0.hs view
@@ -0,0 +1,96 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1.hs view
@@ -0,0 +1,11 @@++-- |+-- 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
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1/Broadword.hs view
@@ -0,0 +1,111 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1/GHC.hs view
@@ -0,0 +1,95 @@+{-# 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 #-}
+ src/HaskellWorks/Data/ByteString.hs view
@@ -0,0 +1,11 @@+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
+ src/HaskellWorks/Data/Conduit/Json.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module HaskellWorks.Data.Conduit.Json+  ( blankedJsonToInterestBits+  , byteStringToBits+  , markerToByteString+  , blankedJsonToBalancedParens+  , jsonToken2Markers+  , textToJsonToken+  , 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.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++interestingWord8s :: A.UArray Word8 Word8+interestingWord8s = A.array (0, 255) [+  (w, if w == wOpenBracket || w == wOpenBrace || w == wOpenParen || w == wt || w == wf || w == wn || w == w1+    then 1+    else 0)+  | w <- [0 .. 255]]++blankedJsonToInterestBits :: Monad m => Conduit BS.ByteString m BS.ByteString+blankedJsonToInterestBits = blankedJsonToInterestBits' ""++padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString+padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs)+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen cs = case BS.uncons cs of+          Just (c, ds) -> Just (c, ds)+          Nothing      -> Just (w, BS.empty)++blankedJsonToInterestBits' :: Monad m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString+blankedJsonToInterestBits' rs = do+  mbs <- await+  case mbs of+    Just bs -> do+      let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs+      let lencs = BS.length cs+      let q = lencs + 7 `quot` 8+      let (ds, es) = BS.splitAt (q * 8) cs+      let (fs, _) = BS.unfoldrN q gen ds+      yield fs+      blankedJsonToInterestBits' es+    Nothing -> return ()+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen as = if BS.length as == 0+          then Nothing+          else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 as))+                    , BS.drop 8 as+                    )++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+  case mbs of+    Just bs -> blankedJsonToBalancedParens' bs+    Nothing -> return ()++blankedJsonToBalancedParens' :: Monad m => BS.ByteString -> Conduit BS.ByteString m Bool+blankedJsonToBalancedParens' bs = case BS.uncons bs of+  Just (c, cs) -> do+    case c of+      d | d == wOpenBrace     -> yield True+      d | d == wCloseBrace    -> yield False+      d | d == wOpenBracket   -> yield True+      d | d == wCloseBracket  -> yield False+      d | d == wOpenParen     -> yield True+      d | d == wCloseParen    -> yield False+      d | d == wt             -> yield True >> yield False+      d | d == wf             -> yield True >> yield False+      d | d == w1             -> yield True >> yield False+      d | d == wn             -> yield True >> yield False+      _                       -> return ()+    blankedJsonToBalancedParens' cs+  Nothing -> return ()++------------------------++yieldBitsOfWord8 :: Monad m => Word8 -> Conduit BS.ByteString m Bool+yieldBitsOfWord8 w = do+  yield ((w .&. BITS.bit 0) /= 0)+  yield ((w .&. BITS.bit 1) /= 0)+  yield ((w .&. BITS.bit 2) /= 0)+  yield ((w .&. BITS.bit 3) /= 0)+  yield ((w .&. BITS.bit 4) /= 0)+  yield ((w .&. BITS.bit 5) /= 0)+  yield ((w .&. BITS.bit 6) /= 0)+  yield ((w .&. BITS.bit 7) /= 0)++yieldBitsofWord8s :: Monad m => [Word8] -> Conduit BS.ByteString m Bool+yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) (return ())++byteStringToBits :: Monad m => Conduit BS.ByteString m Bool+byteStringToBits = do+  mbs <- await+  case mbs of+    Just bs -> yieldBitsofWord8s (BS.unpack bs) >> byteStringToBits+    Nothing -> return ()
+ src/HaskellWorks/Data/Conduit/Json/Blank.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Conduit.Json.Blank+  ( blankJson+  ) where++import           Control.Monad+import           Control.Monad.Trans.Resource         (MonadThrow)+import           Data.ByteString                      as BS+import           Data.Conduit+import           Data.Word+import           HaskellWorks.Data.Conduit.Json.Words+import           Prelude                              as P++data BlankState+  = Escaped+  | InJson+  | InString+  | InNumber+  | InIdent++blankJson :: MonadThrow m => Conduit BS.ByteString m BS.ByteString+blankJson = blankJson' InJson++blankJson' :: MonadThrow m => BlankState -> Conduit BS.ByteString m BS.ByteString+blankJson' lastState = do+  mbs <- await+  case mbs of+    Just bs -> do+      let (!cs, Just (!nextState, _)) = unfoldrN (BS.length bs) blankByteString (lastState, bs)+      yield cs+      blankJson' nextState+    Nothing -> return ()+  where+    blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))+    blankByteString (InJson, bs) = case BS.uncons bs of+      Just (!c, !cs) | isLeadingDigit c   -> Just (w1         , (InNumber , cs))+      Just (!c, !cs) | c == wDoubleQuote  -> Just (wOpenParen , (InString , cs))+      Just (!c, !cs) | isAlphabetic c     -> Just (c          , (InIdent  , cs))+      Just (!c, !cs)                      -> Just (c          , (InJson   , cs))+      Nothing -> Nothing+    blankByteString (InString, bs) = case BS.uncons bs of+      Just (!c, !cs) | c == wBackslash    -> Just (wSpace     , (Escaped  , cs))+      Just (!c, !cs) | c == wDoubleQuote  -> Just (wCloseParen, (InJson   , cs))+      Just (_ , !cs)                      -> Just (wSpace     , (InString , cs))+      Nothing                             -> Nothing+    blankByteString (Escaped, bs) = case BS.uncons bs of+      Just (_, !cs)                       -> Just (wSpace, (InString, cs))+      Nothing                             -> Nothing+    blankByteString (InNumber, bs) = case BS.uncons bs of+      Just (!c, !cs) | isTrailingDigit c  -> Just (w0         , (InNumber , cs))+      Just (!c, !cs) | c == wDoubleQuote  -> Just (wOpenParen , (InString , cs))+      Just (!c, !cs) | isAlphabetic c     -> Just (c          , (InIdent  , cs))+      Just (!c, !cs)                      -> Just (c          , (InJson   , cs))+      Nothing                             -> Nothing+    blankByteString (InIdent, bs) = case BS.uncons bs of+      Just (!c, !cs) | isAlphabetic c     -> Just (wUnderscore, (InIdent  , cs))+      Just (!c, !cs) | isLeadingDigit c   -> Just (w1         , (InNumber , cs))+      Just (!c, !cs) | c == wDoubleQuote  -> Just (wOpenParen , (InString , cs))+      Just (!c, !cs)                      -> Just (c          , (InJson   , cs))+      Nothing                             -> Nothing
+ src/HaskellWorks/Data/Conduit/Json/Words.hs view
@@ -0,0 +1,88 @@+module HaskellWorks.Data.Conduit.Json.Words where++import           Data.Char+import           Data.Word++wBackslash :: Word8+wBackslash = fromIntegral (ord '\\')++wDoubleQuote :: Word8+wDoubleQuote = fromIntegral (ord '"')++wUnderscore :: Word8+wUnderscore = fromIntegral (ord '_')++wSpace :: Word8+wSpace = fromIntegral (ord ' ')++wOpenParen :: Word8+wOpenParen = fromIntegral (ord '(')++wCloseParen :: Word8+wCloseParen = fromIntegral (ord ')')++wOpenBracket :: Word8+wOpenBracket = fromIntegral (ord '[')++wCloseBracket :: Word8+wCloseBracket = fromIntegral (ord ']')++wOpenBrace :: Word8+wOpenBrace = fromIntegral (ord '{')++wCloseBrace :: Word8+wCloseBrace = fromIntegral (ord '}')++wPlus :: Word8+wPlus = fromIntegral (ord '+')++wA :: Word8+wA = fromIntegral (ord 'A')++wa :: Word8+wa = fromIntegral (ord 'a')++we :: Word8+we = fromIntegral (ord 'e')++wE :: Word8+wE = fromIntegral (ord 'E')++wf :: Word8+wf = fromIntegral (ord 'f')++wn :: Word8+wn = fromIntegral (ord 'n')++wt :: Word8+wt = fromIntegral (ord 't')++wz :: Word8+wz = fromIntegral (ord 'z')++wZ :: Word8+wZ = fromIntegral (ord 'Z')++wDot :: Word8+wDot = fromIntegral (ord '.')++wMinus :: Word8+wMinus = fromIntegral (ord '-')++w0 :: Word8+w0 = fromIntegral (ord '0')++w1 :: Word8+w1 = fromIntegral (ord '1')++w9 :: Word8+w9 = fromIntegral (ord '9')++isLeadingDigit :: Word8 -> Bool+isLeadingDigit w = w == wMinus || (w >= w0 && w <= w9)++isTrailingDigit :: Word8 -> Bool+isTrailingDigit w = w == wPlus || w == wMinus || (w >= w0 && w <= w9) || w == wDot || w == wE || w == we++isAlphabetic :: Word8 -> Bool+isAlphabetic w = (w >= wA && w <= wZ) || (w >= wa && w <= wz)
+ src/HaskellWorks/Data/Conduit/List.hs view
@@ -0,0 +1,11 @@++module HaskellWorks.Data.Conduit.List+  ( runListConduit+  ) where++import           Data.Conduit+import           Data.Conduit.List as CL+import           Prelude           as P++runListConduit :: Conduit i [] o -> [i] -> [o]+runListConduit c is = P.concat $ sourceList is =$ c $$ consume
+ src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec.hs view
@@ -0,0 +1,29 @@+{-# 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
+ src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/Internal.hs view
@@ -0,0 +1,196 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/LineColumn.hs view
@@ -0,0 +1,84 @@+{-# 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)) #-}
+ src/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/Offset.hs view
@@ -0,0 +1,79 @@+{-# 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)) #-}
+ src/HaskellWorks/Data/FromByteString.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.FromByteString+  ( FromByteString(..)+  ) where++import           Data.ByteString.Internal++class FromByteString a where+  fromByteString :: ByteString -> a
+ src/HaskellWorks/Data/FromForeignRegion.hs view
@@ -0,0 +1,7 @@+module HaskellWorks.Data.FromForeignRegion where++import           Data.Word+import           Foreign.ForeignPtr++class FromForeignRegion a where+  fromForeignRegion :: (ForeignPtr Word8, Int, Int) -> a
+ src/HaskellWorks/Data/Json/Final/Tokenize.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Json.Final.Tokenize+    ( parseJsonToken+    ) where++import           HaskellWorks.Data.Attoparsec.Final.Parser.ByteString ()+import           HaskellWorks.Data.Json.Final.Tokenize.Internal
+ src/HaskellWorks/Data/Json/Final/Tokenize/Internal.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Final.Tokenize.Internal+    ( IsChar(..)+    , JsonToken(..)+    , AFP.Parser(..)+    , parseJsonToken+    , parseJsonTokenString+    , escapedChar+    ) where++import           Control.Applicative+import           Control.Monad+import qualified Data.Attoparsec.ByteString.Char8          as BC+import qualified Data.Attoparsec.Combinator                as AC+import qualified Data.Attoparsec.Types                     as T+import           Data.Bits+import           Data.Char+import           Data.String+import           HaskellWorks.Data.Attoparsec.Final.IsChar+import           HaskellWorks.Data.Attoparsec.Final.Parser as AFP+import           HaskellWorks.Data.Json.Token++hexDigitNumeric :: AFP.Parser t => T.Parser t Int+hexDigitNumeric = do+  c <- satisfyChar (\c -> '0' <= c && c <= '9')+  return $ ord c - ord '0'++hexDigitAlphaLower :: AFP.Parser t => T.Parser t Int+hexDigitAlphaLower = do+  c <- satisfyChar (\c -> 'a' <= c && c <= 'z')+  return $ ord c - ord 'a' + 10++hexDigitAlphaUpper :: AFP.Parser t => T.Parser t Int+hexDigitAlphaUpper = do+  c <- satisfyChar (\c -> 'A' <= c && c <= 'Z')+  return $ ord c - ord 'A' + 10++hexDigit :: AFP.Parser t => T.Parser t Int+hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper++verbatimChar :: AFP.Parser t => T.Parser t Char+verbatimChar  = satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"++escapedChar :: (IsString t, AFP.Parser t) => T.Parser t Char+escapedChar   = do+  _ <- string "\\"+  (   char '"'  >> return '"'  ) <|>+    ( char 'b'  >> return '\b' ) <|>+    ( char 'n'  >> return '\n' ) <|>+    ( char 'f'  >> return '\f' ) <|>+    ( char 'r'  >> return '\r' ) <|>+    ( char 't'  >> return '\t' ) <|>+    ( char '\\' >> return '\\' ) <|>+    ( char '\'' >> return '\'' ) <|>+    ( char '/'  >> return '/'  )++escapedCode :: (IsString t, AFP.Parser t) => T.Parser t Char+escapedCode   = do+  _ <- string "\\u"+  a <- hexDigit+  b <- hexDigit+  c <- hexDigit+  d <- hexDigit+  return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d++parseJsonTokenString :: (JsonTokenLike j, AFP.Parser t, Alternative (T.Parser t), IsString t) => T.Parser t j+parseJsonTokenString = do+  _ <- string "\""+  value <- many (verbatimChar <|> escapedChar <|> escapedCode)+  _ <- string "\""+  return $ jsonTokenString value++parseJsonTokenBraceL :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenBraceL = string "{" >> return jsonTokenBraceL++parseJsonTokenBraceR :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenBraceR = string "}" >> return jsonTokenBraceR++parseJsonTokenBracketL :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenBracketL = string "[" >> return jsonTokenBracketL++parseJsonTokenBracketR :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenBracketR = string "]" >> return jsonTokenBracketR++parseJsonTokenComma :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenComma = string "," >> return jsonTokenComma++parseJsonTokenColon :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenColon = string ":" >> return jsonTokenColon++parseJsonTokenWhitespace :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenWhitespace = do+  _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"]+  return jsonTokenWhitespace++parseJsonTokenNull :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenNull = string "null" >> return jsonTokenNull++parseJsonTokenBoolean :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenBoolean = true <|> false+  where+    true  = string "true"   >> return (jsonTokenBoolean True)+    false = string "false"  >> return (jsonTokenBoolean False)++parseJsonTokenDouble :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonTokenDouble = liftM jsonTokenNumber rational++parseJsonToken :: (JsonTokenLike j, AFP.Parser t, IsString t) => T.Parser t j+parseJsonToken =+  parseJsonTokenString     <|>+  parseJsonTokenBraceL     <|>+  parseJsonTokenBraceR     <|>+  parseJsonTokenBracketL   <|>+  parseJsonTokenBracketR   <|>+  parseJsonTokenComma      <|>+  parseJsonTokenColon      <|>+  parseJsonTokenWhitespace <|>+  parseJsonTokenNull       <|>+  parseJsonTokenBoolean    <|>+  parseJsonTokenDouble
+ src/HaskellWorks/Data/Json/Succinct.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Json.Succinct+  ( module X+  ) where++import HaskellWorks.Data.Json.Succinct.Cursor     as X+import HaskellWorks.Data.Json.Succinct.Transform  as X
+ src/HaskellWorks/Data/Json/Succinct/Cursor.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor+  ( module X+  , jsonTokenAt+  , firstChild+  , nextSibling+  , parent+  , depth+  , subtreeSize+  ) where++import qualified Data.Attoparsec.ByteString.Char8                           as ABC+import           Data.ByteString.Internal                                   as BSI+import           HaskellWorks.Data.Json.Final.Tokenize.Internal+import           HaskellWorks.Data.Json.Succinct.Cursor.CursorType          as X+import           HaskellWorks.Data.Json.Succinct.Cursor.Internal            as X+import           HaskellWorks.Data.Positioning+import qualified HaskellWorks.Data.Succinct.BalancedParens                  as BP+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++jsonTokenAt :: (Rank1 w, Select1 v) => JsonCursor ByteString v w -> JsonToken+jsonTokenAt k = case ABC.parse parseJsonToken (vDrop (toCount (jsonCursorPos k)) (cursorText k)) of+  ABC.Fail    {}  -> error "Failed to parse token in cursor"+  ABC.Partial _   -> error "Failed to parse token in cursor"+  ABC.Done    _ r -> r++firstChild :: JsonCursor t v u -> JsonCursor t v u+firstChild k = k { cursorRank = BP.firstChild (balancedParens k) (cursorRank k) }++nextSibling :: BP.BalancedParens u => JsonCursor t v u -> JsonCursor t v u+nextSibling k = k { cursorRank = BP.nextSibling (balancedParens k) (cursorRank k) }++parent :: BP.BalancedParens u => JsonCursor t v u -> JsonCursor t v u+parent k = k { cursorRank = BP.parent (balancedParens k) (cursorRank k) }++depth :: (BP.BalancedParens u, Rank1 u, Rank0 u) => JsonCursor t v u -> Count+depth k = BP.depth (balancedParens k) (cursorRank k)++subtreeSize :: BP.BalancedParens u => JsonCursor t v u -> Count+subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)+
+ src/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParens.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens+  ( JsonBalancedParens(..)+  , getJsonBalancedParens+  ) where++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+import           HaskellWorks.Data.Succinct.BalancedParens          as BP++newtype JsonBalancedParens a = JsonBalancedParens a++getJsonBalancedParens :: JsonBalancedParens a -> a+getJsonBalancedParens (JsonBalancedParens a) = a++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where+  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where+  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where+  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))++instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where+  fromBlankedJson (BlankedJson bj) = JsonBalancedParens (SimpleBalancedParens (DVS.unfoldr fromBools (runListConduit blankedJsonToBalancedParens bj)))
+ src/HaskellWorks/Data/Json/Succinct/Cursor/BlankedJson.hs view
@@ -0,0 +1,23 @@++module HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+  ( BlankedJson(..)+  , FromBlankedJson(..)+  , getBlankedJson+  ) where++import qualified Data.ByteString                      as BS+import           HaskellWorks.Data.ByteString+import           HaskellWorks.Data.Conduit.Json.Blank+import           HaskellWorks.Data.Conduit.List+import           HaskellWorks.Data.FromByteString++newtype BlankedJson = BlankedJson [BS.ByteString] deriving (Eq, Show)++getBlankedJson :: BlankedJson -> [BS.ByteString]+getBlankedJson (BlankedJson bs) = bs++class FromBlankedJson a where+  fromBlankedJson :: BlankedJson -> a++instance FromByteString BlankedJson where+  fromByteString bs = BlankedJson (runListConduit blankJson (chunkedBy 4096 bs))
+ src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.CursorType+  ( HasJsonCursorType(..)+  , JsonCursorType(..)+  , jsonCursorPos+  ) where++import qualified Data.ByteString                                            as BS+import           Data.Char+import           HaskellWorks.Data.Json.Succinct.Cursor.Internal+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data JsonCursorType+  = JsonCursorArray+  | JsonCursorBool+  | JsonCursorNull+  | JsonCursorNumber+  | JsonCursorObject+  | JsonCursorString+  deriving (Eq, Show)++class HasJsonCursorType k where+  jsonCursorType :: k -> JsonCursorType++jsonCursorType' :: Char -> JsonCursorType+jsonCursorType' c = case c of+  '[' -> JsonCursorArray+  't' -> JsonCursorBool+  'f' -> JsonCursorBool+  '0' -> JsonCursorNumber+  '1' -> JsonCursorNumber+  '2' -> JsonCursorNumber+  '3' -> JsonCursorNumber+  '4' -> JsonCursorNumber+  '5' -> JsonCursorNumber+  '6' -> JsonCursorNumber+  '7' -> JsonCursorNumber+  '8' -> JsonCursorNumber+  '9' -> JsonCursorNumber+  '+' -> JsonCursorNumber+  '-' -> JsonCursorNumber+  'n' -> JsonCursorNull+  '{' -> JsonCursorObject+  '"' -> JsonCursorString+  _   -> error "Invalid JsonCursor cursorRank"++jsonCursorPos :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Position+jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1)+  where ik  = interests k+        bpk = balancedParens k++jsonCursorElemAt :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Elem s+jsonCursorElemAt k = cursorText k !!! jsonCursorPos k++instance (Rank1 i, Select1 i, Rank1 b) => HasJsonCursorType (JsonCursor String i b) where+  jsonCursorType = jsonCursorType' . jsonCursorElemAt++instance (Rank1 i, Select1 i, Rank1 b) => HasJsonCursorType (JsonCursor BS.ByteString i b) where+  jsonCursorType = jsonCursorType' . chr . fromIntegral . jsonCursorElemAt
+ src/HaskellWorks/Data/Json/Succinct/Cursor/InterestBits.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+  ( JsonInterestBits(..)+  , getJsonInterestBits+  ) where++import           Control.Applicative+import qualified Data.ByteString                                       as BS+import           Data.ByteString.Internal+import qualified Data.Vector.Storable                                  as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Conduit.Json+import           HaskellWorks.Data.Conduit.List+import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512++newtype JsonInterestBits a = JsonInterestBits a++getJsonInterestBits :: JsonInterestBits a -> a+getJsonInterestBits (JsonInterestBits a) = a++blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString+blankedJsonBssToInterestBitsBs bss = BS.concat $ runListConduit blankedJsonToInterestBits bss++genInterest :: ByteString -> Maybe (Word8, ByteString)+genInterest = BS.uncons++genInterestForever :: ByteString -> Maybe (Word8, ByteString)+genInterestForever bs = BS.uncons bs <|> Just (0, bs)++instance FromBlankedJson (JsonInterestBits (BitShown BS.ByteString)) where+  fromBlankedJson (BlankedJson bj) = JsonInterestBits (BitShown (BS.unfoldr genInterest (blankedJsonBssToInterestBitsBs bj)))++instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word8))) where+  fromBlankedJson (BlankedJson bj) = JsonInterestBits (BitShown (DVS.unfoldr genInterest (blankedJsonBssToInterestBitsBs bj)))++instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word16))) where+  fromBlankedJson bj = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))+    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)+          newLen        = (BS.length interestBS + 1) `div` 2 * 2++instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word32))) where+  fromBlankedJson bj = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))+    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)+          newLen        = (BS.length interestBS + 3) `div` 4 * 4++instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word64))) where+  fromBlankedJson bj    = JsonInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)))+    where interestBS    = blankedJsonBssToInterestBitsBs (getBlankedJson bj)+          newLen        = (BS.length interestBS + 7) `div` 8 * 8++instance FromBlankedJson (JsonInterestBits Poppy512) where+  fromBlankedJson = JsonInterestBits . makePoppy512 . bitShown . getJsonInterestBits . fromBlankedJson
+ src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Cursor.Internal+  ( JsonCursor(..)+  ) where++import qualified Data.ByteString                                       as BS+import qualified Data.ByteString.Char8                                 as BSC+import           Data.ByteString.Internal                              as BSI+import           Data.String+import qualified Data.Vector.Storable                                  as DVS+import           Data.Word+import           Foreign.ForeignPtr+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.FromByteString+import           HaskellWorks.Data.FromForeignRegion+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++data JsonCursor t v w = JsonCursor+  { cursorText     :: !t+  , interests      :: !v+  , balancedParens :: !w+  , cursorRank     :: !Count+  }+  deriving (Eq, Show)++instance  (FromBlankedJson (JsonInterestBits a), FromBlankedJson (JsonBalancedParens b))+          => FromByteString (JsonCursor BS.ByteString a b) where+  fromByteString bs   = JsonCursor+    { cursorText      = bs+    , interests       = getJsonInterestBits (fromBlankedJson blankedJson)+    , balancedParens  = getJsonBalancedParens (fromBlankedJson blankedJson)+    , cursorRank      = 1+    }+    where blankedJson :: BlankedJson+          blankedJson = fromByteString bs++instance IsString (JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])) where+  fromString :: String -> JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+  fromString s = JsonCursor+    { cursorText      = s+    , cursorRank      = 1+    , balancedParens  = SimpleBalancedParens (jsonToInterestBalancedParens [bs])+    , interests       = BitShown interests'+    }+    where bs          = BSC.pack s :: BS.ByteString+          interests'  = jsonToInterestBits [bs]++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where+  fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) where+  fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) where+  fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) where+  fromString = fromByteString . BSC.pack++instance IsString (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where+  fromString = fromByteString . BSC.pack++instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)++instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where+  fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size)+
+ src/HaskellWorks/Data/Json/Succinct/Transform.hs view
@@ -0,0 +1,18 @@+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)
+ src/HaskellWorks/Data/Json/Token.hs view
@@ -0,0 +1,41 @@+module HaskellWorks.Data.Json.Token (JsonToken(..), JsonTokenLike(..)) where++class JsonTokenLike j where+  jsonTokenBraceL     :: j+  jsonTokenBraceR     :: j+  jsonTokenBracketL   :: j+  jsonTokenBracketR   :: j+  jsonTokenComma      :: j+  jsonTokenColon      :: j+  jsonTokenWhitespace :: j+  jsonTokenString     :: String -> j+  jsonTokenBoolean    :: Bool -> j+  jsonTokenNumber     :: Double -> j+  jsonTokenNull       :: j++data JsonToken+  = JsonTokenBraceL+  | JsonTokenBraceR+  | JsonTokenBracketL+  | JsonTokenBracketR+  | JsonTokenComma+  | JsonTokenColon+  | JsonTokenWhitespace+  | JsonTokenString String+  | JsonTokenBoolean Bool+  | JsonTokenNumber Double+  | JsonTokenNull+  deriving (Eq, Show)++instance JsonTokenLike JsonToken where+  jsonTokenBraceL     = JsonTokenBraceL+  jsonTokenBraceR     = JsonTokenBraceR+  jsonTokenBracketL   = JsonTokenBracketL+  jsonTokenBracketR   = JsonTokenBracketR+  jsonTokenComma      = JsonTokenComma+  jsonTokenColon      = JsonTokenColon+  jsonTokenWhitespace = JsonTokenWhitespace+  jsonTokenString     = JsonTokenString+  jsonTokenBoolean    = JsonTokenBoolean+  jsonTokenNumber     = JsonTokenNumber+  jsonTokenNull       = JsonTokenNull
+ src/HaskellWorks/Data/Positioning.hs view
@@ -0,0 +1,34 @@+{-# 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)
+ src/HaskellWorks/Data/Search.hs view
@@ -0,0 +1,12 @@+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 #-}
+ src/HaskellWorks/Data/Succinct.hs view
@@ -0,0 +1,12 @@+-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Succinct+    ( module X+    ) where++import           HaskellWorks.Data.Succinct.BalancedParens   as X+import           HaskellWorks.Data.Succinct.NearestNeighbour as X+import           HaskellWorks.Data.Succinct.RankSelect       as X
+ src/HaskellWorks/Data/Succinct/BalancedParens.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Succinct.BalancedParens+  ( module X+  ) where++import HaskellWorks.Data.Succinct.BalancedParens.Internal as X+import HaskellWorks.Data.Succinct.BalancedParens.Simple as X
+ src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs view
@@ -0,0 +1,32 @@+module HaskellWorks.Data.Succinct.BalancedParens.Internal+  ( BalancedParens(..)+  , firstChild+  , nextSibling+  , parent+  , depth+  , subtreeSize+  ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1++class BalancedParens v where+  findOpen :: v -> Count -> Count+  findClose :: v -> Count -> Count+  enclose :: v -> Count -> Count++firstChild :: v -> Count -> Count+firstChild _ = (+ 1)++nextSibling :: BalancedParens v => v -> Count -> Count+nextSibling v p = findClose v p + 1++parent :: BalancedParens v => v -> Count -> Count+parent = enclose++depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Count+depth v p = let q = findOpen v p in rank1 v q - rank0 v q++subtreeSize :: BalancedParens v => v -> Count -> Count+subtreeSize v p = (findClose v p - p + 1) `quot` 2
+ src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HaskellWorks.Data.Succinct.BalancedParens.Simple+  ( SimpleBalancedParens(..)+  , closeAt+  , findOpen+  , findClose+  , findClose'+  , openAt+  ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitLength+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.BalancedParens.Internal+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Prelude                                                    as P++newtype SimpleBalancedParens a = SimpleBalancedParens a+  deriving (BitLength, Eq, BitShow, TestBit, Rank0, Rank1, Select0, Select1)++instance Functor SimpleBalancedParens where+  fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)++instance BitShow a => Show (SimpleBalancedParens a) where+  show = bitShow++closeAt :: TestBit a => a -> Count -> Bool+closeAt v c = not (v .?. lastPositionOf c)++openAt :: TestBit a => a -> Count -> Bool+openAt v c = v .?. lastPositionOf c++require :: Bool -> String -> a -> a+require p msg v = if p then v else error msg++findOpen' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count+findOpen' c v p =+  require (0 < p && p <= bitLength v) "Out of bounds" $+  if v `openAt` p+    then if c == 0+      then p+      else findOpen' (c - 1) v (p - 1)+    else findOpen' (c + 1) v (p - 1)++findClose' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count+findClose' c v p =+  require (1 < p && p <= bitLength v) "Out of bounds" $+  if v `closeAt` p+    then if c == 0+      then p+      else findClose' (c + 1) v (p + 1)+    else findClose' (c - 1) v (p + 1)++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)++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)++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)++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)++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)++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)++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)++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)++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)
+ src/HaskellWorks/Data/Succinct/NearestNeighbour.hs view
@@ -0,0 +1,14 @@+module HaskellWorks.Data.Succinct.NearestNeighbour+  ( bitPred+  , bitSucc+  ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1++bitPred :: (Rank1 v, Select1 v) => v -> Count -> Count+bitPred v p = select1 v (rank1 v p - 1)++bitSucc :: (Rank1 v, Select1 v) => v -> Count -> Count+bitSucc v p = select1 v (rank1 v p + 1)
+ src/HaskellWorks/Data/Succinct/RankSelect.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Succinct.RankSelect+  ( module X+  ) where++import           HaskellWorks.Data.Succinct.RankSelect.Internal as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary+  ( module X+  ) where++import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic.hs view
@@ -0,0 +1,9 @@++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+    ( module X+    ) where++import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0   as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1   as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0 as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+    ( Rank0(..)+    ) where++import qualified Data.Vector                                              as DV+import qualified Data.Vector.Storable                                     as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 as X+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                                  as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Rank0 v where+  rank0 :: v -> Count -> Count++deriving instance Rank0 a => Rank0 (BitShown a)++instance Rank0 Word8 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word16 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word32 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word64 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 [Bool] where+  rank0 = go 0+    where go r _ 0 = r+          go r (False:bs) p = go (r + 1) bs (p - 1)+          go r (True:bs) p  = go  r      bs (p - 1)+          go _ [] _         = error "Out of range"+  {-# INLINABLE rank0 #-}++instance Rank0 [Word8] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word16] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word32] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word64] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word8) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word16) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word32) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word64) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word8) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word16) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word32) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word64) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+    ( Rank1(..)+    ) where++import qualified Data.Vector                               as DV+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                   as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Rank1 v where+  rank1 :: v -> Count -> Count++deriving instance Rank1 a => Rank1 (BitShown a)++instance Rank1 Word8 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (8 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x55) + ((r0 .>. 1) .&. 0x55)  in+    let r2 = (r1 .&. 0x33) + ((r1 .>. 2) .&. 0x33)  in+    let r3 = (r2 .&. 0x0f) + ((r2 .>. 4) .&. 0x0f)  in+    let r4 = r3 `mod` 255                           in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word16 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (16 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x5555) + ((r0 .>. 1) .&. 0x5555)  in+    let r2 = (r1 .&. 0x3333) + ((r1 .>. 2) .&. 0x3333)  in+    let r3 = (r2 .&. 0x0f0f) + ((r2 .>. 4) .&. 0x0f0f)  in+    let r4 = r3 `mod` 255                               in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word32 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (32 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x55555555) + ((r0 .>. 1) .&. 0x55555555)  in+    let r2 = (r1 .&. 0x33333333) + ((r1 .>. 2) .&. 0x33333333)  in+    let r3 = (r2 .&. 0x0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f)  in+    let r4 = r3 `mod` 255                                       in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word64 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (64 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x5555555555555555) + ((r0 .>. 1) .&. 0x5555555555555555)  in+    let r2 = (r1 .&. 0x3333333333333333) + ((r1 .>. 2) .&. 0x3333333333333333)  in+    let r3 = (r2 .&. 0x0f0f0f0f0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f0f0f0f0f)  in+    let r4 = r3 `mod` 255                                                       in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 [Bool] where+  rank1 = go 0+    where go r _ 0 = r+          go r (True :bs) p = go (r + 1) bs (p - 1)+          go r (False:bs) p = go  r      bs (p - 1)+          go _ [] _         = error "Out of range"+  {-# INLINABLE rank1 #-}++instance Rank1 [Word8] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word16] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word32] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word64] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word8) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word16) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word32) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word64) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word8) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word16) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word32) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word64) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+    ( Select0(..)+    ) where++import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Select0 v where+  select0 :: v -> Count -> Count++deriving instance Select0 a => Select0 (BitShown a)++-- TODO: Implement NOT in terms of select for word-16+instance Select0 Word8 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word16 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word32 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word64 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 [Bool] where+  select0 = go 0+    where go r _ 0 = r+          go r (False:bs) c = go (r + 1) bs (c - 1)+          go r (True:bs)  c = go (r + 1) bs  c+          go _ []         _ = error "Out of range"+  {-# INLINABLE select0 #-}++instance Select0 [Word8] where+  select0 v c = go v c 0+    where go :: [Word8] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word16] where+  select0 v c = go v c 0+    where go :: [Word16] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word32] where+  select0 v c = go v c 0+    where go :: [Word32] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word64] where+  select0 v c = go v c 0+    where go :: [Word64] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word8) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word16) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word32) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word64) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word8) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word16) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word32) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word64) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+    ( Select1(..)+    ) where++import qualified Data.Vector                               as DV+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                   as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Select1 v where+  select1 :: v -> Count -> Count++deriving instance Select1 a => Select1 (BitShown a)++-- TODO: Implement NOT interms of select for word-16+instance Select1 Word8 where+  select1 _ 0 = 0+  select1 v p = select1 (fromIntegral v :: Word16) p+  {-# INLINABLE select1 #-}++-- TODO: Remove redundant code to optimise+instance Select1 Word16 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x5555) + ((v .>.  1) .&. 0x5555)    in+    let b = (a .&. 0x3333) + ((a .>.  2) .&. 0x3333)    in+    let c = (b .&. 0x0f0f) + ((b .>.  4) .&. 0x0f0f)    in+    let d = (c .&. 0x00ff) + ((c .>.  8) .&. 0x00ff)    in+    -- Now do branchless select!+    let r0 = d + 1 - (fromIntegral (getCount rn) :: Word16)                     in+    let s0 = 64 :: Word16                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++-- TODO: Remove redundant code to optimise+instance Select1 Word32 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x55555555) + ((v .>.  1) .&. 0x55555555)    in+    let b = (a .&. 0x33333333) + ((a .>.  2) .&. 0x33333333)    in+    let c = (b .&. 0x0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f)    in+    let d = (c .&. 0x00ff00ff) + ((c .>.  8) .&. 0x00ff00ff)    in+    let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff)    in+    -- Now do branchless select!+    let r0 = e + 1 - (fromIntegral (getCount rn) :: Word32)                     in+    let s0 = 64 :: Word32                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++instance Select1 Word64 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x5555555555555555) + ((v .>.  1) .&. 0x5555555555555555)    in+    let b = (a .&. 0x3333333333333333) + ((a .>.  2) .&. 0x3333333333333333)    in+    let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f0f0f0f0f)    in+    let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>.  8) .&. 0x00ff00ff00ff00ff)    in+    let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff)    in+    let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff)    in+    -- Now do branchless select!+    let r0 = f + 1 - fromIntegral (getCount rn) :: Word64                       in+    let s0 = 64 :: Word64                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++instance Select1 [Bool] where+  select1 = go 0+    where go r _ 0 = r+          go r (True :bs) c = go (r + 1) bs (c - 1)+          go r (False:bs) c = go (r + 1) bs  c+          go _ []         _ = error "Out of range"+  {-# INLINABLE select1 #-}++instance Select1 [Word8] where+  select1 v c = go v c 0+    where go :: [Word8] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word16] where+  select1 v c = go v c 0+    where go :: [Word16] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word32] where+  select1 v c = go v c 0+    where go :: [Word32] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word64] where+  select1 v c = go v c 0+    where go :: [Word64] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word8) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word16) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word32) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word64) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word8) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word16) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word32) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word64) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs view
@@ -0,0 +1,55 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+    ( Poppy512(..)+    , Rank1(..)+    , makePoppy512+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data Poppy512 = Poppy512+  { poppy512Bits  :: DVS.Vector Word64+  , poppy512Index :: DVS.Vector Word64+  } deriving (Eq, Show)++makePoppy512 :: DVS.Vector Word64 -> Poppy512+makePoppy512 v = Poppy512+  { poppy512Bits  = v+  , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index+  }+  where gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else getCount (popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v))) + DVS.last u++instance BitRead Poppy512 where+  bitRead = fmap makePoppy512 . bitRead++instance Rank1 Poppy512 where+  rank1 (Poppy512 v i) p =+    Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Rank0 Poppy512 where+  rank0 (Poppy512 v i) p =+    p `div` 512 * 512 - Count (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Select1 Poppy512 where+  select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = Count (i !!! q)+          wordAt = (i !!!)++instance Select0 Poppy512 where+  select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = Count (fromIntegral q * 512 - (i !!! q))+          wordAt o = fromIntegral o * 512 - (i !!! o)
+ src/HaskellWorks/Data/Succinct/RankSelect/Internal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Succinct.RankSelect.Internal+    ( -- * Rank & Select+      Rank(..)+    , Select(..)+    ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic++class Eq a => Rank v a where+  rank :: a -> v -> Count -> Count++class Eq a => Select v a where+  select :: a -> v -> Count -> Count++instance Rank [Bool] Bool where+  rank a = if a then rank1 else rank0+  {-# INLINABLE rank #-}++instance Select [Bool] Bool where+  select a = if a then select1 else select0+  {-# INLINABLE select #-}
+ src/HaskellWorks/Data/Time.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE BangPatterns #-}++module HaskellWorks.Data.Time where++import           System.CPUTime++measure :: a -> IO a+measure a = do+  start <- getCPUTime+  let !b = a+  end   <- getCPUTime+  print (end - start)+  return b
+ src/HaskellWorks/Data/Vector/BoxedVectorLike.hs view
@@ -0,0 +1,68 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Vector/Storable/ByteString.hs view
@@ -0,0 +1,38 @@+-- 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)
+ src/HaskellWorks/Data/Vector/StorableVectorLike.hs view
@@ -0,0 +1,68 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Vector/VectorLike.hs view
@@ -0,0 +1,453 @@+{-# 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 #-}
+ src/HaskellWorks/Data/Word.hs view
@@ -0,0 +1,40 @@+{-# 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))
+ src/HaskellWorks/Function.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Function+  ( applyN+  ) where++applyN :: (a -> a) -> Int -> a -> a+applyN f n = foldl (.) id (replicate (fromIntegral n) f)
+ test/HaskellWorks/Data/Bits/BitReadSpec.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.BitReadSpec (spec) where++import qualified Data.Vector                    as DV+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitShow+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BitReadSpec" $ do+  it "bitRead \"10000000 101\" :: Maybe [Word8]" $+    let w = bitRead "10000000 101" :: Maybe [Bool] in+    w `shouldBe` Just [True, False, False, False, False, False, False, False, True, False, True]+  it "bitRead \"10000000 101\" :: Maybe [Word8]"$+     let w = bitRead "10000000 101" :: Maybe [Word8] in+    w `shouldBe` Just [1, 5]+  it "bitRead \"11100100 10101111 1\" :: Maybe [Word8]" $+    let ws = bitRead "11100100 10101111 1" :: Maybe [Word8] in+    ws `shouldBe` Just [39, 245, 1]+  it "bitRead \"\" :: Maybe [Word8]" $+    let ws = bitRead "" :: Maybe [Word8] in+    ws `shouldBe` Just []+  it "bitRead \"10000000 101\" :: Maybe (DV.Vector Word8)" $+    let v = bitRead "10000000 101" :: Maybe (DV.Vector Word8) in+    v `shouldBe` Just (DV.fromList [1, 5])+  it "bitRead \"11100100 10101111 1\" :: Maybe (DV.Vector Word8)" $+    let v = bitRead "11100100 10101111 1" :: Maybe (DV.Vector Word8) in+    v `shouldBe` Just (DV.fromList [39, 245, 1])+  it "bitRead \"11100100 10101111 1\" :: Maybe (DV.Vector Word16)" $+    let v = bitRead "11100100 10101111 1" :: Maybe (DV.Vector Word16) in+    v `shouldBe` Just (DV.fromList [39 + 62720, 1])+  it "bitRead \"\" :: Maybe (DV.Vector Word8)" $+    let v = bitRead "" :: Maybe (DV.Vector Word8) in+    v `shouldBe` Just (DV.fromList [])+  it "bitShow (8 :: Word8)" $+    let bs = bitShow (8 :: Word8) in+    bs `shouldBe` "00010000"+  it "bitShow (8 :: Word64)" $+    let bs = bitShow (8 :: Word64) in+    bs `shouldBe` "00010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+  it "bitShow [0x0102040810204080 :: Word64]" $+    let bs = bitShow [0x0102040810204080 :: Word64] in+    bs `shouldBe` "00000001 00000010 00000100 00001000 00010000 00100000 01000000 10000000"
+ test/HaskellWorks/Data/Bits/BitWiseSpec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.BitWiseSpec (spec) where++import qualified Data.Bits                                 as B+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitLength+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.SuccinctSpec" $ do+  describe "for popCount0" $ do+    it "for Word8 matches Data.Bits implementation" $ property $+      \(w :: Word8 ) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+    it "for Word16 matches Data.Bits implementation" $ property $+      \(w :: Word16) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+    it "for Word32 matches Data.Bits implementation" $ property $+      \(w :: Word32) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+    it "for Word64 matches Data.Bits implementation" $ property $+      \(w :: Word64) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+    it "for [Word8] matches Data.Bits implementation" $ property $+      \(w :: [Word8] ) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word16] matches Data.Bits implementation" $ property $+      \(w :: [Word16]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word32] matches Data.Bits implementation" $ property $+      \(w :: [Word32]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word64] matches Data.Bits implementation" $ property $+      \(w :: [Word64]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word8] matches Data.Bits implementation" $ property $+      \(w :: [Word8] ) -> popCount0 w == popCount0 (DVS.fromList w)+    it "for [Word16] matches Data.Bits implementation" $ property $+      \(w :: [Word16]) -> popCount0 w == popCount0 (DVS.fromList w)+    it "for [Word32] matches Data.Bits implementation" $ property $+      \(w :: [Word32]) -> popCount0 w == popCount0 (DVS.fromList w)+    it "for [Word64] matches Data.Bits implementation" $ property $+      \(w :: [Word64]) -> popCount0 w == popCount0 (DVS.fromList w)+  describe "for popCount1" $ do+    it "for Word8 matches Data.Bits implementation" $ property $+      \(w :: Word8 ) -> popCount1 w == fromIntegral (B.popCount w)+    it "for Word16 matches Data.Bits implementation" $ property $+      \(w :: Word16) -> popCount1 w == fromIntegral (B.popCount w)+    it "for Word32 matches Data.Bits implementation" $ property $+      \(w :: Word32) -> popCount1 w == fromIntegral (B.popCount w)+    it "for Word64 matches Data.Bits implementation" $ property $+      \(w :: Word64) -> popCount1 w == fromIntegral (B.popCount w)+    it "for [Word8] matches Data.Bits implementation" $ property $+      \(w :: [Word8] ) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word16] matches Data.Bits implementation" $ property $+      \(w :: [Word16]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word32] matches Data.Bits implementation" $ property $+      \(w :: [Word32]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word64] matches Data.Bits implementation" $ property $+      \(w :: [Word64]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+    it "for [Word8] matches Data.Bits implementation" $ property $+      \(w :: [Word8] ) -> popCount1 w == popCount1 (DVS.fromList w)+    it "for [Word16] matches Data.Bits implementation" $ property $+      \(w :: [Word16]) -> popCount1 w == popCount1 (DVS.fromList w)+    it "for [Word32] matches Data.Bits implementation" $ property $+      \(w :: [Word32]) -> popCount1 w == popCount1 (DVS.fromList w)+    it "for [Word64] matches Data.Bits implementation" $ property $+      \(w :: [Word64]) -> popCount1 w == popCount1 (DVS.fromList w)
+ test/HaskellWorks/Data/Bits/FromBoolsSpec.hs view
@@ -0,0 +1,157 @@+{-# 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])
+ test/HaskellWorks/Data/Conduit/Json/BlankSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Conduit.Json.BlankSpec (spec) where++import qualified Data.ByteString                      as BS+import           HaskellWorks.Data.Conduit.Json.Blank+import           HaskellWorks.Data.Conduit.List+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec+whenBlankedJsonShouldBe original expected = do+  it (show original ++ " when blanked json should be " ++ show expected) $ do+    BS.concat (runListConduit blankJson [original]) `shouldBe` expected++spec :: Spec+spec = describe "HaskellWorks.Data.Conduit.Json.BlankSpec" $ do+  describe "Can blank json" $ do+    "\"\""                                `whenBlankedJsonShouldBe` "()"+    "\"\\\\\""                            `whenBlankedJsonShouldBe` "(  )"+    "\"\\\\\\\""                          `whenBlankedJsonShouldBe` "(    "+    "\" \\\\\\\""                         `whenBlankedJsonShouldBe` "(     "+    "\" \\n\\\\\""                        `whenBlankedJsonShouldBe` "(     )"+    ""                                    `whenBlankedJsonShouldBe` ""+    "\"\""                                `whenBlankedJsonShouldBe` "()"+    "\" \""                               `whenBlankedJsonShouldBe` "( )"+    "\" a \""                             `whenBlankedJsonShouldBe` "(   )"+    " \"a \" x"                           `whenBlankedJsonShouldBe` " (  ) x"+    " \"a\"b\"c\"d"                       `whenBlankedJsonShouldBe` " ( )b( )d"+    ""                                    `whenBlankedJsonShouldBe` ""+    "1"                                   `whenBlankedJsonShouldBe` "1"+    "11"                                  `whenBlankedJsonShouldBe` "10"+    "00"                                  `whenBlankedJsonShouldBe` "10"+    "00"                                  `whenBlankedJsonShouldBe` "10"+    "-0.12e+34"                           `whenBlankedJsonShouldBe` "100000000"+    "10.12E-34 "                          `whenBlankedJsonShouldBe` "100000000 "+    "10.12E-34 12"                        `whenBlankedJsonShouldBe` "100000000 10"+    " 10.12E-34 -1"                       `whenBlankedJsonShouldBe` " 100000000 10"+    ""                                    `whenBlankedJsonShouldBe` ""+    "a"                                   `whenBlankedJsonShouldBe` "a"+    "z"                                   `whenBlankedJsonShouldBe` "z"+    " Aaa "                               `whenBlankedJsonShouldBe` " A__ "+    " Za def "                            `whenBlankedJsonShouldBe` " Z_ d__ "+    ""                                    `whenBlankedJsonShouldBe` ""+    " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { (  ): 100, [(), t___], n___}"
+ test/HaskellWorks/Data/Conduit/JsonSpec.hs view
@@ -0,0 +1,108 @@+{-# 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"
+ test/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/LineColumnSpec.hs view
@@ -0,0 +1,171 @@+{-# 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")+                ]
+ test/HaskellWorks/Data/Conduit/Tokenize/Attoparsec/OffsetSpec.hs view
@@ -0,0 +1,164 @@+{-# 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")+                ]
+ test/HaskellWorks/Data/Json/Final/TokenizeSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Json.Final.TokenizeSpec (spec) where++import qualified Data.Attoparsec.ByteString.Char8      as BC+import           Data.ByteString                       as BS+import           HaskellWorks.Data.Json.Final.Tokenize+import           HaskellWorks.Data.Json.Token+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++parseJsonToken' :: ByteString -> Either String JsonToken+parseJsonToken' = BC.parseOnly parseJsonToken++spec :: Spec+spec = describe "Data.Conduit.Succinct.JsonSpec" $ do+  describe "When parsing single token at beginning of text" $ do+    it "Empty Json should produce no bits" $+      parseJsonToken' "" `shouldBe` Left "not enough input"+    it "Json with one space should produce whitespace token" $+      parseJsonToken' " " `shouldBe` Right JsonTokenWhitespace+    it "Json with two spaces should produce whitespace token" $+      parseJsonToken' "  " `shouldBe` Right JsonTokenWhitespace+    it "Spaces and newlines should produce no bits" $+      parseJsonToken' "  \n \r \t " `shouldBe` Right JsonTokenWhitespace+    it "`null` at beginning should produce one bit" $+      parseJsonToken' "null " `shouldBe` Right JsonTokenNull+    it "number at beginning should produce one bit" $+      parseJsonToken' "1234 " `shouldBe` Right (JsonTokenNumber 1234)+    it "false at beginning should produce one bit" $+      parseJsonToken' "false " `shouldBe` Right (JsonTokenBoolean False)+    it "true at beginning should produce one bit" $+      parseJsonToken' "true " `shouldBe` Right (JsonTokenBoolean True)+    it "string at beginning should produce one bit" $+      parseJsonToken' "\"hello\" " `shouldBe` Right (JsonTokenString "hello")+    it "quoted string should parse" $+      parseJsonToken' "\"\\\"\" " `shouldBe` Right (JsonTokenString "\"")+    it "left brace at beginning should produce one bit" $+      parseJsonToken' "{ " `shouldBe` Right JsonTokenBraceL+    it "right brace at beginning should produce one bit" $+      parseJsonToken' "} " `shouldBe` Right JsonTokenBraceR+    it "left bracket at beginning should produce one bit" $+      parseJsonToken' "[ " `shouldBe` Right JsonTokenBracketL+    it "right bracket at beginning should produce one bit" $+      parseJsonToken' "] " `shouldBe` Right JsonTokenBracketR+    it "right bracket at beginning should produce one bit" $+      parseJsonToken' ": " `shouldBe` Right JsonTokenColon+    it "right bracket at beginning should produce one bit" $+      parseJsonToken' ", " `shouldBe` Right JsonTokenComma
+ test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE ExplicitForAll        #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}++module HaskellWorks.Data.Json.Succinct.CursorSpec(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.BitShow+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.FromForeignRegion+import           HaskellWorks.Data.Json.Succinct.Cursor                     as C+import           HaskellWorks.Data.Json.Token+import qualified HaskellWorks.Data.Succinct.BalancedParens.Internal         as BP+import           HaskellWorks.Data.Succinct.BalancedParens.Simple+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import           System.IO.MMap+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do+  let fc = C.firstChild+  let ns = C.nextSibling+  let cd = C.depth+  describe "Cursor for [Bool]" $ do+    it "initialises to beginning of empty object" $ do+      let cursor = "{}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorObject+    it "initialises to beginning of empty object preceded by spaces" $ do+      let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorObject+    it "initialises to beginning of number" $ do+      let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorNumber+    it "initialises to beginning of string" $ do+      let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorString+    it "initialises to beginning of array" $ do+      let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorArray+    it "initialises to beginning of boolean true" $ do+      let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorBool+    it "initialises to beginning of boolean false" $ do+      let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorBool+    it "initialises to beginning of null" $ do+      let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType cursor `shouldBe` JsonCursorNull+    it "cursor can navigate to first child of array" $ do+      let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType (fc cursor) `shouldBe` JsonCursorNull+    it "cursor can navigate to second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject+    it "cursor can navigate to first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString+    it "cursor can navigate to first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      jsonCursorType ((ns . fc . ns . fc) cursor)  `shouldBe` JsonCursorNumber+    it "depth at top" $ do+      let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      cd cursor `shouldBe` 1+    it "depth at first child of array" $ do+      let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      cd (fc cursor) `shouldBe` 2+    it "depth at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      cd ((ns . fc) cursor) `shouldBe` 2+    it "depth at first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      cd ((fc . ns . fc) cursor) `shouldBe` 3+    it "depth at first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+      cd ((ns . fc . ns . fc) cursor)  `shouldBe` 3+  genSpec "DVS.Vector Word8"  (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))+  genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))+  genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))+  genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "Poppy512"          (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+  it "Loads same Json consistentally from different backing vectors" $ do+    let cursor8   = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))+    let cursor16  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))+    let cursor32  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))+    let cursor64  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+    cursorText cursor8 `shouldBe` cursorText cursor16+    cursorText cursor8 `shouldBe` cursorText cursor32+    cursorText cursor8 `shouldBe` cursorText cursor64+    let ic8   = bitShow $ interests cursor8+    let ic16  = bitShow $ interests cursor16+    let ic32  = bitShow $ interests cursor32+    let ic64  = bitShow $ interests cursor64+    ic16 `shouldBeginWith` ic8+    ic32 `shouldBeginWith` ic16+    ic64 `shouldBeginWith` ic32++shouldBeginWith :: (Eq a, Show a) => [a] -> [a] -> IO ()+shouldBeginWith as bs = take (length bs) as `shouldBe` bs++genSpec :: forall t u.+  ( Eq                t+  , Show              t+  , Select1           t+  , Eq                u+  , Show              u+  , Rank0             u+  , Rank1             u+  , BP.BalancedParens u+  , FromForeignRegion (JsonCursor BS.ByteString t u)+  , IsString          (JsonCursor BS.ByteString t u)+  , HasJsonCursorType (JsonCursor BS.ByteString t u))+  => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t _ = do+  let fc = C.firstChild+  let ns = C.nextSibling+  let pn = C.parent+  let cd = C.depth+  let ss = C.subtreeSize+  describe ("Cursor for (" ++ t ++ ")") $ do+    it "initialises to beginning of empty object" $ do+      let cursor = "{}" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorObject+    it "initialises to beginning of empty object preceded by spaces" $ do+      let cursor = " {}" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorObject+    it "initialises to beginning of number" $ do+      let cursor = "1234" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorNumber+    it "initialises to beginning of string" $ do+      let cursor = "\"Hello\"" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorString+    it "initialises to beginning of array" $ do+      let cursor = "[]" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorArray+    it "initialises to beginning of boolean true" $ do+      let cursor = "true" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorBool+    it "initialises to beginning of boolean false" $ do+      let cursor = "false" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorBool+    it "initialises to beginning of null" $ do+      let cursor = "null" :: JsonCursor BS.ByteString t u+      jsonCursorType cursor `shouldBe` JsonCursorNull+    it "cursor can navigate to first child of array" $ do+      let cursor = "[null]" :: JsonCursor BS.ByteString t u+      jsonCursorType (firstChild cursor) `shouldBe` JsonCursorNull+    it "cursor can navigate to second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject+    it "cursor can navigate to first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString+    it "cursor can navigate to first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      jsonCursorType ((ns . fc . ns . fc) cursor)  `shouldBe` JsonCursorNumber+    it "depth at top" $ do+      let cursor = "[null]" :: JsonCursor BS.ByteString t u+      cd cursor `shouldBe` 1+    it "depth at first child of array" $ do+      let cursor = "[null]" :: JsonCursor BS.ByteString t u+      cd (fc cursor) `shouldBe` 2+    it "depth at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      cd ((ns . fc) cursor) `shouldBe` 2+    it "depth at first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      cd ((fc . ns . fc) cursor) `shouldBe` 3+    it "depth at first child of object at second child of array" $ do+      let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u+      cd ((ns . fc . ns . fc) cursor)  `shouldBe` 3+    it "can navigate down and forwards" $ do+      (fptr, offset, size) <- mmapFileForeignPtr "test/Resources/sample.json" ReadOnly Nothing+      let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+      jsonCursorType                                                              cursor  `shouldBe` JsonCursorObject+      jsonCursorType ((                                                       fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((                                                  ns . fc) cursor) `shouldBe` JsonCursorObject+      jsonCursorType ((                                             fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((                                        ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((                                   ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((                              ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorObject+      jsonCursorType ((                         fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((                    ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((               ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((          ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((     ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString+      jsonCursorType ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber+    it "can navigate up" $ do+      (fptr, offset, size) <- mmapFileForeignPtr "test/Resources/sample.json" ReadOnly Nothing+      let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+      (                                                        pn . fc) cursor `shouldBe`                               cursor+      (                                                   pn . ns . fc) cursor `shouldBe`                               cursor+      (                                              pn . fc . ns . fc) cursor `shouldBe` (                    ns . fc) cursor+      (                                         pn . ns . fc . ns . fc) cursor `shouldBe` (                    ns . fc) cursor+      (                                    pn . ns . ns . fc . ns . fc) cursor `shouldBe` (                    ns . fc) cursor+      (                               pn . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (                    ns . fc) cursor+      (                          pn . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+      (                     pn . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+      (                pn . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+      (           pn . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+      (      pn . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+      ( pn . ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor+    it "can get subtree size" $ do+      (fptr, offset, size) <- mmapFileForeignPtr "test/Resources/sample.json" ReadOnly Nothing+      let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+      ss                                                              cursor  `shouldBe` 45+      ss ((                                                       fc) cursor) `shouldBe` 1+      ss ((                                                  ns . fc) cursor) `shouldBe` 43+      ss ((                                             fc . ns . fc) cursor) `shouldBe` 1+      ss ((                                        ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((                                   ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((                              ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 9+      ss ((                         fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((                    ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((               ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((          ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((     ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+      ss ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1+    it "can get token at cursor" $ do+      (fptr, offset, size) <- mmapFileForeignPtr "test/Resources/sample.json" ReadOnly Nothing+      let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u+      jsonTokenAt                                                              cursor  `shouldBe` JsonTokenBraceL+      jsonTokenAt ((                                                       fc) cursor) `shouldBe` JsonTokenString "widget"+      jsonTokenAt ((                                                  ns . fc) cursor) `shouldBe` JsonTokenBraceL+      jsonTokenAt ((                                             fc . ns . fc) cursor) `shouldBe` JsonTokenString "debug"+      jsonTokenAt ((                                        ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "on"+      jsonTokenAt ((                                   ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "window"+      jsonTokenAt ((                              ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenBraceL+      jsonTokenAt ((                         fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "title"+      jsonTokenAt ((                    ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "Sample Konfabulator Widget"+      jsonTokenAt ((               ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "name"+      jsonTokenAt ((          ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "main_window"+      jsonTokenAt ((     ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenString "width"+      jsonTokenAt ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonTokenNumber 500.0
+ test/HaskellWorks/Data/Json/SuccinctSpec.hs view
@@ -0,0 +1,34 @@+{-# 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")
+ test/HaskellWorks/Data/Succinct/BalancedParensSpec.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParensSpec where++import           Data.Maybe+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Succinct.BalancedParens+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParensSpec" $ do+  describe "For (()(()())) 1101101000" $ do+    let bs = SimpleBalancedParens (91 :: Word64)+    it "Test 1a" $ findClose bs  1 `shouldBe` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+  describe "For (()(()())) 1101101000" $ do+    let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool])+    it "Test 1a" $ findClose bs  1 `shouldBe` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 1b" $ findClose bs  3 `shouldBe`  3+    it "Test 1b" $ findClose bs  4 `shouldBe`  9+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+    it "firstChild 1" $ firstChild bs 1 `shouldBe` 2+    it "firstChild 4" $ firstChild bs 4 `shouldBe` 5+    it "nextSibling 2" $ nextSibling bs 2 `shouldBe` 4+    it "nextSibling 5" $ nextSibling bs 5 `shouldBe` 7+    it "parent 2" $ parent bs 2 `shouldBe` 1+    it "parent 5" $ parent bs 5 `shouldBe` 4+    it "depth  1" $ depth bs  1 `shouldBe` 1+    it "depth  2" $ depth bs  2 `shouldBe` 2+    it "depth  3" $ depth bs  3 `shouldBe` 2+    it "depth  4" $ depth bs  4 `shouldBe` 2+    it "depth  5" $ depth bs  5 `shouldBe` 3+    it "depth  6" $ depth bs  6 `shouldBe` 3+    it "depth  7" $ depth bs  7 `shouldBe` 3+    it "depth  8" $ depth bs  8 `shouldBe` 3+    it "depth  9" $ depth bs  9 `shouldBe` 2+    it "depth 10" $ depth bs 10 `shouldBe` 1+    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` 5+    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` 1+    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` 0+    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` 3+    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` 1+    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` 0+    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` 1+    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` 0+    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` 0+    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` 0+  describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do+    let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8)+    it "Test 1a" $ findClose bs  1 `shouldBe` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 1b" $ findClose bs  3 `shouldBe`  3+    it "Test 1b" $ findClose bs  4 `shouldBe`  9+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+    it "firstChild 1" $ firstChild bs 1 `shouldBe` 2+    it "firstChild 4" $ firstChild bs 4 `shouldBe` 5+    it "nextSibling 2" $ nextSibling bs 2 `shouldBe` 4+    it "nextSibling 5" $ nextSibling bs 5 `shouldBe` 7+    it "parent 2" $ parent bs 2 `shouldBe` 1+    it "parent 5" $ parent bs 5 `shouldBe` 4+    it "depth  1" $ depth bs  1 `shouldBe` 1+    it "depth  2" $ depth bs  2 `shouldBe` 2+    it "depth  3" $ depth bs  3 `shouldBe` 2+    it "depth  4" $ depth bs  4 `shouldBe` 2+    it "depth  5" $ depth bs  5 `shouldBe` 3+    it "depth  6" $ depth bs  6 `shouldBe` 3+    it "depth  7" $ depth bs  7 `shouldBe` 3+    it "depth  8" $ depth bs  8 `shouldBe` 3+    it "depth  9" $ depth bs  9 `shouldBe` 2+    it "depth 10" $ depth bs 10 `shouldBe` 1+    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` 5+    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` 1+    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` 0+    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` 3+    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` 1+    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` 0+    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` 1+    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` 0+    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` 0+    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` 0++-- 11011010 00000000, cursorRank = 2
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0Spec.hs view
@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec+  ( genRank0UpTo8Spec+  , genRank0UpTo16Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec+genRank0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank0 10010010 over [0..8] should be 001223445" $ do+    let bs = fromJust (bitRead "10010010") :: s+    fmap (rank0 bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]++genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec+genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank0 11011010 00000000 over [0..16]" $ do+    let bs = fromJust $ bitRead "11011010 00000000" :: s+    fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]+  it "rank0 11011010 10000000 over [0..16]" $ do+    let bs = fromJust $ bitRead "11011010 10000000" :: s+    fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genRank0UpTo8Spec (undefined :: Word8)+  genRank0UpTo8Spec (undefined :: Word16)+  genRank0UpTo8Spec (undefined :: Word32)+  genRank0UpTo8Spec (undefined :: Word64)+  genRank0UpTo8Spec (undefined :: [Word8])+  genRank0UpTo16Spec (undefined :: [Word8])+  genRank0UpTo8Spec (undefined :: [Word16])+  genRank0UpTo16Spec (undefined :: [Word16])+  genRank0UpTo8Spec (undefined :: [Word32])+  genRank0UpTo16Spec (undefined :: [Word32])+  genRank0UpTo8Spec (undefined :: [Word64])+  genRank0UpTo16Spec (undefined :: [Word64])+  genRank0UpTo8Spec (undefined :: DV.Vector Word8)+  genRank0UpTo16Spec (undefined :: DV.Vector Word8)+  genRank0UpTo8Spec (undefined :: DV.Vector Word16)+  genRank0UpTo16Spec (undefined :: DV.Vector Word16)+  genRank0UpTo8Spec (undefined :: DV.Vector Word32)+  genRank0UpTo16Spec (undefined :: DV.Vector Word32)+  genRank0UpTo8Spec (undefined :: DV.Vector Word64)+  genRank0UpTo16Spec (undefined :: DV.Vector Word64)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word8)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word8)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word16)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word16)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word32)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word32)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word64)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word64)+  describe "Different word sizes give the same rank0" $ do+    it "when comparing Word16 and Word64 over bits 0-7" $+      forAll (choose (0, 8 :: Count)) $ \(i :: Count) (w :: Word8) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word16 and Word64 over bits 0-15" $ property $+      forAll (choose (0, 16 :: Count)) $ \(i :: Count) (w :: Word16) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word32 and Word64 over bits 0-31" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word32 and Word64 over bits 32-64" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)+    it "when comparing select1 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->+        1 <= i && i <= popCount0 w ==>+          rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1Spec.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec+  ( genRank1UpTo8Spec+  , genRank1UpTo16Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank1 10010010 over [0..8] should be 011122233" $ do+    let bs = fromJust (bitRead "10010010") :: s+    fmap (rank1 bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]++genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank1 11011010 00000000 over [0..9]" $ do+    let bs = fromJust $ bitRead "11011010 00000000" :: s+    fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5]+  it "rank1 11011010 10000000 over [0..9]" $ do+    let bs = fromJust $ bitRead "11011010 10000000" :: s+    fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genRank1UpTo8Spec (undefined :: Word8)+  genRank1UpTo8Spec (undefined :: Word16)+  genRank1UpTo8Spec (undefined :: Word32)+  genRank1UpTo8Spec (undefined :: Word64)+  genRank1UpTo8Spec (undefined :: [Word8])+  genRank1UpTo16Spec (undefined :: [Word8])+  genRank1UpTo8Spec (undefined :: [Word16])+  genRank1UpTo16Spec (undefined :: [Word16])+  genRank1UpTo8Spec (undefined :: [Word32])+  genRank1UpTo16Spec (undefined :: [Word32])+  genRank1UpTo8Spec (undefined :: [Word64])+  genRank1UpTo16Spec (undefined :: [Word64])+  genRank1UpTo8Spec (undefined :: DV.Vector Word8)+  genRank1UpTo16Spec (undefined :: DV.Vector Word8)+  genRank1UpTo8Spec (undefined :: DV.Vector Word16)+  genRank1UpTo16Spec (undefined :: DV.Vector Word16)+  genRank1UpTo8Spec (undefined :: DV.Vector Word32)+  genRank1UpTo16Spec (undefined :: DV.Vector Word32)+  genRank1UpTo8Spec (undefined :: DV.Vector Word64)+  genRank1UpTo16Spec (undefined :: DV.Vector Word64)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word8)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word8)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word16)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word16)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word32)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word32)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word64)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word64)+  describe "For Word8-Word64" $ do+    it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank1 and select1 for Word64 form a galois connection" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>+        rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0Spec.hs view
@@ -0,0 +1,116 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec+  ( genSelect0UpTo8Spec+  , genSelect0UpTo16Spec+  , genSelect0UpTo32Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select0 10010010 over [0..5] should be 023568" $ do+    let bs = fromJust $ bitRead "10010010" :: Word8+    fmap (select0 bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]++genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select0 11011010 00 over [0..5]" $+    let bs = fromJust $ bitRead "1101101 000" :: [Bool] in+    fmap (select0 bs) [0..5] `shouldBe` [0, 3, 6, 8, 9, 10]+  it "select0 11011010 00000000 over [0..5]" $ do+    let bs = fromJust $ bitRead "11011010 00000000" :: Word32+    fmap (select0 bs) [0..11] `shouldBe` [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16]++genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $+    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in+    fmap (select0 bs) [0..19] `shouldBe` [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genSelect0UpTo8Spec  (undefined :: Word8)+  genSelect0UpTo8Spec  (undefined :: Word16)+  genSelect0UpTo8Spec  (undefined :: Word32)+  genSelect0UpTo8Spec  (undefined :: Word64)+  genSelect0UpTo16Spec (undefined :: Word16)+  genSelect0UpTo16Spec (undefined :: Word32)+  genSelect0UpTo16Spec (undefined :: Word64)+  genSelect0UpTo32Spec (undefined :: Word32)+  genSelect0UpTo32Spec (undefined :: Word64)+  genSelect0UpTo8Spec  (undefined :: [Bool])+  genSelect0UpTo16Spec (undefined :: [Bool])+  genSelect0UpTo32Spec (undefined :: [Bool])+  genSelect0UpTo8Spec  (undefined :: [Word8])+  genSelect0UpTo16Spec (undefined :: [Word8])+  genSelect0UpTo32Spec (undefined :: [Word8])+  genSelect0UpTo8Spec  (undefined :: [Word16])+  genSelect0UpTo16Spec (undefined :: [Word16])+  genSelect0UpTo32Spec (undefined :: [Word16])+  genSelect0UpTo8Spec  (undefined :: [Word32])+  genSelect0UpTo16Spec (undefined :: [Word32])+  genSelect0UpTo32Spec (undefined :: [Word32])+  genSelect0UpTo8Spec  (undefined :: [Word64])+  genSelect0UpTo16Spec (undefined :: [Word64])+  genSelect0UpTo32Spec (undefined :: [Word64])+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word8)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word8)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word8)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word16)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word16)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word16)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word32)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word32)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word32)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word64)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word64)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word64)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word8)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word8)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word8)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word16)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word16)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word16)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word32)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word32)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word32)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word64)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word64)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word64)+  describe "For Word8-Word64" $ do+    it "rank0 for Word16 and Word64 should give same answer for bits 0-7" $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word16 and Word64 should give same answer for bits 0-15" $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word32 and Word64 should give same answer for bits 0-31" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word32 and Word64 should give same answer for bits 32-64" $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank0 and select0 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount0 w ==>+        rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1Spec.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec+  ( genSelect1UpTo8Spec+  , genSelect1UpTo16Spec+  , genSelect1UpTo32Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select1 10010010 over [0..3] should be 0147" $ do+    let bs = fromJust $ bitRead "10010010" :: s+    fmap (select1 bs) [0..3] `shouldBe` [0, 1, 4, 7]++genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select1 11011010 00 over [0..5]" $+    let bs = fromJust $ bitRead "11011010 00" :: s in+    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]+  it "select1 11011010 00000000 over [0..5]" $ do+    let bs = fromJust $ bitRead "11011010 00000000" :: s+    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]+  it "select 01000000 00000100 over [0..2]" $ do+    let bs = fromJust $ bitRead "01000000 00000100" :: s+    fmap (select1 bs) [0..2] `shouldBe` [0, 2, 14]++genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $+    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in+    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 8, 9, 18]+  it "select 10000010 00000000 00100000 00010000 over [0..4]" $ do+    let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s+    fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genSelect1UpTo8Spec  (undefined :: Word8)+  genSelect1UpTo8Spec  (undefined :: Word16)+  genSelect1UpTo8Spec  (undefined :: Word32)+  genSelect1UpTo8Spec  (undefined :: Word64)+  genSelect1UpTo16Spec (undefined :: Word16)+  genSelect1UpTo16Spec (undefined :: Word32)+  genSelect1UpTo16Spec (undefined :: Word64)+  genSelect1UpTo32Spec (undefined :: Word32)+  genSelect1UpTo32Spec (undefined :: Word64)+  genSelect1UpTo8Spec  (undefined :: [Bool])+  genSelect1UpTo16Spec (undefined :: [Bool])+  genSelect1UpTo32Spec (undefined :: [Bool])+  genSelect1UpTo8Spec  (undefined :: [Word8])+  genSelect1UpTo16Spec (undefined :: [Word8])+  genSelect1UpTo32Spec (undefined :: [Word8])+  genSelect1UpTo8Spec  (undefined :: [Word16])+  genSelect1UpTo16Spec (undefined :: [Word16])+  genSelect1UpTo32Spec (undefined :: [Word16])+  genSelect1UpTo8Spec  (undefined :: [Word32])+  genSelect1UpTo16Spec (undefined :: [Word32])+  genSelect1UpTo32Spec (undefined :: [Word32])+  genSelect1UpTo8Spec  (undefined :: [Word64])+  genSelect1UpTo16Spec (undefined :: [Word64])+  genSelect1UpTo32Spec (undefined :: [Word64])+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word8)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word8)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word8)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word16)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word16)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word16)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word32)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word32)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word32)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word64)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word64)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word64)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word8)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word8)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word8)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word16)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word16)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word16)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word32)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word32)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word32)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word64)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word64)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word64)+  describe "For Word64" $ do+    it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ property $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ property $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank1 and select1 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>+        rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+  ( genBinaryRankSelectSpec+  ) where++import           Data.Typeable+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec   hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec   hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec hiding (spec)+import           Test.Hspec++genBinaryRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec+genBinaryRankSelectSpec s = describe "Generically" $ do+  genRank0UpTo8Spec     s+  genRank0UpTo16Spec    s+  genRank1UpTo8Spec     s+  genRank1UpTo16Spec    s+  genSelect0UpTo8Spec   s+  genSelect0UpTo16Spec  s+  genSelect0UpTo32Spec  s+  genSelect1UpTo8Spec   s+  genSelect1UpTo16Spec  s+  genSelect1UpTo32Spec  s
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs view
@@ -0,0 +1,130 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec (spec) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+  n   <- choose (a, b)+  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]+  return $ ShowVector (DVS.fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512.Rank1Spec" $ do+  genBinaryRankSelectSpec (undefined :: Poppy512)+  describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512 v in+      let i = 0 in+      rank1 v i === rank1 w i+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank1 v i === rank1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank1 v i === rank1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank1 v i === rank1 w i+  describe "rank0 for Vector Word64 is equivalent to rank0 for Poppy512" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512 v in+      let i = 0 in+      rank0 v i === rank0 w i+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank0 v i === rank0 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank0 v i === rank0 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512 v in+      rank0 v i === rank0 w i+  describe "select0 for Vector Word64 is equivalent to select0 for Poppy512" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512 v in+      let i = 0 in+      select0 v i === select0 w i+    it "on one full zero basic block" $+      let v = DVS.fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in+      let w = makePoppy512 v in+      select0 v 0 === select0 w 0+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, popCount0 v)) $ \i ->+      let w = makePoppy512 v in+      select0 v i === select0 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, popCount0 v)) $ \i ->+      let w = makePoppy512 v in+      select0 v i === select0 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, popCount0 v)) $ \i ->+      let w = makePoppy512 v in+      select0 v i === select0 w i+  describe "select1 for Vector Word64 is equivalent to select1 for Poppy512" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512 v in+      let i = 0 in+      select1 v i === select1 w i+    it "on one full zero basic block" $+      let v = DVS.fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in+      let w = makePoppy512 v in+      select1 v 0 === select1 w 0+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512 v in+      select1 v i === select1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512 v in+      select1 v i === select1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512 v in+      select1 v i === select1 w i
+ test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.InternalSpec (spec) where++import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Internal+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  describe "For [Bool]" $ do+    it "rank True 10010010 over [0..8] should be 011122233" $+      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in+      fmap (rank True bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]+    it "rank True 10010010 over [0..8] should be 001223445" $+      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in+      fmap (rank False bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]+    it "select True 10010010 over [0..3] should be 0147" $+      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in+      fmap (select True bs) [0..3] `shouldBe` [0, 1, 4, 7]+    it "select False 10010010 over [0..5] should be 023568" $+      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in+      fmap (select False bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]+    it "Rank and select form a galois connection" $+      property $ \(bs :: [Bool]) ->+      forAll (choose (0, popCount1 bs)) $ \(c :: Count) ->+        rank True bs (select True bs c) == c
+ test/HaskellWorks/Data/Succinct/SimpleSpec.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.SimpleSpec (spec) where++import           Data.Vector+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.SuccinctSpec" $ do+  it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $+    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word8) (b :: Word8) (c :: Word8) (d :: Word8)+                                            (e :: Word8) (f :: Word8) (g :: Word8) (h :: Word8) ->+      let a64 = fromIntegral a :: Word64 in+      let b64 = fromIntegral b :: Word64 in+      let c64 = fromIntegral c :: Word64 in+      let d64 = fromIntegral d :: Word64 in+      let e64 = fromIntegral e :: Word64 in+      let f64 = fromIntegral f :: Word64 in+      let g64 = fromIntegral g :: Word64 in+      let h64 = fromIntegral h :: Word64 in+      let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|.+                       (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|.  a64              in+      let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 )             in+      let vec64 = BitShown (fromList [abcdefgh64]             :: Vector Word64)             in+      rank1 vec16 i == rank1 vec64 i+  it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $+    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word16) (b :: Word16) (c :: Word16) (d :: Word16) ->+      let a64 = fromIntegral a :: Word64 in+      let b64 = fromIntegral b :: Word64 in+      let c64 = fromIntegral c :: Word64 in+      let d64 = fromIntegral d :: Word64 in+      let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64 in+      let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16) in+      let vec64 = BitShown (fromList [abcd64]     :: Vector Word64) in+      rank1 vec16 i == rank1 vec64 i+  it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $+    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word32) (b :: Word32) ->+      let a64 = fromIntegral a :: Word64 in+      let b64 = fromIntegral b :: Word64 in+      let ab64 = (b64 .<. 32) .|. a64 in+      let vec32 = BitShown (fromList [a, b] :: Vector Word32) in+      let vec64 = BitShown (fromList [ab64] :: Vector Word64) in+      rank1 vec32 i == rank1 vec64 i
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}