hw-packed-vector 0.0.0.3 → 0.1.0.0

raw patch · 7 files changed

+203/−2 lines, 7 filesdep +binarydep +generic-lensdep +lensnew-component:exe:hw-packed-vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, generic-lens, lens, optparse-applicative, semigroups

API changes (from Hackage documentation)

Files

• app/App/Commands.hs +13/−0
• app/App/Commands/CreateIndex.hs +75/−0
• app/App/Commands/Types.hs +15/−0
• app/Main.hs +11/−0
• hw-packed-vector.cabal +28/−1
• src/HaskellWorks/Data/PackedVector/IO.hs +15/−0
• src/HaskellWorks/Data/PackedVector/PackedVector64.hs +46/−1

@@ -0,0 +1,13 @@+module App.Commands where++import App.Commands.CreateIndex+import Data.Semigroup           ((<>))+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+  <>  commandGroup "Commands:"+  <>  cmdCreateIndex

@@ -0,0 +1,75 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.CreateIndex+  ( cmdCreateIndex+  ) where++import Control.Lens+import Control.Monad+import Data.Generics.Product.Any+import Data.Semigroup            ((<>))+import Data.Word+import Options.Applicative       hiding (columns)++import qualified App.Commands.Types                            as Z+import qualified Data.Binary.Get                               as G+import qualified Data.ByteString.Lazy                          as LBS+import qualified HaskellWorks.Data.PackedVector.PackedVector64 as PV+import qualified System.Exit                                   as IO+import qualified System.IO                                     as IO++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++decodeWord32s :: LBS.ByteString -> [Word32]+decodeWord32s = fmap (G.runGet G.getWord32le) . go+  where go :: LBS.ByteString -> [LBS.ByteString]+        go lbs = case LBS.splitAt 4 lbs of+          (lt, rt) -> if LBS.length lt == 4+            then lt:go rt+            else if LBS.length lt == 0+              then []+              else [LBS.take 4 (lt <> LBS.replicate 4 0)]++runCreateIndex :: Z.CreateIndexOptions -> IO ()+runCreateIndex opts = do+  let wordSize = opts ^. the @"wordSize"++  IO.withBinaryFile (opts ^. the @"input") IO.ReadMode $ \hIn -> do+    inSize <- IO.hFileSize hIn++    when (inSize `mod` 4 /= 0) $ do+      IO.hPutStrLn IO.stderr "Input file should have size multiple of 4-bytes"+      IO.exitFailure++    lbs <- LBS.hGetContents hIn++    let ws = fmap fromIntegral (decodeWord32s lbs) :: [Word64]++    PV.createFileIndex (opts ^. the @"output") wordSize (fromIntegral inSize) ws++optsCreateIndex :: Parser Z.CreateIndexOptions+optsCreateIndex = Z.CreateIndexOptions+  <$> option auto+        (   long "word-size"+        <>  short 'n'+        <>  help "Size of each word in the packed vector.  Must be between 1 and 64"+        <>  metavar "BIT_COUNT"+        )+  <*> strOption+        (   long "input"+        <>  short 'i'+        <>  help "Input file of integers to pack"+        <>  metavar "FILE"+        )+  <*> strOption+        (   long "output"+        <>  short 'o'+        <>  help "Output file"+        <>  metavar "FILE"+        )++cmdCreateIndex :: Mod CommandFields (IO ())+cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex

@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Types+  ( CreateIndexOptions(..)+  ) where++import GHC.Generics+import HaskellWorks.Data.Positioning++data CreateIndexOptions = CreateIndexOptions+  { wordSize :: Count+  , input    :: FilePath+  , output   :: FilePath+  } deriving (Eq, Show, Generic)

@@ -0,0 +1,11 @@+module Main where++import App.Commands+import Control.Monad+import Data.Semigroup      ((<>))+import Options.Applicative++main :: IO ()+main = join $ customExecParser+  (prefs $ showHelpOnEmpty <> showHelpOnError)+  (info (commands <**> helper) idm)

