diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,5 @@ +# Changelog + +## v1.0.0.0 - October 20, 2020 + +Initial version diff --git a/dsv.cabal b/dsv.cabal new file mode 100644 --- /dev/null +++ b/dsv.cabal @@ -0,0 +1,153 @@ +cabal-version: 2.4 + +name: dsv +version: 1.0.0.0 +category: Text, CSV, Pipes +synopsis: DSV (delimiter-separated values) + +description: + Utilities for working with DSV (delimiter-separated values) files. + +tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.2 + +extra-source-files: changelog.md +data-files: + test-data/tweets.csv + , test-data/tweets-with-id-error.csv + , test-data/tweets-with-duplicate-header.csv + , test-data/doc-example-with-header.csv + , test-data/doc-example-without-header.csv + , test-data/doc-example-malformed-with-header.csv + , test-data/doc-example-malformed-without-header.csv + , test-data/doc-example-with-utf8-errors.csv + , test-data/empty.csv + +copyright: 2019-2020 Typeclass Consulting, LLC +license: MIT +license-file: license.txt + +homepage: https://github.com/typeclasses/dsv +bug-reports: https://github.com/typeclasses/dsv/issues + +author: Chris Martin +maintainer: Chris Martin, Julie Moronuki + +library + hs-source-dirs: library + default-language: Haskell2010 + + ghc-options: + -Wall + -fdefer-typed-holes + + exposed-modules: + DSV + + autogen-modules: + Paths_dsv + + other-modules: + Paths_dsv + , DSV.AttoParser + , DSV.AttoPipe + , DSV.AttoView + , DSV.ByteString + , DSV.CommonDelimiters + , DSV.DelimiterSplice + , DSV.DelimiterType + , DSV.FileFold + , DSV.FileFoldCsv + , DSV.FileStrictCsvMap + , DSV.FileStrictCsvRead + , DSV.FileStrictCsvZipView + , DSV.FileStrictMap + , DSV.FileStrictRead + , DSV.FileStrictZipView + , DSV.Fold + , DSV.Header + , DSV.IndexError + , DSV.IO + , DSV.LookupError + , DSV.LookupErrorUtf8 + , DSV.LookupUtf8 + , DSV.Numbers + , DSV.NumberViews + , DSV.ParseError + , DSV.ParseStop + , DSV.Parsing + , DSV.Pipes + , DSV.Position + , DSV.Prelude + , DSV.RequireCompleteParse + , DSV.Text + , DSV.TextReaderView + , DSV.UTF8 + , DSV.Validation + , DSV.Vector + , DSV.VectorViews + , DSV.ViewType + , DSV.ZipViewError + , DSV.ZipViewFold + , DSV.ZipViewType + , DSV.ZipViews + , DSV.ZipViewPipe + , DSV.ZipViewStop + + build-depends: + attoparsec ^>= 0.13 + , base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 + , bytestring ^>= 0.10 + , cassava ^>= 0.5 + , containers ^>= 0.6 + , foldl ^>= 1.4.5 + , pipes ^>= 4.3.10 + , pipes-bytestring ^>= 2.1 + , pipes-safe ^>= 2.3 + , template-haskell ^>= 2.14 || ^>= 2.15 || ^>= 2.16 + , text ^>= 1.2 + , validation ^>= 1.1 + , vector ^>= 0.12 + +test-suite hedgehog + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: hedgehog.hs + + ghc-options: + -Wall + -fno-warn-missing-signatures + -threaded + + other-modules: + Paths_dsv + , DSV.TestPrelude + , DSV.TestData.Tweets + , DSV.Tests.FileFoldCsv + , DSV.Tests.FileStrictCsvRead + , DSV.Tests.FileStrictCsvZipView + + build-depends: + dsv + , base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 + , bytestring ^>= 0.10 + , containers ^>= 0.6 + , foldl ^>= 1.4 + , hedgehog ^>= 1.0 + , safe-exceptions ^>= 0.1 + , text ^>= 1.2 + , vector ^>= 0.12 + +test-suite doctest + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: doctest.hs + + ghc-options: + -Wall + -threaded + + build-depends: + base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 + , doctest ^>= 0.16 || ^>= 0.17 diff --git a/library/DSV.hs b/library/DSV.hs new file mode 100644 --- /dev/null +++ b/library/DSV.hs @@ -0,0 +1,298 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{- | + +DSV ("delimiter-separated values") is a simple file format used to save tabular data such as you might see in a spreadsheet. Each row is separated by a newline character, and the fields within each row are separated by the /delimiter/ (such as a comma, tab, etc.) Most often, the delimiter is a comma, in which case we call the file a CSV file ("comma-separated values"). + +For example, a CSV file might contain a list of expenses. We will use variations of the following example CSV file throughout the documentation: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +-} + +module DSV + ( + -- * Reading a CSV file as a Vector + -- ** @readCsvFileStrict@... + -- $readingCsvFilesStrictly + readCsvFileStrictWithZippedHeader, readCsvFileStrictWithoutHeader, readCsvFileStrictIgnoringHeader + -- ** What is a Vector + -- $vector + , Vector, nthVectorElement, vectorLookup, listToVector, vectorToList, emptyVector + -- ** What is a ByteString + -- $bytestring + , ByteString + -- ** A read ends with a ParseStop + , ParseStop (..), requireCompleteParse, completely + + -- * Other delimiters + -- ** @readDsvFileStrict@... + -- $readingDsvFilesStrictly + , readDsvFileStrictWithZippedHeader, readDsvFileStrictWithoutHeader, readDsvFileStrictIgnoringHeader + -- ** What is a Delimiter + , Delimiter (..), comma, tab, delimiterWord8, charDelimiter + + -- * Reading with a custom row type + -- ** @mapCsvFileStrict@... + -- $readingCsvFilesStrictlyWithAnyRowType + , mapCsvFileStrictWithoutHeader, mapCsvFileStrictIgnoringHeader, mapCsvFileStrictUsingHeader + -- ** Using other delimiters + -- $readingDsvFilesStrictlyWithAnyRowType + , mapDsvFileStrictWithoutHeader, mapDsvFileStrictIgnoringHeader, mapDsvFileStrictUsingHeader + + -- * Iterating over a file with a Fold + -- ** @foldCsvFile@... + -- $foldingCsvFiles + , foldCsvFileWithZippedHeader, foldCsvFileWithZippedHeaderM + , foldCsvFileWithoutHeader, foldCsvFileWithoutHeaderM + , foldCsvFileIgnoringHeader, foldCsvFileIgnoringHeaderM + -- ** What is a Fold + -- $fold + , Fold (..), FoldM (..) + -- ** Using other delimiters + -- $foldingDsvFiles + , foldDsvFileWithZippedHeader, foldDsvFileWithZippedHeaderM + , foldDsvFileWithoutHeader, foldDsvFileWithoutHeaderM + , foldDsvFileIgnoringHeader, foldDsvFileIgnoringHeaderM + + -- * Functions that can fail + -- ** What is a View + , View (..) + -- ** What is Validation + -- $validation + , Validation (..) + -- ** Constructing views + , constView, maybeView + -- ** Modifying views + , overViewError, inputAsViewError, discardViewError + -- ** Composing views + -- $composingViews + , (>>>), (<<<) + , (>>>-), (<<<-) + -- ** Using views + , applyView, viewOrThrow, viewOrThrowInput, viewMaybe, viewOr, viewOr' + -- ** Viewing strings as numbers + , byteStringNatView, textNatView, InvalidNat (..) + , byteStringNatView_, textNatView_ + , byteStringRationalView, textRationalView, InvalidRational (..) + , byteStringRationalView_, textRationalView_ + , byteStringDollarsView, textDollarsView, InvalidDollars (..) + , byteStringDollarsView_, textDollarsView_ + + -- ** Viewing a position of a vector + , columnNumberView, TooShort (..), IndexError (..) + , columnNumberView_ + -- ** Finding something in a vector + , lookupView, lookupView_, Duplicate (..), Missing (..), LookupError (..) + -- ** Finding something in a vector of UTF-8 byte strings + , lookupTextViewUtf8, lookupStringViewUtf8, LookupErrorUtf8 (..) + , lookupTextViewUtf8_, lookupStringViewUtf8_ + + -- * Header-and-row views + -- ** What is a ZipView + , ZipView (..) + -- ** Basic zip view operations + , overZipViewError, overHeaderError, overRowError + -- ** Converting a ZipView to a Pipe + , zipViewPipe, zipViewPipeIgnoringAllErrors, zipViewPipeThrowFirstError + -- ** Some zip views + , byteStringZipView, textZipViewUtf8, textZipViewUtf8', byteStringZipViewPosition, entireRowZipView + -- ** Refining a ZipView with a View + , refineZipView + -- ** Combining a ZipView with a Fold + , zipViewFold, zipViewFoldM, ZipViewError (..) + -- ** Reading strictly from CSV files using ZipView + , zipViewCsvFileStrict + , zipViewCsvFileStrictIgnoringAllErrors + , zipViewCsvFileStrictThrowFirstError + -- ** A read ends with a ZipViewStop + , ZipViewStop (..) + -- ** Using other delimiters + , zipViewDsvFileStrict + , zipViewDsvFileStrictIgnoringAllErrors + , zipViewDsvFileStrictThrowFirstError + + -- * Pipes + -- ** Pipes that parse DSV rows + , csvRowPipe, dsvRowPipe + -- ** Creating row producers from file handles + , handleCsvRowProducer, handleDsvRowProducer + -- ** Pipes that combine the header with subsequent rows + , zipHeaderPipe, zipHeaderWithPipe + -- ** What are Pipes + -- $pipes + , Pipe, Producer, Consumer, Effect, runEffect, (>->), await, yield + + -- * Attoparsec + -- $attoparsec + , AttoParser, attoPipe, handleAttoProducer, ParseError (..) + + -- * Position types + , Position (..), RowNumber (..), ColumnNumber (..) + , ColumnName (..), Positive (..), At (..) + + -- * Text + -- ** What is Text + -- $text + , Text + -- ** Relationship to String + , stringToText, textToString + -- ** Relationship to Bytestring + , encodeTextUtf8, utf8TextView, InvalidUtf8 (..) + + ) where + +import DSV.AttoParser +import DSV.AttoPipe +import DSV.ByteString +import DSV.CommonDelimiters +import DSV.DelimiterSplice +import DSV.DelimiterType +import DSV.UTF8 +import DSV.FileFold +import DSV.FileFoldCsv +import DSV.FileStrictCsvMap +import DSV.FileStrictCsvRead +import DSV.FileStrictCsvZipView +import DSV.FileStrictMap +import DSV.FileStrictRead +import DSV.FileStrictZipView +import DSV.Fold +import DSV.Header +import DSV.IndexError +import DSV.LookupError +import DSV.LookupUtf8 +import DSV.ZipViews +import DSV.Numbers +import DSV.NumberViews +import DSV.ParseError +import DSV.ParseStop +import DSV.Parsing +import DSV.Pipes +import DSV.Position +import DSV.Prelude +import DSV.RequireCompleteParse +import DSV.Text +import DSV.Validation +import DSV.Vector +import DSV.VectorViews +import DSV.ViewType +import DSV.ZipViewError +import DSV.ZipViewFold +import DSV.ZipViewPipe +import DSV.ZipViewStop +import DSV.ZipViewType + +import qualified Control.Foldl as L + +{- $readingCsvFilesStrictly + +We present these functions first because they require the least amount of effort to use. Each function in this section: + + 1. Assumes that the delimiter is a comma. + 2. Reads from a file (specified by a 'FilePath'); + 3. Reads all of the results into memory at once ("strictly"); + +Read on to the subsequent sections if: + + - you need to use a different delimiter; + - your input source is something other than a file; + - you need streaming to control memory usage; or + - you would like assistance in converting the data from 'Vector's of 'ByteString's to other types. + +-} + +{- $readingDsvFilesStrictly + +\"CSV\" stands for "comma-separated values". But sometimes you may encounter CSV-like files in which the values are separated by some other character; e.g. it may have tabs instead of commas. We refer to such files more generally, then, as DSV files ("delimiter-separated values"). Functions that have a 'Delimiter' parameter, such as 'readDsvFileStrictWithoutHeader', let you specify what kind of DSV file you want to read. + +-} + +{- $readingCsvFilesStrictlyWithAnyRowType + +Most likely, you don't just want to get 'Vector's of 'ByteString' values from a CSV file; you want to interpret the meaning of those bytes somehow, converting each row into some type that is specific to the kind of data that your particular CSV file represents. These functions are parameterized on a function of type @(Vector ByteString -> IO row)@ which will get applied to each row as it is read. Then instead of getting each row as a @Vector ByteString@, each row will be represented in the result as a value of type @row@ (where @row@ is a type parameter that stands for whatever type your conversion function returns). + +-} + +{- $readingDsvFilesStrictlyWithAnyRowType + +This section is the same as the previous, but generalized with a 'Delimiter' parameter. + +-} + +{- $foldingCsvFiles + +The functions in this section are all parameterized on: + + 1. A 'FilePath', which specifies what CSV file to read; + 2. Either a 'L.Fold' or a 'L.FoldM', which specifies what action to take upon each row from the CSV file. + +Use one of the functions with a 'L.Fold' parameter if you only need to collect information from the rows and aggregate it into some @result@ value. Use a function with a 'L.FoldM' parameter if your fold also needs to perform some kind of /effect/ as the rows are read from the file. + +See the "Control.Foldl" module for much more on what folds are and how to construct them. + +-} + +{- $foldingDsvFiles + +This section is the same as the previous, but generalized with a 'Delimiter' parameter. + +-} + +{- $miscellania + +These functions are not directly relevant to this library's primary purpose of consuming DSV files, but we include them because you might find some of them useful for reading particular kinds of values. + +-} + +{- $validation + +See the "Data.Validation" module for more on the 'Validation' type. + +-} + +{- $vector + +See the "Data.Vector" module for more on the 'Vector' type. + +-} + +{- $bytestring + +See the "Data.ByteString" module for more on the 'ByteString' type. + +-} + +{- $fold + +See the "Control.Foldl" module for more on the 'Fold' and 'FoldM' types. + +-} + +{- $text + +See the "Data.Text" module for more on the 'Text' type. + +-} + +{- $attoparsec + +See the "Data.Attoparsec.ByteString" module for more on parsing byte strings. + +-} + +{- $pipes + +See the "Pipes" module for more on pipes. + +-} + +{- $composingViews + +'View' has a 'Category' instance, so you can chain views together using '>>>' and '<<<'. See the "Control.Category" module for more on categories. + +The two views being sequenced have to have the same error type, which is often inconvenient. To chain views together while converting their error type to @()@, you can use '>>>-' and '<<<-' instead. + +-} diff --git a/library/DSV/AttoParser.hs b/library/DSV/AttoParser.hs new file mode 100644 --- /dev/null +++ b/library/DSV/AttoParser.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.AttoParser + ( AttoParser + ) where + +-- attoparsec +import qualified Data.Attoparsec.ByteString as Atto + +type AttoParser = Atto.Parser diff --git a/library/DSV/AttoPipe.hs b/library/DSV/AttoPipe.hs new file mode 100644 --- /dev/null +++ b/library/DSV/AttoPipe.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.AttoPipe + ( attoPipe + , handleAttoProducer + ) where + +import DSV.AttoParser +import DSV.ByteString +import DSV.IO +import DSV.ParseError +import DSV.ParseStop +import DSV.Pipes +import DSV.Prelude + +-- attoparsec +import qualified Data.Attoparsec.ByteString as Atto + +-- pipes-bytestring +import qualified Pipes.ByteString + +attoPipe :: forall a m . + Monad m + => AttoParser a + -> Pipe ByteString a m ParseError + +attoPipe p = + do + x <- await + proceed (Atto.parse p x) + + where + proceed (Atto.Partial c) = + do + x <- await + proceed (c x) + + proceed (Atto.Done remainingInput x) = + do + yield x + proceed (Atto.parse p remainingInput) + + proceed (Atto.Fail _remainingInput _ctxs _msg) = + return ParseError + +handleAttoProducer :: + forall a m . + MonadIO m + => AttoParser a + -> Handle -- ^ File handle to read parser input from + -> Producer a m ParseStop + +handleAttoProducer p h = readBytes >-> parseRows + where + readBytes = + do Pipes.ByteString.fromHandle h + return ParseComplete + parseRows = + do _ <- attoPipe p + return ParseIncomplete diff --git a/library/DSV/AttoView.hs b/library/DSV/AttoView.hs new file mode 100644 --- /dev/null +++ b/library/DSV/AttoView.hs @@ -0,0 +1,18 @@ +module DSV.AttoView + ( attoByteStringView + ) where + +import DSV.AttoParser +import DSV.ByteString +import DSV.Validation +import DSV.ViewType + +-- attoparsec +import qualified Data.Attoparsec.ByteString as A + +attoByteStringView :: e -> AttoParser a -> View e ByteString a +attoByteStringView e p = + View $ \bs -> + case A.parseOnly (p <* A.endOfInput) bs of + Left _ -> Failure e + Right x -> Success x diff --git a/library/DSV/ByteString.hs b/library/DSV/ByteString.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ByteString.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.ByteString + ( ByteString + ) where + +import qualified Data.ByteString as BS + +type ByteString = BS.ByteString diff --git a/library/DSV/CommonDelimiters.hs b/library/DSV/CommonDelimiters.hs new file mode 100644 --- /dev/null +++ b/library/DSV/CommonDelimiters.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module DSV.CommonDelimiters + ( Delimiter (..) + , charDelimiter + , delimiterWord8 + , comma, tab + ) where + +import DSV.DelimiterType +import DSV.DelimiterSplice + +-- | ASCII code point @0x2C@, the typical choice of DSV delimiter. DSV (delimiter-separated value) files that use the comma delimiter are called CSV (comma-separated-value) files. +-- +-- @comma = $('charDelimiter' ',')@ +comma :: Delimiter +comma = $(charDelimiter ',') + +-- | ASCII code point @0x09@, the "horizontal tab" character. +-- +-- @tab = $('charDelimiter' '\t')@ +tab :: Delimiter +tab = $(charDelimiter '\t') diff --git a/library/DSV/DelimiterSplice.hs b/library/DSV/DelimiterSplice.hs new file mode 100644 --- /dev/null +++ b/library/DSV/DelimiterSplice.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.DelimiterSplice + ( charDelimiter + ) where + +import DSV.DelimiterType +import DSV.Prelude + +import Data.Word (Word8) + +import qualified Data.Char + +import Language.Haskell.TH.Syntax (Q, Exp, lift) + +-- | A Template Haskell expression of type 'Delimiter'. Rejects code points above @0xff@. +-- +-- === Example +-- +-- 'comma' is defined as: +-- +-- @$('charDelimiter' ',')@ +-- +-- This could be written equivalently as: +-- +-- @'Delimiter' ('fromIntegral' ('Data.Char.ord' ','))@ +-- +-- but the former includes a compile-time check to ensure that the character @','@ is representable by a single byte (and thus that 'fromIntegral' does not overflow). + +charDelimiter :: Char -> Q Exp +charDelimiter c = + do + let n = Data.Char.ord c :: Int + if n > (fromIntegral (maxBound :: Word8) :: Int) + then fail ("Character " ++ [c] ++ " is outside the range of Word8.") + else lift (Delimiter (fromIntegral n :: Word8)) diff --git a/library/DSV/DelimiterType.hs b/library/DSV/DelimiterType.hs new file mode 100644 --- /dev/null +++ b/library/DSV/DelimiterType.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveLift #-} + +module DSV.DelimiterType + ( Delimiter (..) + , delimiterWord8 + ) where + +import Data.Word (Word8) + +import Language.Haskell.TH.Syntax (Lift) + +newtype Delimiter = Delimiter Word8 + deriving stock Lift + +delimiterWord8 :: Delimiter -> Word8 +delimiterWord8 (Delimiter d) = d diff --git a/library/DSV/FileFold.hs b/library/DSV/FileFold.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileFold.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileFold + ( foldDsvFileWithoutHeader, foldDsvFileWithoutHeaderM + , foldDsvFileIgnoringHeader, foldDsvFileIgnoringHeaderM + , foldDsvFileWithZippedHeader, foldDsvFileWithZippedHeaderM + ) where + +import DSV.ByteString +import DSV.DelimiterType +import DSV.Fold +import DSV.Header +import DSV.IO +import DSV.ParseStop +import DSV.Parsing +import DSV.Pipes +import DSV.Prelude +import DSV.Vector + +-- pipes-safe +import qualified Pipes.Safe.Prelude as P + +foldDsvFileWithoutHeader :: + forall m result . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> Fold (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileWithoutHeader d fp fld = + liftIO $ runSafeT $ P.withFile fp ReadMode $ \h -> lift $ + foldProducer fld (handleDsvRowProducer d h) + +foldDsvFileWithoutHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> FoldM m (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileWithoutHeaderM d fp fld = + runSafeT $ P.withFile fp ReadMode $ \h -> lift $ + foldProducerM fld (handleDsvRowProducer d h) + +foldDsvFileIgnoringHeader :: + forall m result . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> Fold (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileIgnoringHeader d fp fld = + foldDsvFileWithoutHeader d fp (foldDrop 1 fld) + +foldDsvFileIgnoringHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> FoldM m (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileIgnoringHeaderM d fp fld = + foldDsvFileWithoutHeaderM d fp (foldDropM 1 fld) + +foldDsvFileWithZippedHeader :: + forall m result . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> Fold (Vector (ByteString, ByteString)) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileWithZippedHeader d fp fld = + liftIO $ runSafeT $ P.withFile fp ReadMode $ \h -> lift $ + foldProducer fld (handleDsvRowProducer d h >-> zipHeaderPipe) + +foldDsvFileWithZippedHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> FoldM m (Vector (ByteString, ByteString)) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldDsvFileWithZippedHeaderM d fp fld = + runSafeT $ P.withFile fp ReadMode $ \h -> lift $ + foldProducerM fld (handleDsvRowProducer d h >-> zipHeaderPipe) diff --git a/library/DSV/FileFoldCsv.hs b/library/DSV/FileFoldCsv.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileFoldCsv.hs @@ -0,0 +1,261 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileFoldCsv + ( foldCsvFileWithoutHeader, foldCsvFileWithoutHeaderM + , foldCsvFileIgnoringHeader, foldCsvFileIgnoringHeaderM + , foldCsvFileWithZippedHeader, foldCsvFileWithZippedHeaderM + ) where + +import DSV.ByteString +import DSV.CommonDelimiters +import DSV.FileFold +import DSV.Fold +import DSV.IO +import DSV.NumberViews +import DSV.ParseStop +import DSV.Prelude +import DSV.Vector +import DSV.VectorViews +import DSV.ViewType + +-- base +import Data.Foldable (traverse_) +import Data.Maybe (fromMaybe) + +-- bytestring +import qualified Data.ByteString.Char8 as BS + +-- foldl +import qualified Control.Foldl as L + +{- | + +=== Example + +CSV file: + +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.premap' ('viewOr' 0 $ 'byteStringDollarsView' '<<<-' 'columnNumberView' 3) 'L.sum' +@ + +Result: + +@ +('ParseComplete', 624.84) +@ + +-} + +foldCsvFileWithoutHeader :: + forall m result . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> Fold (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileWithoutHeader fp fld = + foldDsvFileWithoutHeader comma fp fld + +{- | + +=== Example + +CSV file: + +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.mapM_' ('traverse_' 'BS.putStrLn' . 'nthVectorElement' 4) *> 'L.generalize' 'L.length' +@ + +Output printed to the terminal: + +> Dehydrated boulders +> Earthquake pills + +Result: + +@ +('ParseComplete', 2) +@ + +-} + +foldCsvFileWithoutHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => FilePath + -- ^ The path of a CSV file to read + -> FoldM m (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileWithoutHeaderM fp fld = + foldDsvFileWithoutHeaderM comma fp fld + +{- | + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.premap' ('viewOr' 0 $ 'byteStringDollarsView' '<<<-' 'columnNumberView' 3) 'L.sum' +@ + +Result: + +@ +('ParseComplete', 624.84) +@ + +-} + +foldCsvFileIgnoringHeader :: + forall m result . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> Fold (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileIgnoringHeader fp fld = + foldDsvFileIgnoringHeader comma fp fld + +{- | + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.mapM_' ('traverse_' 'BS.putStrLn' . 'nthVectorElement' 4) *> 'L.generalize' 'L.length' +@ + +Output printed to the terminal: + +> Dehydrated boulders +> Earthquake pills + +Result: + +@ +('ParseComplete', 2) +@ + +-} + +foldCsvFileIgnoringHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => FilePath + -- ^ The path of a CSV file to read + -> FoldM m (Vector ByteString) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileIgnoringHeaderM fp fld = + foldDsvFileIgnoringHeaderM comma fp fld + +{- | + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.premap' ('viewOr' 0 $ 'byteStringDollarsView' '<<<-' 'lookupView' (== \"Price")) 'L.sum' +@ + +Result: + +@ +('ParseComplete', 624.84) +@ + +-} + +foldCsvFileWithZippedHeader :: + forall m result . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> Fold (Vector (ByteString, ByteString)) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileWithZippedHeader fp fld = + foldDsvFileWithZippedHeader comma fp fld + +{- | + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Fold: + +@ +'L.mapM_' ('traverse_' 'BS.putStrLn' . 'vectorLookup' (== \"Product")) *> 'L.generalize' 'L.length' +@ + +Output printed to the terminal: + +> Dehydrated boulders +> Earthquake pills + +Result: + +@ +('ParseComplete', 2) +@ + +-} + +foldCsvFileWithZippedHeaderM :: + forall m result . + (MonadCatch m, MonadMask m, MonadIO m) + => FilePath + -- ^ The path of a CSV file to read + -> FoldM m (Vector (ByteString, ByteString)) result + -- ^ What to do with each row + -> m (ParseStop, result) + +foldCsvFileWithZippedHeaderM fp fld = + foldDsvFileWithZippedHeaderM comma fp fld diff --git a/library/DSV/FileStrictCsvMap.hs b/library/DSV/FileStrictCsvMap.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictCsvMap.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileStrictCsvMap + ( mapCsvFileStrictWithoutHeader + , mapCsvFileStrictIgnoringHeader + , mapCsvFileStrictUsingHeader + ) where + +import DSV.ByteString +import DSV.CommonDelimiters +import DSV.FileStrictMap +import DSV.IO +import DSV.ParseStop +import DSV.Prelude +import DSV.Vector + +mapCsvFileStrictWithoutHeader :: + forall m row . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> (Vector ByteString -> IO row) + -- ^ Conversion function by which you specify how to interpret one row of bytes from the CSV file + -> m (ParseStop, Vector row) + +mapCsvFileStrictWithoutHeader fp f = + mapDsvFileStrictWithoutHeader comma fp f + +mapCsvFileStrictIgnoringHeader :: + forall m row . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> (Vector ByteString -> IO row) + -- ^ Conversion function by which you specify how to interpret one row of bytes from the CSV file + -> m (ParseStop, Vector row) + +mapCsvFileStrictIgnoringHeader fp f = + mapDsvFileStrictIgnoringHeader comma fp f + +mapCsvFileStrictUsingHeader :: + forall m row . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> (Vector ByteString -> IO (Vector ByteString -> IO row)) + -- ^ Function which interprets the header (the first @Vector ByteString@) and returns a conversion function (@Vector ByteString -> IO row@) by which you specify how to interpret one row of bytes from the CSV file + -> m (ParseStop, Vector row) + +mapCsvFileStrictUsingHeader fp f = + mapDsvFileStrictUsingHeader comma fp f diff --git a/library/DSV/FileStrictCsvRead.hs b/library/DSV/FileStrictCsvRead.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictCsvRead.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileStrictCsvRead + ( readCsvFileStrictWithZippedHeader + , readCsvFileStrictWithoutHeader + , readCsvFileStrictIgnoringHeader + ) where + +import DSV.ByteString +import DSV.CommonDelimiters +import DSV.FileStrictRead +import DSV.IO +import DSV.ParseStop +import DSV.Prelude +import DSV.Vector + +{- | Often, the first line of a CSV file is a row that gives the name of each column in the file. If present, this row is called the /header/. + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Result: + +> ( ParseComplete, +> [ [ ("Date", "2019-03-24"), +> ("Vendor", "Acme Co"), +> ("Price", "$599.89"), +> ("Product", "Dehydrated boulders") ], +> [ ("Date", "2019-04-18"), +> ("Vendor", "Acme Co"), +> ("Price", "$24.95"), +> ("Product", "Earthquake pills") ] ] ) + +=== Example with a malformed file + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-03-29,Store Mart,"$"8.14,Coffee beans +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Notice the quotation marks around the dollar sign on the third line. + +Result: + +> ( ParseIncomplete, +> [ [ ("Date", "2019-03-24"), +> ("Vendor", "Acme Co"), +> ("Price", "$599.89"), +> ("Product", "Dehydrated boulders") ] ) + +The result includes the first row of data because it appears /before/ the malformed line. All data that comes /after/ the erroneous quotation is discarded, even though the final line does contain correctly formatted data. + +-} + +readCsvFileStrictWithZippedHeader :: + forall m . + MonadIO m + => FilePath -- ^ The path of a CSV file to read + -> m (ParseStop, (Vector (Vector (ByteString, ByteString)))) + +readCsvFileStrictWithZippedHeader fp = readDsvFileStrictWithZippedHeader comma fp + +{- | Not every CSV file has a header row. Use this function to read a CSV file that does /not/ have a header. + +=== Example + +CSV file: + +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Result: + +> ( ParseComplete, +> [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"], +> ["2019-04-18", "Acme Co", "$24.95", "Earthquake pills"] ] ) + +=== Example with a malformed file + +CSV file: + +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-03-29,Store Mart,"$"8.14,Coffee beans +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Result: + +> ( ParseIncomplete, +> [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"] ] ) + +-} +readCsvFileStrictWithoutHeader :: + forall m . + MonadIO m + => FilePath -- ^ The path of a CSV file to read + -> m (ParseStop, (Vector (Vector ByteString))) + +readCsvFileStrictWithoutHeader fp = readDsvFileStrictWithoutHeader comma fp + +{- | Sometimes a CSV file has a header but you don't care about it. In that case, you can use this function to /ignore/ the header line and read only the rows containing data. + +=== Example + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +Result: + +> ( ParseComplete, +> [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"], +> ["2019-04-18", "Acme Co", "$24.95", "Earthquake pills"] ] ) + +-} + +readCsvFileStrictIgnoringHeader :: + forall m . + MonadIO m + => FilePath -- ^ The path of a CSV file to read + -> m (ParseStop, (Vector (Vector ByteString))) + +readCsvFileStrictIgnoringHeader fp = readDsvFileStrictIgnoringHeader comma fp diff --git a/library/DSV/FileStrictCsvZipView.hs b/library/DSV/FileStrictCsvZipView.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictCsvZipView.hs @@ -0,0 +1,144 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileStrictCsvZipView + ( zipViewCsvFileStrict + , zipViewCsvFileStrictIgnoringAllErrors + , zipViewCsvFileStrictThrowFirstError + ) where + +import DSV.CommonDelimiters +import DSV.FileStrictZipView +import DSV.IndexError +import DSV.IO +import DSV.ZipViewStop +import DSV.Position +import DSV.Prelude +import DSV.Text +import DSV.UTF8 +import DSV.Validation +import DSV.Vector +import DSV.ZipViews +import DSV.ZipViewType + +{- | + +=== Example: Reading entire rows + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +View: + +@ +'entireRowZipView' @() @() +@ + +Result: + +@ +( 'ZipViewComplete', + [ 'Success' ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"], + 'Success' ["2019-04-18", "Acme Co", "$24.95", "Earthquake pills"] ] ) +@ + +=== Example: Reading particular columns + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydrated boulders +> 2019-04-18,Acme Co,$24.95,Earthquake pills + +View: + +@ +do + date <- 'overZipViewError' (:[]) (:[]) ('textZipViewUtf8' \"Date" 'utf8TextView') + product <- 'overZipViewError' (:[]) (:[]) ('textZipViewUtf8' \"Product" 'utf8TextView') + return (date, product) +@ + +Result: + +@ +( 'ZipViewComplete', + [ 'Success' ("2019-03-24", "Dehydrated boulders"), + 'Success' ("2019-04-18", "Earthquake pills") ] ) +@ + +=== Example: Decoding errors + +CSV file: + +> Date,Vendor,Price,Product +> 2019-03-24,Acme Co,$599.89,Dehydra\xc3\x28d boulders +> 2019-04-18,\xc3\x28me Co,$24.95,Earthquake pills + +In this example, @\\xc3\\x28@ represents two bytes which constitute an invalid sequence in UTF-8. Notice that there is a UTF-8 error on each of the last two lines. + +View: + +@ +do + date <- 'overZipViewError' (:[]) (:[]) ('textZipViewUtf8' \"Date" 'utf8TextView') + product <- 'overZipViewError' (:[]) (:[]) ('textZipViewUtf8' \"Product" 'utf8TextView') + return (date, product) +@ + +Result: + +@ +( 'ZipViewComplete', + [ 'Failure' ['At' ('ColumnName' \"Product") ('IndexError_FieldError' 'InvalidUtf8')] + , 'Success' ("2019-04-18", "Earthquake pills") + ] +@ + +The first item in the result is a 'Failure', because we tried to decode the value in the \"Product" column, and it cannot be decoded as UTF-8. The second item in the result is a 'Success', because although the row does contain an encoding error, the error is in the \"Vendor" field, which we never read. + +-} + +zipViewCsvFileStrict :: + forall m headerError rowError row . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (ZipViewStop headerError, Vector (Validation rowError row)) + +zipViewCsvFileStrict fp lu = + zipViewDsvFileStrict comma fp lu + +zipViewCsvFileStrictIgnoringAllErrors :: + forall m headerError rowError row . + MonadIO m + => FilePath + -- ^ The path of a CSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (Vector row) + +zipViewCsvFileStrictIgnoringAllErrors fp lu = + zipViewDsvFileStrictIgnoringAllErrors comma fp lu + +zipViewCsvFileStrictThrowFirstError :: + forall m headerError rowError row . + ( MonadIO m + , Exception headerError + , Show rowError, Typeable rowError + ) + => FilePath + -- ^ The path of a CSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (Vector row) + +zipViewCsvFileStrictThrowFirstError fp lu = + zipViewDsvFileStrictThrowFirstError comma fp lu diff --git a/library/DSV/FileStrictMap.hs b/library/DSV/FileStrictMap.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictMap.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileStrictMap + ( mapDsvFileStrictWithoutHeader + , mapDsvFileStrictIgnoringHeader + , mapDsvFileStrictUsingHeader + ) where + +import DSV.ByteString +import DSV.DelimiterType +import DSV.Fold +import DSV.Header +import DSV.IO +import DSV.ParseStop +import DSV.Parsing +import DSV.Pipes +import DSV.Prelude +import DSV.Vector + +-- pipes +import qualified Pipes.Prelude as P + +mapDsvFileStrictWithoutHeader :: + forall m row . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> (Vector ByteString -> IO row) + -- ^ Conversion function by which you specify how to interpret one row of bytes from the DSV file + -> m (ParseStop, Vector row) + +mapDsvFileStrictWithoutHeader d fp f = + liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h >-> P.mapM (lift . f) + +mapDsvFileStrictIgnoringHeader :: + forall m row . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> (Vector ByteString -> IO row) + -- ^ Conversion function by which you specify how to interpret one row of bytes from the DSV file + -> m (ParseStop, Vector row) + +mapDsvFileStrictIgnoringHeader d fp f = + liftIO $ runSafeT $ + do + foldProducerM (foldDropM 1 foldVectorM) $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h >-> P.mapM (lift . f) + +mapDsvFileStrictUsingHeader :: + forall m row . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> (Vector ByteString -> IO (Vector ByteString -> IO row)) + -- ^ Function which interprets the header (the first @Vector ByteString@) and returns a conversion function (@Vector ByteString -> IO row@) by which you specify how to interpret one row of bytes from the DSV file + -> m (ParseStop, Vector row) + +mapDsvFileStrictUsingHeader d fp f = + liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h >-> applyHeaderPipeM (bigLift f) + +bigLift :: + (Vector ByteString -> IO (Vector ByteString -> IO a)) + -> (Vector ByteString -> SafeT IO (Vector ByteString -> SafeT IO a)) + +bigLift = fmap liftIO . ((fmap . fmap . fmap) liftIO) diff --git a/library/DSV/FileStrictRead.hs b/library/DSV/FileStrictRead.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictRead.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.FileStrictRead + ( readDsvFileStrictWithZippedHeader + , readDsvFileStrictWithoutHeader + , readDsvFileStrictIgnoringHeader + ) where + +import DSV.ByteString +import DSV.DelimiterType +import DSV.Fold +import DSV.Header +import DSV.IO +import DSV.ParseStop +import DSV.Parsing +import DSV.Pipes +import DSV.Prelude +import DSV.Vector + +readDsvFileStrictWithoutHeader :: + forall m . + MonadIO m + => Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath -- ^ The path of a CSV file to read + -> m (ParseStop, Vector (Vector ByteString)) + +readDsvFileStrictWithoutHeader d fp = + liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h + +readDsvFileStrictWithZippedHeader :: + forall m . + MonadIO m + => Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath -- ^ The path of a CSV file to read + -> m (ParseStop, Vector (Vector (ByteString, ByteString))) + +readDsvFileStrictWithZippedHeader d fp = + liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h >-> zipHeaderPipe + +readDsvFileStrictIgnoringHeader :: + forall m . + MonadIO m + => Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath -- ^ The path of a CSV file to read + + -> m (ParseStop, Vector (Vector ByteString)) + +readDsvFileStrictIgnoringHeader d fp = + liftIO $ runSafeT $ + do + foldProducerM (foldDropM 1 foldVectorM) $ + withFile fp ReadMode $ \h -> + handleDsvRowProducer d h diff --git a/library/DSV/FileStrictZipView.hs b/library/DSV/FileStrictZipView.hs new file mode 100644 --- /dev/null +++ b/library/DSV/FileStrictZipView.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} + +module DSV.FileStrictZipView + ( zipViewDsvFileStrict + , zipViewDsvFileStrictIgnoringAllErrors + , zipViewDsvFileStrictThrowFirstError + ) where + +import DSV.DelimiterType +import DSV.Fold +import DSV.IO +import DSV.ParseStop +import DSV.Parsing +import DSV.Pipes +import DSV.Prelude +import DSV.Validation +import DSV.Vector +import DSV.ZipViewPipe +import DSV.ZipViewStop +import DSV.ZipViewType + +zipViewDsvFileStrict :: + forall m headerError rowError row . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (ZipViewStop headerError, Vector (Validation rowError row)) + +zipViewDsvFileStrict d fp lu = + liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + readRows h >-> interpretRows + + where + readRows h = + fmap + ( + \case + (_, ParseIncomplete) -> ZipViewParseError + (0, ParseComplete) -> ZipViewEmpty + (_, ParseComplete) -> ZipViewComplete + ) + (count (handleDsvRowProducer d h)) + + interpretRows = + fmap ZipViewHeaderError (zipViewPipe lu) + +zipViewDsvFileStrictIgnoringAllErrors :: + forall m headerError rowError row . + MonadIO m + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (Vector row) + +zipViewDsvFileStrictIgnoringAllErrors d fp lu = + fmap snd $ liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + void (handleDsvRowProducer d h) >-> + zipViewPipeIgnoringAllErrors lu + +zipViewDsvFileStrictThrowFirstError :: + forall m headerError rowError row . + ( MonadIO m + , Exception headerError + , Show rowError, Typeable rowError + ) + => Delimiter + -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> FilePath + -- ^ The path of a DSV file to read + -> ZipView headerError rowError row + -- ^ How to interpret the rows + -> m (Vector row) + +zipViewDsvFileStrictThrowFirstError d fp lu = + fmap snd $ liftIO $ runSafeT $ + do + foldProducerM foldVectorM $ + withFile fp ReadMode $ \h -> + void (handleDsvRowProducer d h) >-> + zipViewPipeThrowFirstError lu diff --git a/library/DSV/Fold.hs b/library/DSV/Fold.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Fold.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Fold + ( Fold (Fold), FoldM (FoldM) + , foldDrop, foldDropM + , foldProducer, foldProducerM + , foldVectorM + ) where + +import DSV.Numbers +import DSV.Pipes +import DSV.Prelude + +-- foldl +import qualified Control.Foldl as L +import Control.Foldl (Fold (Fold), FoldM (FoldM)) + +-- pipes +import qualified Pipes.Prelude as P + +foldDrop :: + forall a b . + Natural -> Fold a b -> Fold a b + +foldDrop n (Fold step begin done) = + Fold step' begin' done' + where + begin' = (n, begin) + step' (0, s) x = (0, step s x) + step' (n', s) _ = (n' - 1, s) + done' (_, s) = done s + +foldDropM :: + forall m a b . + Monad m + => Natural -> FoldM m a b -> FoldM m a b + +foldDropM n (FoldM step begin done) = + FoldM step' begin' done' + where + begin' = fmap (\s -> (n, s)) begin + step' (0, s) x = fmap (\s' -> (0, s')) (step s x) + step' (n', s) _ = return (n' - 1, s) + done' (_, s) = done s + +foldProducer :: + forall a b m r. + Monad m + => Fold a b -> Producer a m r -> m (r, b) + +foldProducer fld p = + do + (x, r) <- L.purely P.fold' fld p + return (r, x) + +foldProducerM :: + forall a b m r . + Monad m + => FoldM m a b -> Producer a m r -> m (r, b) + +foldProducerM fld p = + do + (x, r) <- L.impurely P.foldM' fld p + return (r, x) + +foldVectorM :: + forall v m a . + (L.PrimMonad m, L.Vector v a) + => FoldM m a (v a) + +foldVectorM = L.vectorM diff --git a/library/DSV/Header.hs b/library/DSV/Header.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Header.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Header + ( zipHeader, zipHeader', zipHeaderPipe + , zipHeaderWith, zipHeaderWith', zipHeaderWithPipe + , applyHeaderPipe, applyHeaderPipeM + ) where + +import DSV.Pipes +import DSV.Prelude +import DSV.Vector + +-- pipes +import qualified Pipes.Prelude as P + +{- | + +=== Example + +>>> :set -XOverloadedLists +>>> zipHeader [["A","B"],["1","2"],["3","4"]] +[[("A","1"),("B","2")],[("A","3"),("B","4")]] + +-} + +zipHeader :: forall a . [Vector a] -> [Vector (a, a)] +zipHeader [] = [] +zipHeader (names : rows) = zipHeader' names rows + +{- | + +=== Example + +>>> :set -XOverloadedLists +>>> zipHeader' ["A","B"] [["1","2"],["3","4"]] +[[("A","1"),("B","2")],[("A","3"),("B","4")]] + +-} + +zipHeader' :: forall a b . Vector a -> [Vector b] -> [Vector (a, b)] +zipHeader' names rows = map (vectorZip names) rows + +{- | + +=== Example + +>>> :set -XOverloadedLists +>>> zipHeaderWith (<>) [["A","B"],["1","2"],["3","4"]] +[["A1","B2"],["A3","B4"]] + +-} + +zipHeaderWith :: forall a b . (a -> a -> b) -> [Vector a] -> [Vector b] +zipHeaderWith _ [] = [] +zipHeaderWith f (names : rows) = zipHeaderWith' f names rows + +{- | + +=== Example + +>>> :set -XOverloadedLists +>>> zipHeaderWith' (<>) ["A","B"] [["1","2"],["3","4"]] +[["A1","B2"],["A3","B4"]] + +-} + +zipHeaderWith' :: forall a b c . (a -> b -> c) + -> Vector a -> [Vector b] -> [Vector c] +zipHeaderWith' f names rows = map (vectorZipWith f names) rows + +applyHeaderPipe :: + forall a b m r . + Monad m + => (a -> a -> b) + -> Pipe a b m r + +applyHeaderPipe f = + do + header <- await + P.map (f header) + +applyHeaderPipeM :: + forall a b m r . + Monad m + => (a -> m (a -> m b)) + -> Pipe a b m r + +applyHeaderPipeM f = + do + header <- await + applyHeader <- lift (f header) + P.mapM applyHeader + +{- | + +=== Example + +>>> import qualified Pipes.Prelude as P +>>> r1 = listToVector ["A","B"] +>>> r2 = listToVector ["1","2"] +>>> r3 = listToVector ["3","4"] +>>> p = do { yield r1; yield r2; yield r3 } +>>> runEffect (p >-> zipHeaderPipe >-> P.print) +[("A","1"),("B","2")] +[("A","3"),("B","4")] + +-} + +zipHeaderPipe :: + forall a m r . + Monad m + => Pipe (Vector a) (Vector (a, a)) m r + +zipHeaderPipe = applyHeaderPipe vectorZip + +{- | + +=== Example + +>>> import qualified Pipes.Prelude as P +>>> r1 = listToVector ["A","B"] +>>> r2 = listToVector ["1","2"] +>>> r3 = listToVector ["3","4"] +>>> p = do { yield r1; yield r2; yield r3 } +>>> runEffect (p >-> zipHeaderWithPipe (<>) >-> P.print) +["A1","B2"] +["A3","B4"] + +-} + +zipHeaderWithPipe :: + forall a b m r . + Monad m + => (a -> a -> b) + -> Pipe (Vector a) (Vector b) m r + +zipHeaderWithPipe f = applyHeaderPipe (vectorZipWith f) diff --git a/library/DSV/IO.hs b/library/DSV/IO.hs new file mode 100644 --- /dev/null +++ b/library/DSV/IO.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.IO + ( MonadIO (liftIO), MonadThrow (throwM), MonadCatch, MonadMask + , IOMode (ReadMode) + , SafeT, runSafeT + , withFile + , Exception (displayException), throw + , Handle + ) where + +-- base +import Control.Exception (Exception (displayException), throw) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import System.IO (IOMode (ReadMode), Handle) + +-- pipes-safe +import Pipes.Safe (SafeT, runSafeT, MonadThrow (throwM), MonadCatch, MonadMask) +import Pipes.Safe.Prelude (withFile) diff --git a/library/DSV/IndexError.hs b/library/DSV/IndexError.hs new file mode 100644 --- /dev/null +++ b/library/DSV/IndexError.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-} + +module DSV.IndexError + ( TooShort (..) + , IndexError (..) + ) where + +import DSV.IO +import DSV.Prelude + +data TooShort = TooShort + deriving stock (Eq, Show) + deriving anyclass Exception + +-- | The general concept of what can go wrong when you look up something by position in a list. +data IndexError error + = IndexError_TooShort + -- ^ There is no element at that position because the list isn't long enough. + | IndexError_FieldError error + -- ^ There is something wrong with the element found at the position. + deriving stock (Eq, Show) + deriving anyclass Exception diff --git a/library/DSV/LookupError.hs b/library/DSV/LookupError.hs new file mode 100644 --- /dev/null +++ b/library/DSV/LookupError.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-} + +module DSV.LookupError + ( Missing (..) + , Duplicate (..) + , LookupError (..) + ) where + +import DSV.IO +import DSV.Prelude + +data Missing = Missing + deriving stock (Eq, Show) + deriving anyclass Exception + +data Duplicate = Duplicate + deriving stock (Eq, Show) + deriving anyclass Exception + +-- | The general concept of what can go wrong when you look up the position of a particular element in a list. +data LookupError + = LookupError_Missing -- ^ There is /no/ matching element. + | LookupError_Duplicate -- ^ There are /more than one/ matching elements. + deriving stock (Eq, Show) + deriving anyclass Exception diff --git a/library/DSV/LookupErrorUtf8.hs b/library/DSV/LookupErrorUtf8.hs new file mode 100644 --- /dev/null +++ b/library/DSV/LookupErrorUtf8.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-} + +module DSV.LookupErrorUtf8 + ( LookupErrorUtf8 (..) + ) where + +import DSV.IO +import DSV.Prelude + +-- | The general concept of what can go wrong when you look up the position of a particular element in a list. +data LookupErrorUtf8 + = LookupErrorUtf8_Missing -- ^ There is /no/ matching element. + | LookupErrorUtf8_Duplicate -- ^ There are /more than one/ matching elements. + | LookupErrorUtf8_Invalid -- ^ Found one matching element, but it is not a valid UTF-8 string. + deriving stock (Eq, Show) + deriving anyclass Exception diff --git a/library/DSV/LookupUtf8.hs b/library/DSV/LookupUtf8.hs new file mode 100644 --- /dev/null +++ b/library/DSV/LookupUtf8.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.LookupUtf8 + ( lookupTextViewUtf8, lookupStringViewUtf8 + , lookupTextViewUtf8_, lookupStringViewUtf8_ + , LookupErrorUtf8 (..) + ) where + +import DSV.ByteString +import DSV.LookupErrorUtf8 +import DSV.Prelude +import DSV.Text +import DSV.Validation +import DSV.Vector +import DSV.ViewType +import DSV.UTF8 + +lookupTextViewUtf8 :: (Text -> Bool) + -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text +lookupTextViewUtf8 = lookupViewUtf8 + +lookupTextViewUtf8_ :: (Text -> Bool) + -> View () (Vector (ByteString, ByteString)) Text +lookupTextViewUtf8_ x = discardViewError (lookupTextViewUtf8 x) + +lookupStringViewUtf8 :: (String -> Bool) + -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String +lookupStringViewUtf8 = lookupViewUtf8 + +lookupStringViewUtf8_ :: (String -> Bool) + -> View () (Vector (ByteString, ByteString)) String +lookupStringViewUtf8_ x = discardViewError (lookupStringViewUtf8 x) + +lookupViewUtf8 :: DecodeUtf8 a => (a -> Bool) + -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a +lookupViewUtf8 f = + View $ \xs -> + case filter (\(n, _) -> maybe False f (decodeUtf8Maybe n)) (toList xs) of + [] -> Failure LookupErrorUtf8_Missing + [(_, v)] -> maybe (Failure LookupErrorUtf8_Invalid) Success (decodeUtf8Maybe v) + _ -> Failure LookupErrorUtf8_Duplicate diff --git a/library/DSV/NumberViews.hs b/library/DSV/NumberViews.hs new file mode 100644 --- /dev/null +++ b/library/DSV/NumberViews.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-} +{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +module DSV.NumberViews + ( InvalidNat (..), byteStringNatView, textNatView + , byteStringNatView_, textNatView_ + , InvalidRational (..), byteStringRationalView, textRationalView + , byteStringRationalView_, textRationalView_ + , InvalidDollars (..), byteStringDollarsView, textDollarsView + , byteStringDollarsView_, textDollarsView_ + ) where + +import DSV.AttoView +import DSV.ByteString +import DSV.IO +import DSV.Numbers +import DSV.Prelude +import DSV.Text +import DSV.TextReaderView +import DSV.UTF8 +import DSV.Validation +import DSV.ViewType + +-- attoparsec +import qualified Data.Attoparsec.ByteString.Char8 + +data InvalidNat = InvalidNat + deriving stock (Eq, Show) + deriving anyclass Exception + +byteStringNatView :: View InvalidNat ByteString Natural +byteStringNatView = attoByteStringView InvalidNat p + where + p = Data.Attoparsec.ByteString.Char8.decimal + +byteStringNatView_ :: View () ByteString Natural +byteStringNatView_ = discardViewError byteStringNatView + +textNatView :: View InvalidNat Text Natural +textNatView = textReaderView InvalidNat textReadDecimal + +textNatView_ :: View () Text Natural +textNatView_ = discardViewError textNatView + +data InvalidRational = InvalidRational + deriving stock (Eq, Show) + deriving anyclass Exception + +{- | + +Read a rational number written in decimal notation. + +=== Examples + +>>> :set -XOverloadedStrings + +>>> applyView byteStringRationalView "1234" +Success (1234 % 1) + +>>> applyView byteStringRationalView "1234.567" +Success (1234567 % 1000) + +>>> applyView byteStringRationalView "12.3.4" +Failure InvalidRational + +-} + +byteStringRationalView :: View InvalidRational ByteString Rational +byteStringRationalView = + textRationalView . + overViewError (\InvalidUtf8 -> InvalidRational) utf8TextView + +byteStringRationalView_ :: View () ByteString Rational +byteStringRationalView_ = discardViewError byteStringRationalView + +{- | + +Read a rational number written in decimal notation. + +=== Examples + +>>> :set -XOverloadedStrings + +>>> applyView textRationalView "1234" +Success (1234 % 1) + +>>> applyView textRationalView "1234.567" +Success (1234567 % 1000) + +>>> applyView textRationalView "12.3.4" +Failure InvalidRational + +-} + +textRationalView :: View InvalidRational Text Rational +textRationalView = textReaderView InvalidRational textReadRational + +textRationalView_ :: View () Text Rational +textRationalView_ = discardViewError textRationalView + +data InvalidDollars = InvalidDollars + deriving stock (Eq, Show) + deriving anyclass Exception + +{- | Read a dollar amount. + +=== Examples + +>>> applyView byteStringDollarsView "$1234.567" +Success (1234567 % 1000) + +>>> applyView byteStringDollarsView "1234.567" +Failure InvalidDollars + +-} + +byteStringDollarsView :: View InvalidDollars ByteString Rational +byteStringDollarsView = + textDollarsView . + overViewError (\InvalidUtf8 -> InvalidDollars) utf8TextView + +byteStringDollarsView_ :: View () ByteString Rational +byteStringDollarsView_ = discardViewError byteStringDollarsView + +{- | Read a dollar amount. + +=== Examples + +>>> applyView textDollarsView "$1234.567" +Success (1234567 % 1000) + +>>> applyView textDollarsView "1234.567" +Failure InvalidDollars + +-} + +textDollarsView :: View InvalidDollars Text Rational +textDollarsView = + overViewError + (\InvalidRational -> InvalidDollars) + textRationalView + . + View ( + maybe (Failure InvalidDollars) Success . + textStripPrefix "$" + ) + +textDollarsView_ :: View () Text Rational +textDollarsView_ = discardViewError textDollarsView diff --git a/library/DSV/Numbers.hs b/library/DSV/Numbers.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Numbers.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module DSV.Numbers + ( fromIntegerMaybe + , Natural + , ArithException (..) + , Positive (..), natPositive, positiveNat, positiveInt + ) where + +import DSV.IO +import DSV.Prelude + +-- base +import Control.Exception (ArithException (..)) +import Numeric.Natural (Natural) + +fromIntegerMaybe :: + forall n . + (Bounded n, Integral n) + => Integer -> Maybe n + +fromIntegerMaybe i + | i < toInteger (minBound @n) = Nothing + | i > toInteger (maxBound @n) = Nothing + | otherwise = Just (fromInteger @n i) + +newtype Positive = Positive Natural + deriving newtype (Eq, Ord, Show) + +natPositive :: Natural -> Positive +natPositive = + \case + 0 -> throw Underflow + n -> Positive n + +positiveNat :: Positive -> Natural +positiveNat (Positive n) = n + +positiveInt :: Positive -> Int +positiveInt (Positive n) = fromIntegral n + +instance Num Positive + where + fromInteger n | n < 1 = throw Underflow + | True = Positive (fromInteger n) + + Positive x + Positive y = Positive (x + y) + Positive x - Positive y = natPositive (x - y) + Positive x * Positive y = Positive (x * y) + + negate _ = throw Underflow + abs = id + signum _ = 1 diff --git a/library/DSV/ParseError.hs b/library/DSV/ParseError.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ParseError.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.ParseError + ( ParseError (..) + ) where + +import DSV.IO +import DSV.Prelude + +data ParseError = + ParseError + deriving (Eq, Show) + +instance Exception ParseError + where + displayException ParseError = "DSV parse error" diff --git a/library/DSV/ParseStop.hs b/library/DSV/ParseStop.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ParseStop.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.ParseStop + ( ParseStop (..) + ) where + +import DSV.Prelude + +data ParseStop + = ParseComplete + | ParseIncomplete + deriving (Eq, Show) diff --git a/library/DSV/Parsing.hs b/library/DSV/Parsing.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Parsing.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Parsing + ( dsvRowAtto + , dsvRowPipe, csvRowPipe + , handleCsvRowProducer, handleDsvRowProducer + ) where + +import DSV.AttoParser +import DSV.AttoPipe +import DSV.ByteString +import DSV.CommonDelimiters +import DSV.IO +import DSV.ParseError +import DSV.ParseStop +import DSV.Pipes +import DSV.Prelude +import DSV.Vector + +-- attoparsec +import Data.Attoparsec.ByteString.Char8 (endOfLine) + +-- cassava +import qualified Data.Csv.Parser as Cassava + +dsvRowAtto :: + Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> AttoParser (Vector ByteString) + +dsvRowAtto d = + Cassava.record (delimiterWord8 d) <* endOfLine + +-- | Like 'csvRowPipe', but allows customizing the delimiter. + +dsvRowPipe :: + forall m . + Monad m + => Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> Pipe ByteString (Vector ByteString) m ParseError + +dsvRowPipe d = + attoPipe (dsvRowAtto d) + +-- | This pipe 'await's @ByteString@ input read from a CSV file, parses the input, and 'yield's a @'Vector' 'ByteString'@ for each row in the CSV file. If this pipe reaches some portion of the input that is not formatted correctly and cannot parse any further, the pipe terminates and 'return's a 'ParseError'. + +csvRowPipe :: + forall m . + Monad m + => Pipe ByteString (Vector ByteString) m ParseError + +csvRowPipe = + attoPipe (dsvRowAtto comma) + +handleCsvRowProducer :: + forall m . + MonadIO m + => Handle -- ^ File handle to read CSV data from + -> Producer (Vector ByteString) m ParseStop + +handleCsvRowProducer h = + handleDsvRowProducer comma h + +handleDsvRowProducer :: + forall m . + MonadIO m + => Delimiter -- ^ What character separates input values, e.g. 'comma' or 'tab' + -> Handle -- ^ File handle to read DSV data from + -> Producer (Vector ByteString) m ParseStop + +handleDsvRowProducer d h = + handleAttoProducer (dsvRowAtto d) h diff --git a/library/DSV/Pipes.hs b/library/DSV/Pipes.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Pipes.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Pipes + ( Pipe, Producer, Consumer, Effect + , yield, await, (>->), lift, runEffect + , count + ) where + +import DSV.Numbers +import DSV.Prelude + +-- pipes +import Pipes (Proxy, lift, next, await, yield, runEffect) +import qualified Pipes + +-- | Use @>->@ to build an 'Effect': a pipeline consisting of a 'Producer' at the beginning, any number of 'Pipe's in the middle, and a 'Consumer' at the end. +(>->) :: Monad m => Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r +(>->) = (Pipes.>->) + +type Producer b m r = Pipes.Producer b m r + +type Pipe a b m r = Pipes.Pipe a b m r + +type Consumer a m r = Pipes.Consumer a m r + +type Effect m r = Pipes.Effect m r + +count :: + forall a m r . + Monad m + => Producer a m r + -> Producer a m (Natural, r) + +count = go 0 + where + go n p = + lift (next p) >>= + \case + Left r -> return (n, r) + Right (a, p') -> yield a *> go (n + 1) p' diff --git a/library/DSV/Position.hs b/library/DSV/Position.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Position.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass, GeneralizedNewtypeDeriving #-} + +module DSV.Position + ( RowNumber (..) + , ColumnNumber (..) + , ColumnName (..) + , Position (..) + , At (..) + , AtHeader (..) + ) where + +import DSV.IO +import DSV.Numbers +import DSV.Prelude + +newtype RowNumber = + RowNumber Positive + deriving stock (Eq, Ord) + deriving newtype (Num, Show) + +newtype ColumnNumber = + ColumnNumber Positive + deriving stock (Eq, Ord) + deriving newtype (Num, Show) + +newtype ColumnName str = + ColumnName str + deriving stock (Eq, Ord, Show) + +data Position row col = + Position row col + deriving stock (Eq, Ord, Show) + +data At p a = At p {- ^ Position -} a + deriving stock (Eq, Ord, Show) + deriving anyclass Exception + +data AtHeader a = AtHeader a + deriving stock (Eq, Ord, Show) + deriving anyclass Exception diff --git a/library/DSV/Prelude.hs b/library/DSV/Prelude.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Prelude.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.Prelude (module Prelude) where + +import Prelude hiding ((.), id, init) +import Control.Category as Prelude ((.), id, (>>>), (<<<)) +import Data.Coerce as Prelude +import Data.Foldable as Prelude (toList) +import Data.Functor as Prelude (void) +import Data.Functor.Compose as Prelude (Compose (Compose)) +import Data.Typeable as Prelude (Typeable) diff --git a/library/DSV/RequireCompleteParse.hs b/library/DSV/RequireCompleteParse.hs new file mode 100644 --- /dev/null +++ b/library/DSV/RequireCompleteParse.hs @@ -0,0 +1,17 @@ +module DSV.RequireCompleteParse + ( requireCompleteParse + , completely + ) where + +import DSV.IO +import DSV.ParseError +import DSV.ParseStop + +requireCompleteParse :: MonadThrow m => (ParseStop, a) -> m a +requireCompleteParse (s, x) = + case s of + ParseComplete -> pure x + ParseIncomplete -> throwM ParseError + +completely :: MonadThrow m => m (ParseStop, a) -> m a +completely x = x >>= requireCompleteParse diff --git a/library/DSV/Text.hs b/library/DSV/Text.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Text.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Text + ( Text + , stringToText, textToString + , textNull, textStripPrefix + , TextReader, textReadMaybe, textReadRational, textReadDecimal + ) where + +import DSV.Numbers +import DSV.Prelude + +-- text +import Data.Text (Text) +import qualified Data.Text +import qualified Data.Text.Read + +stringToText :: String -> Text +stringToText = Data.Text.pack + +textToString :: Text -> String +textToString = Data.Text.unpack + +textNull :: Text -> Bool +textNull = Data.Text.null + +textStripPrefix :: Text -> Text -> Maybe Text +textStripPrefix = Data.Text.stripPrefix + +type TextReader a = Data.Text.Read.Reader a + +textReadMaybe :: + forall a . + TextReader a -> Text -> Maybe a + +textReadMaybe f t = + case f t of + Right (x, r) | textNull r -> Just x + _ -> Nothing + +textReadRational :: TextReader Rational +textReadRational = Data.Text.Read.rational + +textReadDecimal :: TextReader Natural +textReadDecimal = Data.Text.Read.decimal diff --git a/library/DSV/TextReaderView.hs b/library/DSV/TextReaderView.hs new file mode 100644 --- /dev/null +++ b/library/DSV/TextReaderView.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.TextReaderView + ( textReaderView + , textReaderView_ + ) where + +import DSV.Prelude +import DSV.Text +import DSV.Validation +import DSV.ViewType + +textReaderView :: e -> TextReader a -> View e Text a +textReaderView e r = + View $ \txt -> + case (textReadMaybe r txt) of + Nothing -> Failure e + Just x -> Success x + +textReaderView_ :: TextReader a -> View () Text a +textReaderView_ r = + View $ \txt -> + case (textReadMaybe r txt) of + Nothing -> Failure () + Just x -> Success x diff --git a/library/DSV/UTF8.hs b/library/DSV/UTF8.hs new file mode 100644 --- /dev/null +++ b/library/DSV/UTF8.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} + +module DSV.UTF8 + ( EncodeUtf8 (..) + , DecodeUtf8 (..) + , InvalidUtf8 (..) + , utf8View, utf8TextView, encodeTextUtf8, utf8TextMaybe + ) where + +import DSV.ByteString +import DSV.IO +import DSV.Prelude +import DSV.Validation +import DSV.ViewType + +-- text +import Data.Text (Text) +import qualified Data.Text +import qualified Data.Text.Encoding + + +--- Encode --- + +class EncodeUtf8 a + where + encodeUtf8 :: a -> ByteString + +instance EncodeUtf8 Text + where + encodeUtf8 = + Data.Text.Encoding.encodeUtf8 + +instance EncodeUtf8 [Char] + where + encodeUtf8 = + Data.Text.Encoding.encodeUtf8 . + Data.Text.pack + + +--- Decode --- + +class DecodeUtf8 a + where + decodeUtf8Maybe :: ByteString -> Maybe a + +instance DecodeUtf8 Text + where + decodeUtf8Maybe = + rightMaybe . + Data.Text.Encoding.decodeUtf8' + +instance DecodeUtf8 [Char] + where + decodeUtf8Maybe = + fmap Data.Text.unpack . + rightMaybe . + Data.Text.Encoding.decodeUtf8' + + +--- Views --- + +data InvalidUtf8 = InvalidUtf8 + deriving stock (Eq, Show) + deriving anyclass Exception + +utf8View :: DecodeUtf8 txt => View InvalidUtf8 ByteString txt +utf8View = + View $ \x -> + case decodeUtf8Maybe x of + Nothing -> Failure InvalidUtf8 + Just y -> Success y + +-- | Decode a byte string as UTF-8 text, failing with 'Nothing' if the decoding fails. +utf8TextMaybe :: ByteString -> Maybe Text +utf8TextMaybe = decodeUtf8Maybe @Text + +utf8TextView :: View InvalidUtf8 ByteString Text +utf8TextView = utf8View @Text + +encodeTextUtf8 :: Text -> ByteString +encodeTextUtf8 = encodeUtf8 @Text + +rightMaybe :: Either a b -> Maybe b +rightMaybe = either (const Nothing) Just diff --git a/library/DSV/Validation.hs b/library/DSV/Validation.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Validation.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE LambdaCase #-} + +module DSV.Validation + ( Validation (Success, Failure) + , overFailure + ) where + +-- validation +import Data.Validation + +overFailure :: (e1 -> e2) -> Validation e1 a -> Validation e2 a +overFailure f = + \case + Failure e -> Failure (f e) + Success x -> Success x diff --git a/library/DSV/Vector.hs b/library/DSV/Vector.hs new file mode 100644 --- /dev/null +++ b/library/DSV/Vector.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.Vector + ( Vector + , vectorIndexInt, vectorIndexNat, vectorIndexInteger, nthVectorElement + , vectorLookup + , vectorZip, vectorZipWith + , listToVector, vectorToList + , emptyVector + ) where + +import DSV.Numbers +import DSV.Prelude + +-- base +import Control.Monad ((>=>)) + +-- vector +import qualified Data.Vector as Vector + +type Vector = Vector.Vector + +vectorIndexInt :: forall a . Vector a -> Int -> Maybe a +vectorIndexInt = (Vector.!?) + +vectorIndexNat :: forall a. Vector a -> Natural -> Maybe a +vectorIndexNat xs n = vectorIndexInt xs (fromIntegral n) + +vectorIndexInteger :: + forall a . + Vector a -> Integer -> Maybe a + +vectorIndexInteger xs = + fromIntegerMaybe >=> vectorIndexInt xs + +vectorZip :: + forall a b . + Vector a -> Vector b -> Vector (a, b) + +vectorZip = Vector.zip + +vectorZipWith :: + forall a b c . + (a -> b -> c) -> Vector a -> Vector b -> Vector c + +vectorZipWith = Vector.zipWith + +{- | + +=== Examples + + * @nthVectorElement 0 ["a", "b", "c"] = Nothing@ + * @nthVectorElement 1 ["a", "b", "c"] = Just "a"@ + * @nthVectorElement 2 ["a", "b", "c"] = Just "b"@ + * @nthVectorElement 3 ["a", "b", "c"] = Just "c"@ + * @nthVectorElement 4 ["a", "b", "c"] = Nothing@ + +-} + +nthVectorElement :: forall a . Integer -> Vector a -> Maybe a +nthVectorElement n xs = vectorIndexInteger xs (n - 1) + +vectorLookup :: + forall name value . + (name -> Bool) + -> Vector (name, value) + -> Maybe value + +vectorLookup f xs = + case filter (\(n, _) -> f n) (toList xs) of + [(_, v)] -> Just v + _ -> Nothing + +listToVector :: forall a . [a] -> Vector a +listToVector = Vector.fromList + +vectorToList :: forall a . Vector a -> [a] +vectorToList = toList + +emptyVector :: forall a . Vector a +emptyVector = Vector.empty diff --git a/library/DSV/VectorViews.hs b/library/DSV/VectorViews.hs new file mode 100644 --- /dev/null +++ b/library/DSV/VectorViews.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.VectorViews + ( columnNumberView, lookupView + , columnNumberView_, lookupView_ + ) where + +import DSV.IndexError +import DSV.LookupError +import DSV.Numbers +import DSV.Position +import DSV.Prelude +import DSV.Validation +import DSV.Vector +import DSV.ViewType + +columnNumberView :: forall a. + ColumnNumber -> View TooShort (Vector a) a + +columnNumberView (ColumnNumber n) = + View $ \xs -> + case vectorIndexInt xs (positiveInt n - 1) of + Nothing -> Failure TooShort + Just x -> Success x + +columnNumberView_ :: forall a. + ColumnNumber -> View () (Vector a) a + +columnNumberView_ x = discardViewError (columnNumberView x) + +lookupView :: + (a -> Bool) + -> View LookupError (Vector (a, b)) b + +lookupView f = + View $ \xs -> + case filter (\(n, _) -> f n) (toList xs) of + [] -> Failure LookupError_Missing + [(_, v)] -> Success v + _ -> Failure LookupError_Duplicate + +lookupView_ :: + (a -> Bool) + -> View () (Vector (a, b)) b + +lookupView_ x = discardViewError (lookupView x) diff --git a/library/DSV/ViewType.hs b/library/DSV/ViewType.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ViewType.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DerivingStrategies, DeriveFunctor, DerivingVia, StandaloneDeriving #-} + +module DSV.ViewType + ( View (..), overViewError, inputAsViewError, applyView, viewOrThrow, viewOrThrowInput, constView, maybeView, viewMaybe, viewOr, viewOr' + , discardViewError, (>>>-), (<<<-) + ) where + +import DSV.IO +import DSV.Prelude +import DSV.Validation + +-- base +import Control.Arrow +import Control.Category + +newtype View e a b = View (a -> Validation e b) + deriving stock Functor + +deriving via Compose ((->) a) (Validation e) + instance Semigroup e => Applicative (View e a) + +instance Category (View e) + where + id = View Success + + View f . View g = + View $ \x -> + case g x of + Failure e -> Failure e + Success y -> f y + +instance Arrow (View e) + where + arr f = View (Success . f) + + first (View f) = + View $ \(x, y) -> + case f x of + Failure e -> Failure e + Success z -> Success (z, y) + + second (View f) = + View $ \(x, y) -> + case f y of + Failure e -> Failure e + Success z -> Success (x, z) + +applyView :: forall e a b . + View e a b -> a -> Validation e b + +applyView (View f) x = f x + +viewOrThrow :: forall m e a b. + (Exception e, MonadThrow m) => + View e a b -> a -> m b + +viewOrThrow (View f) x = + case f x of + Failure e -> throwM e + Success y -> pure y + +viewMaybe :: forall e a b . + View e a b -> a -> Maybe b + +viewMaybe v x = + case applyView v x of + Success y -> Just y + Failure _ -> Nothing + +viewOr :: forall e a b . + b -> View e a b -> a -> b + +viewOr z v x = + case applyView v x of + Success y -> y + Failure _ -> z + +viewOr' :: forall m e a b . + Applicative m => + (a -> e -> m b) + -> View e a b + -> a + -> m b + +viewOr' f v a = + case applyView v a of + Failure e -> f a e + Success b -> pure b + +viewOrThrowInput :: forall m ex e a b . + (Exception ex, MonadThrow m) => + (a -> ex) + -> View e a b + -> a + -> m b + +viewOrThrowInput f v a = + case applyView v a of + Failure _ -> throwM (f a) + Success b -> pure b + +constView :: forall e a b . + b -> View e a b + +constView x = View (\_ -> Success x) + +maybeView :: forall a b. + (a -> Maybe b) + -> View () a b + +maybeView f = View (maybe (Failure ()) Success . f) + +overViewError :: forall e1 e2 a b . + (e1 -> e2) -> View e1 a b -> View e2 a b + +overViewError f (View v) = + View $ \x -> + case v x of + Failure e -> Failure (f e) + Success s -> Success s + +inputAsViewError :: forall e a b. View e a b -> View a a b +inputAsViewError (View v) = + View $ \x -> + case v x of + Failure _ -> Failure x + Success s -> Success s + +discardViewError :: View e a b -> View () a b + +discardViewError = overViewError (\_ -> ()) + +(<<<-) :: View e1 b c -> View e2 a b -> View () a c +f <<<- g = discardViewError f <<< discardViewError g + +(>>>-) :: View e2 a b -> View e1 b c -> View () a c +f >>>- g = discardViewError f >>> discardViewError g diff --git a/library/DSV/ZipViewError.hs b/library/DSV/ZipViewError.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViewError.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.ZipViewError + ( ZipViewError (..) + ) where + +data ZipViewError headerError = + + ZipViewError_Empty + -- ^ The input contained no rows, not even a header. + + | ZipViewError_HeaderError headerError + -- ^ There is some problem with the header that would prevent us from interpreting the subsequent rows. diff --git a/library/DSV/ZipViewFold.hs b/library/DSV/ZipViewFold.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViewFold.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.ZipViewFold + ( zipViewFold, zipViewFoldM + ) where + +import DSV.ByteString +import DSV.Fold +import DSV.Prelude +import DSV.Validation +import DSV.Vector +import DSV.ViewType +import DSV.ZipViewError +import DSV.ZipViewType + +zipViewFold :: + forall headerError rowError row result . + ZipView headerError rowError row + -> Fold (Validation rowError row) result + -> Fold (Vector ByteString) (Validation (ZipViewError headerError) result) + +zipViewFold (ZipView v1) (Fold step init done) = Fold step' Init done' + where + step' = \case Init -> \x -> case applyView v1 x of Failure e -> Fail e + Success v2 -> Go v2 init + Fail e -> \_ -> Fail e + Go v2 acc -> \x -> Go v2 (step acc (applyView v2 x)) + + done' = \case Init -> Failure ZipViewError_Empty + Fail e -> Failure (ZipViewError_HeaderError e) + Go _ acc -> Success (done acc) + +zipViewFoldM :: + forall m headerError rowError row result . + Monad m => + ZipView headerError rowError row + -> FoldM m (Validation rowError row) result + -> FoldM m (Vector ByteString) (Validation (ZipViewError headerError) result) + +zipViewFoldM (ZipView v1) (FoldM step init done) = FoldM step' (return Init) done' + where + step' = \case Init -> \x -> case applyView v1 x of Failure e -> return (Fail e) + Success v2 -> Go v2 <$> init + Fail e -> \_ -> return (Fail e) + Go v2 acc -> \x -> Go v2 <$> step acc (applyView v2 x) + + done' = \case Init -> return (Failure ZipViewError_Empty) + Fail e -> return (Failure (ZipViewError_HeaderError e)) + Go _ acc -> Success <$> done acc + +data State headerError rowError row acc = + Init + | Fail headerError + | Go (View rowError (Vector ByteString) row) acc diff --git a/library/DSV/ZipViewPipe.hs b/library/DSV/ZipViewPipe.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViewPipe.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DSV.ZipViewPipe + ( zipViewPipe + , zipViewPipeIgnoringAllErrors + , zipViewPipeThrowFirstError + ) where + +import DSV.ByteString +import DSV.IO +import DSV.Pipes +import DSV.Position +import DSV.Prelude +import DSV.Validation +import DSV.Vector +import DSV.ViewType +import DSV.ZipViewType + +-- pipes +import qualified Pipes.Prelude as P + +zipViewPipe :: + forall m headerError rowError row . + Monad m + => ZipView headerError rowError row + -- ^ A specification of how to interpret the header and rows + -> Pipe (Vector ByteString) (Validation rowError row) m headerError + -- ^ The first vector that this pipe 'await's is the header. If the header is invalid, the pipe closes and 'return's the @headerError@. Otherwise, the pipe continues indefinitely; for each subsequent @'Vector' 'ByteString'@, it 'yield's one @'Validation' rowError row@. + +zipViewPipe (ZipView (View f)) = + do + header <- await + case (f header) of + Failure err -> return err + Success (View g) -> P.map g + +zipViewPipeIgnoringAllErrors :: + forall m headerError rowError row . + Monad m + => ZipView headerError rowError row + -- ^ A specification of how to interpret the header and rows + -> Pipe (Vector ByteString) row m () + -- ^ The first vector that this pipe 'await's is the header. If the header is invalid, the pipe closes and 'return's @()@. Otherwise, the pipe continues indefinitely; for each subsequent @'Vector' 'ByteString'@, it 'yield's a @row@ if the row is valid, or otherwise does nothing if the row is malformed. + +zipViewPipeIgnoringAllErrors (ZipView (View f)) = + do + header <- await + case (f header) of + Failure _ -> return () + Success (View g) -> P.mapFoldable g + +zipViewPipeThrowFirstError :: + forall m headerError rowError row r . + ( Monad m, MonadThrow m + , Exception headerError + , Show rowError, Typeable rowError + ) + => ZipView headerError rowError row + -- ^ A specification of how to interpret the header and rows + -> Pipe (Vector ByteString) row m r + -- ^ The first vector that this pipe 'await's is the header. If the header is invalid, the pipe throws the @headerError@ as an exception in @m@. For each subsequent @'Vector' 'ByteString'@, the pipe 'yield's a @row@ if the row is valid, or otherwise throws the @rowError@ as an exception in @m@. + +zipViewPipeThrowFirstError (ZipView (View f)) = + do + header <- await + case (f header) of + Failure e -> throwM e + Success v -> go v (RowNumber 1) + where + go v (RowNumber n) = + do + x <- await + case applyView v x of + Failure e -> throwM (At (RowNumber n) e) + Success row -> + do + yield row + go v (RowNumber (n + 1)) diff --git a/library/DSV/ZipViewStop.hs b/library/DSV/ZipViewStop.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViewStop.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.ZipViewStop + ( ZipViewStop (..) + ) where + +import DSV.Prelude + +-- | A description of what prompted the program to stop reading a DSV file with a header. This is similar to 'ParseStop', but includes some additional header-specific concerns. + +data ZipViewStop headerError = + + ZipViewEmpty + -- ^ The input contained no rows, not even a header. + + | ZipViewComplete + -- ^ All of the input was consumed. + + | ZipViewParseError + -- ^ The parsing stopped where the data was malformed. + + | ZipViewHeaderError headerError + -- ^ There is some problem with the header that would prevent us from interpreting the subsequent rows. + + deriving (Eq, Show) diff --git a/library/DSV/ZipViewType.hs b/library/DSV/ZipViewType.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViewType.hs @@ -0,0 +1,93 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DerivingStrategies, DeriveFunctor, DerivingVia, StandaloneDeriving #-} + +module DSV.ZipViewType + ( ZipView (..), refineZipView + , overHeaderError, overRowError, overZipViewError + ) where + +import DSV.ByteString +import DSV.Prelude +import DSV.Validation +import DSV.ViewType +import DSV.Vector + +-- base +import Data.Functor.Compose (Compose (Compose)) + +{- | + +'ZipView' captures a common pattern for consuming a DSV file with a header row: First we have one 'View' that looks at the header row, and from that we determine how to view the subsequent rows of data. We use that second 'View' to interpret each row. + +For example, if we want to read the \"Date" and \"Price" columns, when we read the header we may see that these are the first and third columns, respectively; and so the first 'View' will return a 'View' that reads the first and third column of each row. + +=== Errors + +There are two distinct modes of failure in this process, represented by the two type parameters @headerError@ and @rowError@. + +- A 'Failure' of the @headerError@ type is produced by the first 'View' if the header is malformed in a way that prevents us from being able to read the data rows - for example, if we want to read the \"Date" column but the header does not contain any entry with that name. + +- A 'Failure' of the @rowError@ type is produced by the second 'View' for each malformed row - for example, if \"Price" is the third column but the row only contains two entries, or if we require the entry to contain a dollar amount but it contains some other unrecognizable string. + +Note that header errors which are unrecoverable, whereas it is possible to continue past row errors and get a mixture of 'Failure' and 'Success' results among the rows. + +-} + +newtype ZipView headerError rowError a = + ZipView + (View headerError (Vector ByteString) + (View rowError (Vector ByteString) a)) + deriving stock Functor + +-- | 'ZipView' has an 'Applicative' but no 'Monad', so you may wish to enable the @ApplicativeDo@ GHC extension. + +deriving via + Compose + (View headerError (Vector ByteString)) + (View rowError (Vector ByteString)) + instance + (Semigroup headerError, Semigroup rowError) => + Applicative (ZipView headerError rowError) + +refineZipView :: + forall headerError rowError a b . + ZipView headerError rowError a + -- ^ A view that produces a value of type @a@ for each row. + -> View rowError a b + -- ^ A way to interpret that @a@ value as a different type @b@. + -> ZipView headerError rowError b + -- ^ A view that produces a value of type @b@ for each row. + +refineZipView (ZipView (View f)) r2 = + ZipView $ + View $ + fmap (r2 .) . f + +overHeaderError :: + (headerError1 -> headerError2) -> + ZipView headerError1 rowError a -> + ZipView headerError2 rowError a + +overHeaderError f (ZipView v) = + ZipView (overViewError f v) + +overRowError :: + (rowError1 -> rowError2) -> + ZipView headerError rowError1 a -> + ZipView headerError rowError2 a + +overRowError f (ZipView v) = + ZipView (fmap (overViewError f) v) + +overZipViewError :: + forall headerError1 headerError2 rowError1 rowError2 a . + (headerError1 -> headerError2) -> (rowError1 -> rowError2) + -> ZipView headerError1 rowError1 a + -> ZipView headerError2 rowError2 a + +overZipViewError f g = + overRowError g . + overHeaderError f diff --git a/library/DSV/ZipViews.hs b/library/DSV/ZipViews.hs new file mode 100644 --- /dev/null +++ b/library/DSV/ZipViews.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} + +module DSV.ZipViews + ( byteStringZipView, byteStringZipViewPosition + , textZipViewUtf8, textZipViewUtf8' + , entireRowZipView + ) where + +import DSV.ByteString +import DSV.IndexError +import DSV.LookupError +import DSV.Numbers +import DSV.Position +import DSV.Prelude +import DSV.Text +import DSV.UTF8 +import DSV.Validation +import DSV.Vector +import DSV.ViewType +import DSV.ZipViewType + +-- base +import qualified Data.List as List + +byteStringZipView + :: ByteString + -> ZipView LookupError TooShort ByteString + +byteStringZipView name = + (ZipView . View) $ \header -> + case List.findIndices (== name) (toList header) of + [] -> Failure LookupError_Missing + [i] -> withI i + _ -> Failure LookupError_Duplicate + where + withI i = + (Success . View) $ \row -> + case vectorIndexInt row i of + Nothing -> Failure TooShort + Just x -> Success x + +textZipViewUtf8 :: + forall e a . + Text + -> View e ByteString a + -> ZipView + (At (ColumnName Text) LookupError) + (At (ColumnName Text) (IndexError e)) + a + +textZipViewUtf8 name fieldView = + (overZipViewError at at . ZipView . View) $ \header -> + case List.findIndices (== encodeUtf8 name) (toList header) of + [] -> Failure LookupError_Missing + [i] -> withI i + _ -> Failure LookupError_Duplicate + + where + at = At (ColumnName name) + withI i = + (Success . View) $ \row -> + case vectorIndexInt row i of + Nothing -> Failure IndexError_TooShort + Just x -> applyView (overViewError IndexError_FieldError fieldView) x + +textZipViewUtf8' :: + Text + -> ZipView + (At (ColumnName Text) LookupError) + (At (ColumnName Text) TooShort) + ByteString + +textZipViewUtf8' name = + (overZipViewError at at . ZipView . View) $ \header -> + case List.findIndices (== encodeUtf8 name) (toList header) of + [] -> Failure LookupError_Missing + [i] -> withI i + _ -> Failure LookupError_Duplicate + where + at = At (ColumnName name) + withI i = + (Success . View) $ \row -> + case vectorIndexInt row i of + Nothing -> Failure TooShort + Just x -> Success x + +byteStringZipViewPosition :: + forall headerError . + ColumnNumber + -> ZipView headerError TooShort ByteString + +byteStringZipViewPosition (ColumnNumber (Positive n)) = + (ZipView . View) $ \_header -> + (Success . View) $ \row -> + case vectorIndexNat row (n - 1) of + Nothing -> Failure TooShort + Just x -> Success x + +entireRowZipView :: forall he re . ZipView he re (Vector ByteString) +entireRowZipView = ZipView (constView id) diff --git a/license.txt b/license.txt new file mode 100644 --- /dev/null +++ b/license.txt @@ -0,0 +1,18 @@ +Copyright 2019-2020 Typeclass Consulting, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/test-data/doc-example-malformed-with-header.csv b/test-data/doc-example-malformed-with-header.csv new file mode 100644 --- /dev/null +++ b/test-data/doc-example-malformed-with-header.csv @@ -0,0 +1,4 @@ +Date,Vendor,Price,Product +2019-03-24,Acme Co,$599.89,Dehydrated boulders +2019-03-29,Store Mart,"$"8.14,Coffee beans +2019-04-18,Acme Co,$24.95,Earthquake pills diff --git a/test-data/doc-example-malformed-without-header.csv b/test-data/doc-example-malformed-without-header.csv new file mode 100644 --- /dev/null +++ b/test-data/doc-example-malformed-without-header.csv @@ -0,0 +1,3 @@ +2019-03-24,Acme Co,$599.89,Dehydrated boulders +2019-03-29,Store Mart,"$"8.14,Coffee beans +2019-04-18,Acme Co,$24.95,Earthquake pills diff --git a/test-data/doc-example-with-header.csv b/test-data/doc-example-with-header.csv new file mode 100644 --- /dev/null +++ b/test-data/doc-example-with-header.csv @@ -0,0 +1,3 @@ +Date,Vendor,Price,Product +2019-03-24,Acme Co,$599.89,Dehydrated boulders +2019-04-18,Acme Co,$24.95,Earthquake pills diff --git a/test-data/doc-example-with-utf8-errors.csv b/test-data/doc-example-with-utf8-errors.csv new file mode 100644 --- /dev/null +++ b/test-data/doc-example-with-utf8-errors.csv @@ -0,0 +1,3 @@ +Date,Vendor,Price,Product +2019-03-24,Acme Co,$599.89,DehydraÃ(d boulders +2019-04-18,Ã(me Co,$24.95,Earthquake pills diff --git a/test-data/doc-example-without-header.csv b/test-data/doc-example-without-header.csv new file mode 100644 --- /dev/null +++ b/test-data/doc-example-without-header.csv @@ -0,0 +1,2 @@ +2019-03-24,Acme Co,$599.89,Dehydrated boulders +2019-04-18,Acme Co,$24.95,Earthquake pills diff --git a/test-data/empty.csv b/test-data/empty.csv new file mode 100644 --- /dev/null +++ b/test-data/empty.csv diff --git a/test-data/tweets-with-duplicate-header.csv b/test-data/tweets-with-duplicate-header.csv new file mode 100644 --- /dev/null +++ b/test-data/tweets-with-duplicate-header.csv @@ -0,0 +1,6 @@ +tweet_id,in_reply_to_status_id,in_reply_to_user_id,timestamp,source,timestamp,retweeted_status_id,retweeted_status_user_id,retweeted_status_timestamp,expanded_urls +1145722305135423488,,,2019-07-01 15:54:18 +0000,"TweetDeck","stack overflow should just permaban you if you say the word ""efficient"" to somebody whose code still doesn't give correct results",,,, +1144834283204415488,,,2019-06-29 05:05:37 +0000,"TweetDeck",INI files are extremely underrated IMO,,,, +1144470003963420672,,,2019-06-28 04:58:06 +0000,"TweetDeck",I'll listen to any song that has a trumpet solo in the middle,,,, +1143630783963389954,,,2019-06-25 21:23:21 +0000,"TweetDeck","just accidentally typed ""the Python Report"" instead of ""the Python documentation""",,,, +1143602240722210823,,,2019-06-25 19:29:55 +0000,"TweetDeck",I doubt a take about why a programming language is the best one has ever elicited action... point out a single cool feature or use that can catch someone's interest,,,, diff --git a/test-data/tweets-with-id-error.csv b/test-data/tweets-with-id-error.csv new file mode 100644 --- /dev/null +++ b/test-data/tweets-with-id-error.csv @@ -0,0 +1,6 @@ +tweet_id,in_reply_to_status_id,in_reply_to_user_id,timestamp,source,text,retweeted_status_id,retweeted_status_user_id,retweeted_status_timestamp,expanded_urls +1145722305135423488,,,2019-07-01 15:54:18 +0000,"TweetDeck","stack overflow should just permaban you if you say the word ""efficient"" to somebody whose code still doesn't give correct results",,,, +1144834283204415488,,,2019-06-29 05:05:37 +0000,"TweetDeck",INI files are extremely underrated IMO,,,, +114447000r963420672,,,2019-06-28 04:58:06 +0000,"TweetDeck",I'll listen to any song that has a trumpet solo in the middle,,,, +1143630783963389954,,,2019-06-25 21:23:21 +0000,"TweetDeck","just accidentally typed ""the Python Report"" instead of ""the Python documentation""",,,, +1143602240722210823,,,2019-06-25 19:29:55 +0000,"TweetDeck",I doubt a take about why a programming language is the best one has ever elicited action... point out a single cool feature or use that can catch someone's interest,,,, diff --git a/test-data/tweets.csv b/test-data/tweets.csv new file mode 100644 --- /dev/null +++ b/test-data/tweets.csv @@ -0,0 +1,6 @@ +tweet_id,in_reply_to_status_id,in_reply_to_user_id,timestamp,source,text,retweeted_status_id,retweeted_status_user_id,retweeted_status_timestamp,expanded_urls +1145722305135423488,,,2019-07-01 15:54:18 +0000,"TweetDeck","stack overflow should just permaban you if you say the word ""efficient"" to somebody whose code still doesn't give correct results",,,, +1144834283204415488,,,2019-06-29 05:05:37 +0000,"TweetDeck",INI files are extremely underrated IMO,,,, +1144470003963420672,,,2019-06-28 04:58:06 +0000,"TweetDeck",I'll listen to any song that has a trumpet solo in the middle,,,, +1143630783963389954,,,2019-06-25 21:23:21 +0000,"TweetDeck","just accidentally typed ""the Python Report"" instead of ""the Python documentation""",,,, +1143602240722210823,,,2019-06-25 19:29:55 +0000,"TweetDeck",I doubt a take about why a programming language is the best one has ever elicited action... point out a single cool feature or use that can catch someone's interest,,,, diff --git a/test/DSV/TestData/Tweets.hs b/test/DSV/TestData/Tweets.hs new file mode 100644 --- /dev/null +++ b/test/DSV/TestData/Tweets.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE OverloadedStrings #-} + +module DSV.TestData.Tweets where + +import Data.Text (Text) + +tweetsHeader, tweet1, tweet2, tweet3, tweet4, tweet5 :: [Text] + +tweet1_labeled, tweet2_labeled, tweet3_labeled, tweet4_labeled, tweet5_labeled :: [(Text, Text)] + +labeled = (,) + +tweetsHeader = + [ "tweet_id" + , "in_reply_to_status_id" + , "in_reply_to_user_id" + , "timestamp" + , "source" + , "text" + , "retweeted_status_id" + , "retweeted_status_user_id" + , "retweeted_status_timestamp" + , "expanded_urls" + ] + +tweet1 = + [ "1145722305135423488" + , "" + , "" + , "2019-07-01 15:54:18 +0000" + , "TweetDeck" + , "stack overflow should just permaban you if you say the word \"efficient\" to somebody whose code still doesn't give correct results" + , "" + , "" + , "" + , "" + ] + +tweet1_labeled = + [ labeled "tweet_id" "1145722305135423488" + , labeled "in_reply_to_status_id" "" + , labeled "in_reply_to_user_id" "" + , labeled "timestamp" "2019-07-01 15:54:18 +0000" + , labeled "source" "TweetDeck" + , labeled "text" "stack overflow should just permaban you if you say the word \"efficient\" to somebody whose code still doesn't give correct results" + , labeled "retweeted_status_id" "" + , labeled "retweeted_status_user_id" "" + , labeled "retweeted_status_timestamp" "" + , labeled "expanded_urls" "" + ] + +tweet2 = + [ "1144834283204415488" + , "" + , "" + , "2019-06-29 05:05:37 +0000" + , "TweetDeck" + , "INI files are extremely underrated IMO" + , "" + , "" + , "" + , "" + ] + +tweet2_labeled = + [ labeled "tweet_id" "1144834283204415488" + , labeled "in_reply_to_status_id" "" + , labeled "in_reply_to_user_id" "" + , labeled "timestamp" "2019-06-29 05:05:37 +0000" + , labeled "source" "TweetDeck" + , labeled "text" "INI files are extremely underrated IMO" + , labeled "retweeted_status_id" "" + , labeled "retweeted_status_user_id" "" + , labeled "retweeted_status_timestamp" "" + , labeled "expanded_urls" "" + ] + +tweet3 = + [ "1144470003963420672" + , "" + , "" + , "2019-06-28 04:58:06 +0000" + , "TweetDeck" + , "I'll listen to any song that has a trumpet solo in the middle" + , "" + , "" + , "" + , "" + ] + +tweet3_labeled = + [ labeled "tweet_id" "1144470003963420672" + , labeled "in_reply_to_status_id" "" + , labeled "in_reply_to_user_id" "" + , labeled "timestamp" "2019-06-28 04:58:06 +0000" + , labeled "source" "TweetDeck" + , labeled "text" "I'll listen to any song that has a trumpet solo in the middle" + , labeled "retweeted_status_id" "" + , labeled "retweeted_status_user_id" "" + , labeled "retweeted_status_timestamp" "" + , labeled "expanded_urls" "" + ] + +tweet4 = + [ "1143630783963389954" + , "" + , "" + , "2019-06-25 21:23:21 +0000" + , "TweetDeck" + , "just accidentally typed \"the Python Report\" instead of \"the Python documentation\"" + , "" + , "" + , "" + , "" + ] + +tweet4_labeled = + [ labeled "tweet_id" "1143630783963389954" + , labeled "in_reply_to_status_id" "" + , labeled "in_reply_to_user_id" "" + , labeled "timestamp" "2019-06-25 21:23:21 +0000" + , labeled "source" "TweetDeck" + , labeled "text" "just accidentally typed \"the Python Report\" instead of \"the Python documentation\"" + , labeled "retweeted_status_id" "" + , labeled "retweeted_status_user_id" "" + , labeled "retweeted_status_timestamp" "" + , labeled "expanded_urls" "" + ] + +tweet5 = + [ "1143602240722210823" + , "" + , "" + , "2019-06-25 19:29:55 +0000" + , "TweetDeck" + , "I doubt a take about why a programming language is the best one has ever elicited action... point out a single cool feature or use that can catch someone's interest" + , "" + , "" + , "" + , "" + ] + +tweet5_labeled = + [ labeled "tweet_id" "1143602240722210823" + , labeled "in_reply_to_status_id" "" + , labeled "in_reply_to_user_id" "" + , labeled "timestamp" "2019-06-25 19:29:55 +0000" + , labeled "source" "TweetDeck" + , labeled "text" "I doubt a take about why a programming language is the best one has ever elicited action... point out a single cool feature or use that can catch someone's interest" + , labeled "retweeted_status_id" "" + , labeled "retweeted_status_user_id" "" + , labeled "retweeted_status_timestamp" "" + , labeled "expanded_urls" "" + ] diff --git a/test/DSV/TestPrelude.hs b/test/DSV/TestPrelude.hs new file mode 100644 --- /dev/null +++ b/test/DSV/TestPrelude.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module DSV.TestPrelude + ( module Prelude + , example + ) where + +import DSV as Prelude + +import Paths_dsv as Prelude +import Prelude hiding (product) + +import Control.Monad.IO.Class as Prelude +import Data.Bifunctor as Prelude +import Data.IORef as Prelude +import Hedgehog as Prelude + +import Control.Category as Prelude + ((>>>), (<<<)) + +import Control.Exception.Safe as Prelude + (try) + +import Control.Monad as Prelude + ((>=>)) + +import Data.Foldable as Prelude + (toList, traverse_) + +import Data.Maybe as Prelude + (fromMaybe) + +import Data.Monoid as Prelude + (Sum (..)) + +import Data.Semigroup as Prelude + (First (..)) + +example = + withTests 1 . property diff --git a/test/DSV/Tests/FileFoldCsv.hs b/test/DSV/Tests/FileFoldCsv.hs new file mode 100644 --- /dev/null +++ b/test/DSV/Tests/FileFoldCsv.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module DSV.Tests.FileFoldCsv where + +import DSV.TestPrelude + +import qualified Control.Foldl as L + +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq + +group :: Group +group = $$(discover) + +sumPricesWithoutHeader :: L.Fold (Vector ByteString) Rational +sumPricesWithoutHeader = + L.premap + (viewOr 0 $ byteStringDollarsView <<<- columnNumberView 3) + L.sum + +sumPricesWithZippedHeader :: L.Fold (Vector (ByteString, ByteString)) Rational +sumPricesWithZippedHeader = + L.premap + (viewOr 0 $ byteStringDollarsView <<<- lookupView (== "Price")) + L.sum + +writeNamesAndCountWithoutHeader :: IORef (Seq ByteString) -> L.FoldM IO (Vector ByteString) Int +writeNamesAndCountWithoutHeader r = + L.mapM_ (traverse_ write . nthVectorElement 4) *> + L.generalize L.length + where + write x = modifyIORef r (<> Seq.singleton x) + +writeNamesAndCountWithZippedHeader :: IORef (Seq ByteString) -> L.FoldM IO (Vector (ByteString, ByteString)) Int +writeNamesAndCountWithZippedHeader r = + L.mapM_ (traverse_ write . vectorLookup (== "Product")) *> + L.generalize L.length + where + write x = modifyIORef r (<> Seq.singleton x) + +-- Corresponds to the example in the documentation for 'foldCsvFileWithoutHeader'. +prop_foldPrice_withoutHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-without-header.csv" + foldCsvFileWithoutHeader fp sumPricesWithoutHeader + + result === (ParseComplete, 624.84) + +-- Corresponds to the example in the documentation for 'foldCsvFileWithoutHeaderM'. +prop_foldPriceM_withoutHeader_doc = example $ + do + result <- liftIO $ + do + r <- newIORef Seq.empty + fp <- getDataFileName "test-data/doc-example-without-header.csv" + (t, n) <- foldCsvFileWithoutHeaderM fp (writeNamesAndCountWithoutHeader r) + rs <- readIORef r + return (t, toList rs, n) + + result === (ParseComplete, ["Dehydrated boulders", "Earthquake pills"], 2) + +-- Corresponds to the example in the documentation for 'foldCsvFileIgnoringHeader'. +prop_foldPrice_ignoringHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + foldCsvFileIgnoringHeader fp sumPricesWithoutHeader + + result === (ParseComplete, 624.84) + +-- Corresponds to the example in the documentation for 'foldCsvFileIgnoringHeaderM'. +prop_foldPriceM_ignoringHeader_doc = example $ + do + result <- liftIO $ + do + r <- newIORef Seq.empty + fp <- getDataFileName "test-data/doc-example-with-header.csv" + (t, n) <- foldCsvFileIgnoringHeaderM fp (writeNamesAndCountWithoutHeader r) + rs <- readIORef r + return (t, toList rs, n) + + result === (ParseComplete, ["Dehydrated boulders", "Earthquake pills"], 2) + +-- Corresponds to the example in the documentation for 'foldCsvFileWithZippedHeader'. +prop_foldPrice_withZippedHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + foldCsvFileWithZippedHeader fp sumPricesWithZippedHeader + + result === (ParseComplete, 624.84) + +-- Corresponds to the example in the documentation for 'foldCsvFileWithZippedHeaderM'. +prop_foldPriceM_withZippedHeader_doc = example $ + do + result <- liftIO $ + do + r <- newIORef Seq.empty + fp <- getDataFileName "test-data/doc-example-with-header.csv" + (t, n) <- foldCsvFileWithZippedHeaderM fp (writeNamesAndCountWithZippedHeader r) + rs <- readIORef r + return (t, toList rs, n) + + result === (ParseComplete, ["Dehydrated boulders", "Earthquake pills"], 2) diff --git a/test/DSV/Tests/FileStrictCsvRead.hs b/test/DSV/Tests/FileStrictCsvRead.hs new file mode 100644 --- /dev/null +++ b/test/DSV/Tests/FileStrictCsvRead.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module DSV.Tests.FileStrictCsvRead where + +import DSV.TestPrelude +import DSV.TestData.Tweets + +group :: Group +group = $$(discover) + +prop_readCsvFileStrictWithoutHeader_tweets = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + readCsvFileStrictWithoutHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map encodeTextUtf8) + [tweetsHeader, tweet1, tweet2, tweet3, tweet4, tweet5] + ) + +-- Corresponds to the example in the documentation for 'readCsvFileStrictWithoutHeader'. +prop_readCsvFileStrictWithoutHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-without-header.csv" + readCsvFileStrictWithoutHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map encodeTextUtf8) + [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"] + , ["2019-04-18", "Acme Co", "$24.95", "Earthquake pills"] + ] + ) + +-- Corresponds to the second example in the documentation for 'readCsvFileStrictWithoutHeader'. +prop_readCsvFileStrictWithoutHeader_doc_error = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-malformed-without-header.csv" + readCsvFileStrictWithoutHeader fp + + result === + ( ParseIncomplete + , listToVector $ map (listToVector . map encodeTextUtf8) + [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"] + ] + ) + +prop_readCsvFileStrictWithZippedHeader_tweets = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + readCsvFileStrictWithZippedHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map (bimap encodeTextUtf8 encodeTextUtf8)) + [tweet1_labeled, tweet2_labeled, tweet3_labeled, tweet4_labeled, tweet5_labeled] + ) + +-- Corresponds to the example in the documentation for 'readCsvFileStrictWithZippedHeader'. +prop_readCsvFileStrictWithZippedHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + readCsvFileStrictWithZippedHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map (bimap encodeTextUtf8 encodeTextUtf8)) + [ [ ("Date", "2019-03-24") + , ("Vendor", "Acme Co") + , ("Price", "$599.89") + , ("Product", "Dehydrated boulders") + ] + , [ ("Date", "2019-04-18") + , ("Vendor", "Acme Co") + , ("Price", "$24.95") + , ("Product", "Earthquake pills") + ] + ] + ) + +-- Corresponds to the second example in the documentation for 'readCsvFileStrictWithZippedHeader'. +prop_readCsvFileStrictWithZippedHeader_doc_error = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-malformed-with-header.csv" + readCsvFileStrictWithZippedHeader fp + + result === + ( ParseIncomplete + , listToVector $ map (listToVector . map (bimap encodeTextUtf8 encodeTextUtf8)) + [ [ ("Date", "2019-03-24") + , ("Vendor", "Acme Co") + , ("Price", "$599.89") + , ("Product", "Dehydrated boulders") + ] + ] + + ) + +prop_readCsvFileStrictIgnoringHeader_tweets = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + readCsvFileStrictIgnoringHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map encodeTextUtf8) + [tweet1, tweet2, tweet3, tweet4, tweet5] + ) + +-- Corresponds to the example in the documentation for 'readCsvFileStrictIgnoringHeader'. +prop_readCsvFileStrictIgnoringHeader_doc = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + readCsvFileStrictIgnoringHeader fp + + result === + ( ParseComplete + , listToVector $ map (listToVector . map encodeTextUtf8) + [ ["2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders"] + , ["2019-04-18", "Acme Co", "$24.95", "Earthquake pills"] + ] + ) diff --git a/test/DSV/Tests/FileStrictCsvZipView.hs b/test/DSV/Tests/FileStrictCsvZipView.hs new file mode 100644 --- /dev/null +++ b/test/DSV/Tests/FileStrictCsvZipView.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ApplicativeDo #-} + +module DSV.Tests.FileStrictCsvZipView where + +import DSV.TestPrelude + +group :: Group +group = $$(discover) + +-- | This is an example in the documentation for 'zipViewCsvFileStrict'. +prop_zipViewCsvFileStrict_entireRow = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + zipViewCsvFileStrict fp (entireRowZipView @() @()) + + result === + ( ZipViewComplete + , listToVector $ map (fmap (listToVector . map encodeTextUtf8)) $ + [ Success [ "2019-03-24", "Acme Co", "$599.89", "Dehydrated boulders" ] + , Success [ "2019-04-18", "Acme Co", "$24.95", "Earthquake pills" ] + ] + ) + +-- | This is an example in the documentation for 'zipViewCsvFileStrict'. +prop_zipViewCsvFileStrict_particularColumns = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-header.csv" + zipViewCsvFileStrict fp $ + do + date <- overZipViewError (:[]) (:[]) (textZipViewUtf8 "Date" utf8TextView) + product <- overZipViewError (:[]) (:[]) (textZipViewUtf8 "Product" utf8TextView) + return (date, product) + + result === + ( ZipViewComplete + , listToVector + [ Success ("2019-03-24", "Dehydrated boulders") + , Success ("2019-04-18", "Earthquake pills") + ] + ) + +-- | This is an example in the documentation for 'zipViewCsvFileStrict'. +prop_zipViewCsvFileStrict_particularColumns_utf8Error = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/doc-example-with-utf8-errors.csv" + zipViewCsvFileStrict fp $ + do + date <- overZipViewError (:[]) (:[]) (textZipViewUtf8 "Date" utf8TextView) + product <- overZipViewError (:[]) (:[]) (textZipViewUtf8 "Product" utf8TextView) + return (date, product) + + result === + ( ZipViewComplete + , listToVector + [ Failure [At (ColumnName "Product") (IndexError_FieldError InvalidUtf8)] + , Success ("2019-04-18", "Earthquake pills") + ] + ) + +prop_zipViewCsvFileStrict_particularColumns_utf8Error_throw = example $ + do + result <- liftIO $ try $ + do + fp <- getDataFileName "test-data/doc-example-with-utf8-errors.csv" + zipViewCsvFileStrictThrowFirstError fp $ + overZipViewError getFirst getFirst $ + do + date <- overZipViewError First First (textZipViewUtf8 "Date" utf8TextView) + product <- overZipViewError First First (textZipViewUtf8 "Product" utf8TextView) + return (date, product) + + result === + Left + (At (RowNumber 1) + (At (ColumnName @Text "Product") + (IndexError_FieldError InvalidUtf8))) + +prop_zipViewCsvFileStrict_empty = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/empty.csv" + zipViewCsvFileStrict fp (entireRowZipView @() @()) + + result === (ZipViewEmpty, emptyVector) + +prop_tweetIds = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + zipViewCsvFileStrictThrowFirstError fp $ + textZipViewUtf8 "tweet_id" byteStringNatView + + result === + listToVector + [ 1145722305135423488 + , 1144834283204415488 + , 1144470003963420672 + , 1143630783963389954 + , 1143602240722210823 + ] + +prop_tweetIdAndTimestamp = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + zipViewCsvFileStrict fp $ + do + tweetId <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "tweet_id" byteStringNatView) + tweetTime <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "timestamp" utf8TextView) + return (tweetId, tweetTime) + + result === + ( ZipViewComplete + , listToVector $ + [ Success (1145722305135423488, "2019-07-01 15:54:18 +0000") + , Success (1144834283204415488, "2019-06-29 05:05:37 +0000") + , Success (1144470003963420672, "2019-06-28 04:58:06 +0000") + , Success (1143630783963389954, "2019-06-25 21:23:21 +0000") + , Success (1143602240722210823, "2019-06-25 19:29:55 +0000") + ] + ) + +prop_tweetIdAndTimestamp_rowError = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets-with-id-error.csv" + zipViewCsvFileStrict fp $ + do + tweetId <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "tweet_id" byteStringNatView) + tweetTime <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "timestamp" utf8TextView) + return (tweetId, tweetTime) + + result === + ( ZipViewComplete + , listToVector $ + [ Success (1145722305135423488, "2019-07-01 15:54:18 +0000") + , Success (1144834283204415488, "2019-06-29 05:05:37 +0000") + , Failure () + , Success (1143630783963389954, "2019-06-25 21:23:21 +0000") + , Success (1143602240722210823, "2019-06-25 19:29:55 +0000") + ] + ) + +prop_tweetIdAndTimestamp_missingHeader = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets.csv" + zipViewCsvFileStrict fp $ + do + tweetId <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "tweet_id" byteStringNatView) + tweetTime <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "color" utf8TextView) + return (tweetId, tweetTime) + + result === + ( ZipViewHeaderError [ At (ColumnName "color") LookupError_Missing ] + , emptyVector + ) + +prop_tweetIdAndTimestamp_duplicateHeader = example $ + do + result <- liftIO $ + do + fp <- getDataFileName "test-data/tweets-with-duplicate-header.csv" + zipViewCsvFileStrict fp $ + do + tweetId <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "tweet_id" byteStringNatView) + tweetTime <- overZipViewError (:[]) (const ()) (textZipViewUtf8 "timestamp" utf8TextView) + return (tweetId, tweetTime) + + result === + ( ZipViewHeaderError [ At (ColumnName "timestamp") LookupError_Duplicate ] + , emptyVector + ) diff --git a/test/doctest.hs b/test/doctest.hs new file mode 100644 --- /dev/null +++ b/test/doctest.hs @@ -0,0 +1,9 @@ +import Test.DocTest + +main :: IO () +main = + doctest + [ "-ilibrary" + , "library/DSV/Header.hs" + , "library/DSV/NumberViews.hs" + ] diff --git a/test/hedgehog.hs b/test/hedgehog.hs new file mode 100644 --- /dev/null +++ b/test/hedgehog.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +import DSV.TestPrelude + +import qualified DSV.Tests.FileFoldCsv +import qualified DSV.Tests.FileStrictCsvRead +import qualified DSV.Tests.FileStrictCsvZipView + +import Control.Monad (when) + +import System.IO (hSetEncoding, stdout, stderr, utf8) +import System.Exit (exitFailure) + +tests :: IO Bool +tests = + checkParallel + (Group + { groupName = "DSV" + , groupProperties = + foldMap groupProperties + [ DSV.Tests.FileFoldCsv.group + , DSV.Tests.FileStrictCsvRead.group + , DSV.Tests.FileStrictCsvZipView.group + ] + }) + +main :: IO () +main = + do + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + ok <- tests + when (not ok) exitFailure