diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -7,39 +7,45 @@ This library will use support for some BMI2 or AVX2 CPU instructions on some x86 based CPUs if compiled with the appropriate flags on `ghc-8.4.1` or later. -## Compilation +## Compilation & Installation Pre-requisites: -* Install [Haskell Stack](https://docs.haskellstack.org/en/stable/README/) +* `cabal-install-3.0.0.0` +* `ghc-8.4.4` or higher It is sufficient to build, test and benchmark the library as follows for basic performance. The library will be compiled to use broadword implementation of rank & select, which has reasonable performance. -```text -stack build -stack test -stack bench +```bash +cabal v2-configure --enable-tests --enable-benchmarks --disable-documentation +cabal v2-build +cabal v2-test +cabal v2-bench +cabal v2-install --overwrite-policy=always --installdir="$HOME/.local/bin" ``` -For best performance, add the `bmi2` and `avx2` flag to target the BMI2 and AVS2 instruction sets: +Ensure that `$HOME/.local/bin` is in your path if you are using intending to +use the `hw-dsv` binary. -```text -stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 -stack test --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 -stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +For best performance, add the `bmi2` and `avx2` flags to target the BMI2 and +AVS2 instruction are specified in the `cabal.project` file. + +For slightly older CPUs, remove `avx2` flags from the `cabal.project` file to +target only the BMI2 instruction set. + +### Stack support + +It should be possible to install `hw-dsv` via stack: + +```bash stack install --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 ``` -For slightly older CPUs, add only the `bmi2` flag to target the BMI2 instruction set: +Although your mileage may vary depending on which snapshot you are using. -```text -stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 -stack test --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 -stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 -stack install --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 -``` +The flags should be adjusted for the CPU you are targetting. ## Benchmark results @@ -50,24 +56,21 @@ With BMI2 disabled: -```text -$ stack install +```bash $ cat 7g.csv | pv -t -e -b -a | hw-dsv query-lazy -k 1 -k 2 -d , -e '|' > /dev/null 7.08GiB 0:07:25 [16.3MiB/s] ``` With BMI2 and AVX2 enabled: -```text -$ stack install --flag bits-extra:bmi2 --flag hw-bits:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +```bash $ cat 7gb.csv | pv -t -e -b -a | hw-dsv query-lazy -k 1 -k 2 -d , -e '|' > /dev/null 7.08GiB 0:00:39 [ 181MiB/s] ``` With only BMI2 enabled: -```text -$ stack install --flag bits-extra:bmi2 --flag hw-bits:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 +```bash $ cat 7gb.csv | pv -t -e -b -a | hw-dsv query-lazy -k 1 -k 2 -d , -e '|' > /dev/null 7.08GiB 0:00:43 [ 165MiB/s] ``` diff --git a/app/App/Commands.hs b/app/App/Commands.hs --- a/app/App/Commands.hs +++ b/app/App/Commands.hs @@ -5,6 +5,7 @@ import App.Commands.IndexWord8s import App.Commands.QueryLazy import App.Commands.QueryStrict +import App.Commands.RangeJoin import Data.Semigroup ((<>)) import Options.Applicative @@ -17,6 +18,7 @@ <> cmdCreateIndex <> cmdQueryLazy <> cmdQueryStrict + <> cmdRangeJoin commandsDebugging :: Parser (IO ()) commandsDebugging = subparser $ mempty diff --git a/app/App/Commands/Options/Parse.hs b/app/App/Commands/Options/Parse.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/Options/Parse.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Options.Parse + ( nonZeroOneBased + , columnDesc + , rangeJoinColumn + ) where + +import Data.Semigroup ((<>)) +import Data.Text +import Options.Applicative +import Text.Read (readEither) + +import qualified App.Data.ColumnDesc as Z +import qualified App.Data.List as L +import qualified App.Data.RangeJoinColumn as Z +import qualified Data.Text as T + +nonZeroOneBased :: Mod OptionFields Int -> Parser Int +nonZeroOneBased = option $ eitherReader $ \s -> do + a <- readEither s + if a == 0 + then Left "cannot index column 0" + else Right (a - 1) + +columnDesc :: Mod OptionFields (Z.ColumnDesc Text) -> Parser (Z.ColumnDesc Text) +columnDesc = option $ eitherReader $ \s -> do + case L.splitOn ':' s of + [iString, f] -> do + i <- readEither iString + if i == 0 + then Left "cannot index column 0" + else Right (Z.ColumnDesc (i - 1) (T.pack f)) + [iString] -> do + i <- readEither iString + if i == 0 + then Left "cannot index column 0" + else Right (Z.ColumnDesc (i - 1) "id") + _ -> Left $ "invalid column description " <> show s + +rangeJoinColumn :: Mod OptionFields Z.RangeJoinColumn -> Parser Z.RangeJoinColumn +rangeJoinColumn = option $ eitherReader $ \s -> case s of + ('L':rs) -> do + i <- readEither rs + if i == 0 + then Left "cannot index column 0" + else Right (Z.LtColumn (i - 1)) + ('R':rs) -> do + i <- readEither rs + if i == 0 + then Left "cannot index column 0" + else Right (Z.RtColumn (i - 1)) + _ -> Left $ "invalid range-join column: " <> show s diff --git a/app/App/Commands/Options/Type.hs b/app/App/Commands/Options/Type.hs --- a/app/App/Commands/Options/Type.hs +++ b/app/App/Commands/Options/Type.hs @@ -3,8 +3,11 @@ module App.Commands.Options.Type where +import App.Data.ColumnDesc +import App.Data.RangeJoinColumn +import Data.Text (Text) import GHC.Generics -import GHC.Word (Word8) +import GHC.Word (Word8) data CreateIndexOptions = CreateIndexOptions { filePath :: FilePath @@ -38,10 +41,25 @@ } deriving (Eq, Show, Generic) data QueryLazyOptions = QueryLazyOptions - { columns :: [Int] + { columns :: [ColumnDesc Text] , filePath :: FilePath , outputFilePath :: FilePath , delimiter :: Word8 , outDelimiter :: Word8 , method :: String + } deriving (Eq, Show, Generic) + +data RangeJoinOptions = RangeJoinOptions + { input1FilePath :: FilePath + , input1Delimiter :: Word8 + , input1StartColumn :: Int + , input1StopColumn :: Int + , input2FilePath :: FilePath + , input2Delimiter :: Word8 + , input2StartColumn :: Int + , input2StopColumn :: Int + , columns :: [RangeJoinColumn] + , rangeType :: Text + , outputFilePath :: FilePath + , outputDelimiter :: Word8 } deriving (Eq, Show, Generic) diff --git a/app/App/Commands/QueryLazy.hs b/app/App/Commands/QueryLazy.hs --- a/app/App/Commands/QueryLazy.hs +++ b/app/App/Commands/QueryLazy.hs @@ -9,6 +9,7 @@ ) where import App.Char +import App.Commands.Options.Parse import Control.Applicative import Control.Lens import Control.Monad @@ -18,9 +19,9 @@ import Data.List import Data.Semigroup ((<>)) import Options.Applicative hiding (columns) -import Text.Read (readEither) import qualified App.Commands.Options.Type as Z +import qualified App.Data.ColumnDesc as Z import qualified App.IO as IO import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B @@ -55,7 +56,7 @@ runResourceT $ do (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing forM_ rows $ \row -> do - let fieldStrings = columnToFieldString row <$> (opts ^. the @"columns") + let fieldStrings = columnToFieldString row <$> (opts ^.. the @"columns" . each . the @"number") liftIO $ B.hPutBuilder hOut $ mconcat (intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 @@ -77,7 +78,7 @@ runResourceT $ do (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing forM_ rows $ \row -> do - let fieldStrings = columnToFieldString row <$> (opts ^. the @"columns") + let fieldStrings = columnToFieldString row <$> (opts ^.. the @"columns" . each . the @"number") liftIO $ B.hPutBuilder hOut $ mconcat (intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 @@ -93,8 +94,8 @@ !bs <- IO.readInputFile (opts ^. the @"filePath") let !c = SVL.makeCursor (opts ^. the @"delimiter") bs - let !sel = opts ^. the @"columns" - let !rows = SVLL.selectListVector sel c + let !sel = opts ^. the @"columns" <&> Z.realiseColumnDescLazy <&> Z.columnDescToTuple + let !rows = SVLL.mapSelectListList sel c let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter") runResourceT $ do @@ -110,17 +111,10 @@ cmdQueryLazy :: Mod CommandFields (IO ()) cmdQueryLazy = command "query-lazy" $ flip info idm $ runQueryLazy <$> optsQueryLazy -nonZeroOneBased :: Mod OptionFields Int -> Parser Int -nonZeroOneBased = option $ eitherReader $ \s -> do - a <- readEither s - if a == 0 - then Left "cannot index column 0" - else Right (a - 1) - optsQueryLazy :: Parser Z.QueryLazyOptions optsQueryLazy = Z.QueryLazyOptions <$> many - ( nonZeroOneBased + ( columnDesc ( long "column" <> short 'k' <> help "Column to select" diff --git a/app/App/Commands/QueryStrict.hs b/app/App/Commands/QueryStrict.hs --- a/app/App/Commands/QueryStrict.hs +++ b/app/App/Commands/QueryStrict.hs @@ -9,6 +9,7 @@ ) where import App.Char +import App.Commands.Options.Parse import Control.Applicative import Control.Lens import Control.Monad @@ -18,7 +19,6 @@ import Data.List import Data.Semigroup ((<>)) import Options.Applicative -import Text.Read (readEither) import qualified App.Commands.Options.Type as Z import qualified App.IO as IO @@ -54,13 +54,6 @@ cmdQueryStrict :: Mod CommandFields (IO ()) cmdQueryStrict = command "query-strict" $ flip info idm $ runQueryStrict <$> optsQueryStrict - -nonZeroOneBased :: Mod OptionFields Int -> Parser Int -nonZeroOneBased = option $ eitherReader $ \s -> do - a <- readEither s - if a == 0 - then Left "cannot index column 0" - else Right (a - 1) optsQueryStrict :: Parser Z.QueryStrictOptions optsQueryStrict = Z.QueryStrictOptions diff --git a/app/App/Commands/RangeJoin.hs b/app/App/Commands/RangeJoin.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/RangeJoin.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +module App.Commands.RangeJoin + ( cmdRangeJoin + ) where + +import App.Char +import App.Commands.Options.Parse +import Control.Lens +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource +import Data.Generics.Product.Any +import Data.List +import Data.Maybe (catMaybes) +import Data.Semigroup ((<>)) +import Data.Word +import Options.Applicative hiding (columns) +import Text.Read (readMaybe) + +import qualified App.Commands.Options.Type as Z +import qualified App.Data.RangeJoinColumn as Z +import qualified App.IO as IO +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Vector as DV +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor.Lazy as SVLL + +rangeJoin :: (DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString]) + -> Int -> Int -> [DV.Vector LBS.ByteString] -> Int -> Int -> [DV.Vector LBS.ByteString] -> [[LBS.ByteString]] +rangeJoin f aa az as ba bz bs = rangeJoin' f (catMaybes (fmap (mkEntry aa az) as)) (catMaybes (fmap (mkEntry ba bz) bs)) + +mkEntry :: Int -> Int -> DV.Vector LBS.ByteString -> Maybe (Word32, Word32, DV.Vector LBS.ByteString) +mkEntry a z v = (,, v) <$> lookupWord32 a v <*> lookupWord32 z v + +lookupWord32 :: Int -> DV.Vector LBS.ByteString -> Maybe Word32 +lookupWord32 i v = do + lbs <- v DV.!? i + let s = T.unpack (T.decodeUtf8 (LBS.toStrict lbs)) + readMaybe s + +rangeJoin' :: (DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString]) + -> [(Word32, Word32, DV.Vector LBS.ByteString)] -> [(Word32, Word32, DV.Vector LBS.ByteString)] -> [[LBS.ByteString]] +rangeJoin' f ((ua, uz, u):us) ((va, vz, v):vs) = if + | uz < va -> ("L":encodeWord32 ua:encodeWord32 uz :f u e):rangeJoin' f us ((va , vz, v):vs) + | vz < ua -> ("R":encodeWord32 va:encodeWord32 vz :f e v):rangeJoin' f ((ua , uz, u):us) ( vs) + | ua < va -> ("L":encodeWord32 ua:encodeWord32 (va - 1):f u e):rangeJoin' f ((va , uz, u):us) ((va , vz, v):vs) + | va < ua -> ("R":encodeWord32 va:encodeWord32 (ua - 1):f e v):rangeJoin' f ((ua , uz, u):us) ((ua , vz, v):vs) + | uz < vz -> ("B":encodeWord32 ua:encodeWord32 uz :f u v):rangeJoin' f us ((uz + 1, vz, v):vs) + | vz < uz -> ("B":encodeWord32 va:encodeWord32 vz :f u v):rangeJoin' f ((vz + 1, uz, u):us) vs + | otherwise -> ("B":encodeWord32 va:encodeWord32 vz :f u v):rangeJoin' f us vs + where e = DV.empty +rangeJoin' f ((ua, uz, _):us) [] = ("L":encodeWord32 ua:encodeWord32 uz:[]):rangeJoin' f us [] +rangeJoin' f [] ((va, vz, _):vs) = ("R":encodeWord32 va:encodeWord32 vz:[]):rangeJoin' f [] vs +rangeJoin' _ [] [] = [] + +encodeWord32 :: Word32 -> LBS.ByteString +encodeWord32 = LBS.fromStrict . T.encodeUtf8 . T.pack . show + +mkColumnSelector :: [Z.RangeJoinColumn] -> DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString] +mkColumnSelector [] _ _ = [] +mkColumnSelector (c:cs) u v = case c of + Z.LtColumn n -> (maybe "" id (u DV.!? n)):mkColumnSelector cs u v + Z.RtColumn n -> (maybe "" id (v DV.!? n)):mkColumnSelector cs u v + +runRangeJoin :: Z.RangeJoinOptions -> IO () +runRangeJoin opts = do + let input1Delimiter = opts ^. the @"input1Delimiter" + let input1FilePath = opts ^. the @"input1FilePath" + let input1StartColumn = opts ^. the @"input1StartColumn" + let input1StopColumn = opts ^. the @"input1StopColumn" + let input2Delimiter = opts ^. the @"input2Delimiter" + let input2FilePath = opts ^. the @"input2FilePath" + let input2StartColumn = opts ^. the @"input2StartColumn" + let input2StopColumn = opts ^. the @"input2StopColumn" + let columns = opts ^. the @"columns" + let rangeType = opts ^. the @"rangeType" + let outputFilePath = opts ^. the @"outputFilePath" + let outputDelimiter = opts ^. the @"outputDelimiter" + + !rows1 <- SVLL.toListVector . SVL.makeCursor input1Delimiter <$> IO.readInputFile input1FilePath + !rows2 <- SVLL.toListVector . SVL.makeCursor input2Delimiter <$> IO.readInputFile input2FilePath + + let !outDelimiterBuilder = B.word8 outputDelimiter + let !outNewlineBuilder = B.word8 10 + let !columnSelector = mkColumnSelector columns + + runResourceT $ do + (_, hOut) <- IO.openOutputFile outputFilePath Nothing + let outLbsss = rangeJoin columnSelector input1StartColumn input1StopColumn rows1 input2StartColumn input2StopColumn rows2 + let outBss = fmap (fmap B.lazyByteString) outLbsss + let outB = mconcat (intersperse outNewlineBuilder (fmap (mconcat . intersperse outDelimiterBuilder) outBss)) + liftIO $ B.hPutBuilder hOut outB + return () + +cmdRangeJoin :: Mod CommandFields (IO ()) +cmdRangeJoin = command "range-join" $ flip info idm $ runRangeJoin <$> optsRangeJoin + +optsRangeJoin :: Parser Z.RangeJoinOptions +optsRangeJoin = Z.RangeJoinOptions + <$> strOption + ( long "input1" + <> help "Input DSV file 1" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "input1-delimiter" + <> help "DSV delimiter to use for input1" + <> metavar "CHAR" + ) + <*> nonZeroOneBased + ( long "input1-start-column" + <> short 'k' + <> help "Column to use as start column from 1" + <> metavar "COLUMN INDEX" + ) + <*> nonZeroOneBased + ( long "input1-stop-column" + <> short 'k' + <> help "Column to use as stop column from 1" + <> metavar "COLUMN INDEX" + ) + <*> strOption + ( long "input2" + <> help "Input DSV file 2" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "input2-delimiter" + <> help "DSV delimiter to use for input2" + <> metavar "CHAR" + ) + <*> nonZeroOneBased + ( long "input2-start-column" + <> short 'k' + <> help "Column to use as start column from 2" + <> metavar "COLUMN INDEX" + ) + <*> nonZeroOneBased + ( long "input2-stop-column" + <> short 'k' + <> help "Column to use as stop column from 2" + <> metavar "COLUMN INDEX" + ) + <*> many + ( rangeJoinColumn + ( long "column" + <> short 'k' + <> help "Range join colum" + <> metavar "RANGE_JOIN_COLUMN" + ) + ) + <*> strOption + ( long "range-type" + <> short 'r' + <> help "Range type" + <> metavar "RANGE_TYPE" + ) + <*> strOption + ( long "output" + <> short 'o' + <> help "Output DSV file" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "output-delimiter" + <> short 'e' + <> help "DSV delimiter to write in the output" + <> metavar "CHAR" + ) diff --git a/app/App/Data/ColumnDesc.hs b/app/App/Data/ColumnDesc.hs new file mode 100644 --- /dev/null +++ b/app/App/Data/ColumnDesc.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module App.Data.ColumnDesc + ( ColumnDesc(..) + , realiseColumnDescLazy + , realiseColumnDescStrict + , columnDescToTuple + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Text +import GHC.Generics + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IPv4 +import qualified Text.Appar.String as TAS + +data ColumnDesc a = ColumnDesc + { number :: Int + , conversion :: a + } deriving (Eq, Show, Generic, Functor) + +ipv4ToWord32 :: LBS.ByteString -> LBS.ByteString +ipv4ToWord32 lbs = case TAS.parse IPv4.parseIpAddress (T.unpack (T.decodeUtf8 (LBS.toStrict lbs))) of + Just ipv4Address -> LBS.fromStrict (T.encodeUtf8 (T.pack (show (ipv4Address ^. the @"word")))) + Nothing -> lbs + +realiseColumnDescLazy :: ColumnDesc Text -> ColumnDesc (LBS.ByteString -> LBS.ByteString) +realiseColumnDescLazy cd = fmap realise cd + where realise :: Text -> LBS.ByteString -> LBS.ByteString + realise t = case t of + "id" -> id + "ipv4-to-word32" -> ipv4ToWord32 + _ -> const "BAD" + +realiseColumnDescStrict :: ColumnDesc Text -> ColumnDesc (BS.ByteString -> BS.ByteString) +realiseColumnDescStrict cd = fmap (\f -> LBS.toStrict . f . LBS.fromStrict) (realiseColumnDescLazy cd) + +columnDescToTuple :: ColumnDesc a -> (Int, a) +columnDescToTuple cd = (cd ^. the @1, cd ^. the @2) diff --git a/app/App/Data/List.hs b/app/App/Data/List.hs new file mode 100644 --- /dev/null +++ b/app/App/Data/List.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TupleSections #-} + +module App.Data.List + ( splitOn + ) where + +splitOn :: Eq a => a -> [a] -> [[a]] +splitOn _ [] = [] +splitOn a xs = cons $ case break (== a) xs of + (l, ys) -> (l, ) $ case ys of + [] -> [] + _:zs -> splitOn a zs + where cons ~(h, t) = h : t diff --git a/app/App/Data/RangeJoinColumn.hs b/app/App/Data/RangeJoinColumn.hs new file mode 100644 --- /dev/null +++ b/app/App/Data/RangeJoinColumn.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} + +module App.Data.RangeJoinColumn + ( RangeJoinColumn(..) + ) where + +import GHC.Generics + +data RangeJoinColumn = LtColumn Int | RtColumn Int + deriving (Eq, Show, Generic) diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif diff --git a/hw-dsv.cabal b/hw-dsv.cabal --- a/hw-dsv.cabal +++ b/hw-dsv.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-dsv -version: 0.3.7 +version: 0.3.8 synopsis: Unbelievably fast streaming DSV file parser description: Please see the README on Github at category: Text, CSV, SIMD, Succinct Data Structures, Data Structures @@ -37,34 +37,37 @@ manual: False default: True -common base { build-depends: base >= 4.7 && < 5 } +common base { build-depends: base >= 4.7 && < 5 } -common bits-extra { build-depends: bits-extra >= 0.0.1.2 && < 0.1 } -common bytestring { build-depends: bytestring >= 0.10 && < 0.11 } -common cassava { build-depends: cassava >= 0.5.1.0 && < 0.6 } -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.2.2 && < 1.4 } -common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 1.3 } -common ghc-prim { build-depends: ghc-prim >= 0.4 && < 0.6 } -common hedgehog { build-depends: hedgehog >= 0.5 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 3 } -common hw-bits { build-depends: hw-bits >= 0.7.0.2 && < 0.8 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } -common hw-prim { build-depends: hw-prim >= 0.6.2.14 && < 0.7 } -common hw-rankselect { build-depends: hw-rankselect >= 0.12.0.2 && < 0.14 } -common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.0 && < 0.4 } -common hw-simd { build-depends: hw-simd >= 0.1.1.3 && < 0.2 } -common lens { build-depends: lens >= 4.15 && < 5 } -common mmap { build-depends: mmap >= 0.5.9 && < 0.6 } -common optparse-applicative { build-depends: optparse-applicative >= 0.13 && < 0.16 } -common resourcet { build-depends: resourcet >= 1.1 && < 1.3 } -common text { build-depends: text >= 1.2.2 && < 2.0 } -common vector { build-depends: vector >= 0.12.0.1 && < 0.13 } -common weigh { build-depends: weigh >= 0.0.6 && < 0.1 } +common appar { build-depends: appar >= 0.1.8 && < 0.2 } +common bits-extra { build-depends: bits-extra >= 0.0.1.2 && < 0.1 } +common bytestring { build-depends: bytestring >= 0.10 && < 0.11 } +common cassava { build-depends: cassava >= 0.5.1.0 && < 0.6 } +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.2.2 && < 1.4 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 }common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 1.3 } +common ghc-prim { build-depends: ghc-prim >= 0.4 && < 0.6 } +common hedgehog { build-depends: hedgehog >= 0.5 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-bits { build-depends: hw-bits >= 0.7.0.2 && < 0.8 } +common hw-ip { build-depends: hw-ip >= 2.3.4.2 && < 2.4 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-prim { build-depends: hw-prim >= 0.6.2.14 && < 0.7 } +common hw-rankselect { build-depends: hw-rankselect >= 0.12.0.2 && < 0.14 } +common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.0 && < 0.4 } +common hw-simd { build-depends: hw-simd >= 0.1.1.3 && < 0.2 } +common lens { build-depends: lens >= 4.15 && < 5 } +common mmap { build-depends: mmap >= 0.5.9 && < 0.6 } +common optparse-applicative { build-depends: optparse-applicative >= 0.13 && < 0.16 } +common resourcet { build-depends: resourcet >= 1.1 && < 1.3 } +common text { build-depends: text >= 1.2.2 && < 2.0 } +common vector { build-depends: vector >= 0.12.0.1 && < 0.13 } +common weigh { build-depends: weigh >= 0.0.6 && < 0.1 } -common semigroups { if (!impl(ghc >= 8.0.1)) { build-depends: semigroups >= 0.8.4 && < 0.19 } } -common transformers { if (!impl(ghc >= 8.0.1)) { build-depends: transformers >= 0.4 && < 0.6 } } +common semigroups { if (!impl(ghc >= 8.0.1)) { build-depends: semigroups >= 0.8.4 && < 0.19 } } +common transformers { if (!impl(ghc >= 8.0.1)) { build-depends: transformers >= 0.4 && < 0.6 } } common config default-language: Haskell2010 @@ -84,6 +87,9 @@ if (flag(bmi2)) && (impl(ghc >=8.4.1)) ghc-options: -mbmi2 -msse4.2 +common hw-dsv + build-depends: hw-dsv + library import: base, config , bits-extra @@ -119,6 +125,7 @@ executable hw-dsv import: base, config + , appar , bits-extra , bytestring , deepseq @@ -126,6 +133,7 @@ , ghc-prim , hedgehog , hw-bits + , hw-ip , hw-prim , hw-rankselect , hw-rankselect-base @@ -134,6 +142,7 @@ , optparse-applicative , resourcet , semigroups + , text , transformers , vector main-is: Main.hs @@ -142,13 +151,16 @@ App.Commands.CreateIndex App.Commands.Generate App.Commands.IndexWord8s + App.Commands.Options.Parse App.Commands.Options.Type App.Commands.QueryLazy App.Commands.QueryStrict + App.Commands.RangeJoin + App.Data.ColumnDesc + App.Data.RangeJoinColumn + App.Data.List App.Gen App.IO - Paths_hw_dsv - autogen-modules: Paths_hw_dsv hs-source-dirs: app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: hw-dsv @@ -170,8 +182,6 @@ type: exitcode-stdio-1.0 main-is: Space.hs build-depends: hw-dsv - other-modules: Paths_hw_dsv - autogen-modules: Paths_hw_dsv hs-source-dirs: weigh build-tool-depends: hspec-discover:hspec-discover @@ -201,8 +211,6 @@ HaskellWorks.Data.Dsv.Lazy.CursorSpec HaskellWorks.Data.Dsv.Strict.Cursor.InternalSpec HaskellWorks.Data.DsvSpec - Paths_hw_dsv - autogen-modules: Paths_hw_dsv hs-source-dirs: test build-tool-depends: hspec-discover:hspec-discover @@ -224,8 +232,18 @@ , vector type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: Paths_hw_dsv - autogen-modules: Paths_hw_dsv hs-source-dirs: bench ghc-options: -msse4.2 build-depends: hw-dsv + +test-suite doctest + import: base, config + , doctest + , doctest-discover + , hw-dsv + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs b/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs --- a/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs +++ b/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs @@ -73,8 +73,8 @@ {-# INLINE toVectorVector #-} selectListVector :: [Int] -> DsvCursor -> [[LBS.ByteString]] -selectListVector = LCL.selectListVector -{-# DEPRECATED selectListVector "Use HaskellWorks.Data.Dsv.Lazy.Cursor.selectListVector instead" #-} +selectListVector = LCL.selectListList +{-# DEPRECATED selectListVector "Use HaskellWorks.Data.Dsv.Lazy.Cursor.Lazy.selectListList instead" #-} {-# INLINE selectListVector #-} toListVectorStrict :: DsvCursor -> [DV.Vector BS.ByteString] diff --git a/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Lazy.hs b/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Lazy.hs --- a/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Lazy.hs +++ b/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Lazy.hs @@ -9,7 +9,8 @@ , toListList , toListVector , toVectorVector - , selectListVector + , selectListList + , mapSelectListList ) where import Data.Function @@ -88,10 +89,26 @@ {-# INLINE go #-} {-# INLINE selectRowFrom #-} -selectListVector :: [Int] -> DsvCursor -> [[LBS.ByteString]] -selectListVector sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) - then selectRowFrom sel c:selectListVector sel (trim d) +mapSelectRowFrom :: [(Int, LBS.ByteString -> LBS.ByteString)] -> DsvCursor -> [LBS.ByteString] +mapSelectRowFrom sel c = uncurry go <$> sel + where go :: Int -> (LBS.ByteString -> LBS.ByteString) -> LBS.ByteString + go n f = f (snippet nc) + where nc = nextPosition (advanceField (fromIntegral n) c) + {-# INLINE go #-} +{-# INLINE mapSelectRowFrom #-} + +selectListList :: [Int] -> DsvCursor -> [[LBS.ByteString]] +selectListList sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then selectRowFrom sel c:selectListList sel (trim d) else [] where nr = nextRow c d = nextPosition nr -{-# INLINE selectListVector #-} +{-# INLINE selectListList #-} + +mapSelectListList :: [(Int, LBS.ByteString -> LBS.ByteString)] -> DsvCursor -> [[LBS.ByteString]] +mapSelectListList sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then mapSelectRowFrom sel c:mapSelectListList sel (trim d) + else [] + where nr = nextRow c + d = nextPosition nr +{-# INLINE mapSelectListList #-} diff --git a/test/HaskellWorks/Data/Dsv/Lazy/CursorSpec.hs b/test/HaskellWorks/Data/Dsv/Lazy/CursorSpec.hs --- a/test/HaskellWorks/Data/Dsv/Lazy/CursorSpec.hs +++ b/test/HaskellWorks/Data/Dsv/Lazy/CursorSpec.hs @@ -10,9 +10,10 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Vector as DV -import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector as DV +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor.Lazy as SVLL {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} @@ -32,7 +33,7 @@ expectedMM = mkExpected [["hello","goodbye"],["yes","no"]] testToListVector :: LBS.ByteString -> [DV.Vector LBS.ByteString] -testToListVector = SVL.toListVector . SVL.makeCursor comma +testToListVector = SVLL.toListVector . SVL.makeCursor comma testToListList :: LBS.ByteString -> [[LBS.ByteString]] testToListList = fmap DV.toList . testToListVector @@ -214,7 +215,7 @@ let cursor = SVL.makeCursor 44 text _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) - let actual = fmap DV.toList (DV.toList (SVL.toVectorVector cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) LBS.length text === newlinePos + 2 LBS.index text newlinePos === 10 actual === expected @@ -225,7 +226,7 @@ let cursor = SVL.makeCursor 44 text _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) - let actual = fmap DV.toList (DV.toList (SVL.toVectorVector cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) LBS.length text === newlinePos + 2 LBS.index text newlinePos === 10 actual === expected @@ -236,7 +237,7 @@ let cursor = SVL.makeCursor 44 text _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) - let actual = fmap DV.toList (DV.toList (SVL.toVectorVector cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) LBS.length text === newlinePos + 2 LBS.index text newlinePos === 10 actual === expected diff --git a/weigh/Space.hs b/weigh/Space.hs --- a/weigh/Space.hs +++ b/weigh/Space.hs @@ -1,17 +1,18 @@ module Main where -import Data.ByteString (ByteString) -import Data.Vector (Vector) +import Data.ByteString (ByteString) +import Data.Vector (Vector) +import HaskellWorks.Data.Dsv.Internal.Char (comma) import Weigh -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Csv as CSV -import qualified Data.Csv.Streaming as CSS -import qualified Data.Foldable as F -import qualified Data.Vector as DV -import HaskellWorks.Data.Dsv.Internal.Char (comma) -import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS -import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Csv as CSV +import qualified Data.Csv.Streaming as CSS +import qualified Data.Foldable as F +import qualified Data.Vector as DV +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor.Lazy as SVLL +import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS {-# ANN module ("HLint: ignore Redundant do" :: String) #-} @@ -31,7 +32,7 @@ bs <- LBS.readFile filePath let c = SVL.makeCursor comma bs - return $ SVL.toListVector c + return $ SVLL.toListVector c main :: IO () main = do