@@ -1,7 +1,7 @@ cabal-version:      2.2  name:               hw-packed-vector-version:            0.0.0.3+version:            0.1.0.0 synopsis:           Packed Vector description:        Packed Vector. Please see README.md category:           Data, Vector@@ -23,18 +23,24 @@  common base                 { build-depends: base                 >= 4          && < 5      } +common binary               { build-depends: binary               >= 0.8        && < 0.9    } common bytestring           { build-depends: bytestring           >= 0.10.8.2   && < 0.11   } common criterion            { build-depends: criterion            >= 1.4.1.0    && < 1.6    } common deepseq              { build-depends: deepseq              >= 1.4        && < 1.5    } common directory            { build-depends: directory            >= 1.3        && < 1.4    }+common generic-lens         { build-depends: generic-lens         >= 1.1.0.0    && < 1.2    } common hedgehog             { build-depends: hedgehog             >= 0.6        && < 1.1    } common hspec                { build-depends: hspec                >= 2.7.1      && < 3      } common hw-bits              { build-depends: hw-bits              >= 0.7.0.6    && < 0.8    } common hw-hedgehog          { build-depends: hw-hedgehog          >= 0.1.0.3    && < 0.2    } common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1.0.7    && < 0.2    } common hw-prim              { build-depends: hw-prim              >= 0.6.2.27   && < 0.7    }+common lens                 { build-depends: lens                 >= 4          && < 5      }+common optparse-applicative { build-depends: optparse-applicative >= 0.14       && < 0.15   } common vector               { build-depends: vector               >= 0.12.0.3   && < 0.13   } +common semigroups   { if impl(ghc <  8    ) { build-depends: semigroups     >= 0.16     && < 0.19 } }+ common config   default-language: Haskell2010   ghc-options:      -Wall -O2 -msse4.2@@ -49,10 +55,31 @@   exposed-modules:     HaskellWorks.Data.PackedVector     HaskellWorks.Data.PackedVector.Internal+    HaskellWorks.Data.PackedVector.IO     HaskellWorks.Data.PackedVector.PackedVector64   other-modules:    Paths_hw_packed_vector   autogen-modules:  Paths_hw_packed_vector   hs-source-dirs:   src++executable hw-packed-vector+  import:   base, config+          , binary+          , bytestring+          , generic-lens+          , hw-bits+          , hw-prim+          , lens+          , optparse-applicative+          , semigroups+          , vector+  main-is:          Main.hs+  hs-source-dirs:   app+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:    hw-packed-vector+  other-modules:+      App.Commands+      App.Commands.CreateIndex+      App.Commands.Types  test-suite hw-packed-vector-test   import:   base, config

@@ -0,0 +1,15 @@+module HaskellWorks.Data.PackedVector.IO+  ( -- writeAsPackedVector+  ) where++-- import Data.Word++-- import qualified Data.ByteString.Builder as B+-- import qualified Data.ByteString.Lazy    as LBS+-- import qualified Data.Vector.Storable    as DVS+-- import qualified System.IO               as IO++-- writeVector32AsPackedVector :: IO.Handle -> Int -> DVS.Vector Word32 -> IO Int+-- writeVector32AsPackedVector hOut bitSize v = go 0 0+--   where go :: Int -> IO Int+--         go written n | n >= DVS.length v = return written

@@ -7,10 +7,12 @@   , fromList   , fromListN   , toList+  , createFileIndex   ) where  import Control.DeepSeq import Data.Int+import Data.Semigroup                          ((<>)) import Data.Word import GHC.Generics import HaskellWorks.Data.AtIndex@@ -21,7 +23,10 @@ import HaskellWorks.Data.Unsign import Prelude                                 hiding (length) -import qualified Data.Vector.Storable as DVS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy    as LBS+import qualified Data.Vector.Storable    as DVS+import qualified System.IO               as IO  data PackedVector64 = PackedVector64   { swBuffer    :: !(DVS.Vector Word64)@@ -81,3 +86,43 @@  toList :: PackedVector64 -> [Word64] toList v = unpackBits (swBufferLen v) (fromIntegral (swBitSize v)) (DVS.toList (swBuffer v))++encodePacked :: Count -> [Word64] -> B.Builder+encodePacked wordSize = go 0 0+  where go :: Count -> Word64 -> [Word64] -> B.Builder+        go 0           _   [] = mempty+        go _           acc [] = B.word64LE acc+        go bitsWritten acc (w:ws) =+          let totalBits   = bitsWritten + wordSize+              excessBits  = totalBits - 64+              newAcc      = (w .<. bitsWritten) .|. acc+          in if totalBits >= 64+            then B.word64LE newAcc <>             go excessBits (w .>. (wordSize - excessBits))     ws+            else let freeBits = 64 - totalBits in go totalBits  (newAcc .<. freeBits .>. freeBits)  ws++createFileIndex :: FilePath -> Count -> Count -> [Word64] -> IO ()+createFileIndex filename wordSize inSize ws = IO.withBinaryFile filename IO.WriteMode $ \hOut -> do+  headerPos <- IO.hTell hOut++  B.hPutBuilder hOut $ mempty+    <> B.word64LE wordSize              -- Number of bits in a packed word+    <> B.word64LE (fromIntegral inSize) -- Number of entries+    <> B.word64LE 0                     -- Number of bytes in packed vector++  startPos <- IO.hTell hOut++  -- TODO Write packed vector instead+  LBS.hPut hOut (B.toLazyByteString (encodePacked wordSize ws))++  endPos <- IO.hTell hOut++  let vBytes = endPos - startPos++  IO.hSeek hOut IO.AbsoluteSeek headerPos++  B.hPutBuilder hOut $ mempty+    <> B.word64LE wordSize              -- Number of bits in a packed word+    <> B.word64LE (fromIntegral inSize) -- Number of entries+    <> B.word64LE (fromIntegral vBytes) -- Number of bytes in packed vector++  IO.hSeek hOut IO.AbsoluteSeek endPos