Safe Haskell | None |
---|---|
Language | Haskell2010 |
DSV
Description
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
Synopsis
- readCsvFileStrictWithZippedHeader :: forall m. MonadIO m => FilePath -> m (ParseStop, Vector (Vector (ByteString, ByteString)))
- readCsvFileStrictWithoutHeader :: forall m. MonadIO m => FilePath -> m (ParseStop, Vector (Vector ByteString))
- readCsvFileStrictIgnoringHeader :: forall m. MonadIO m => FilePath -> m (ParseStop, Vector (Vector ByteString))
- type Vector = Vector
- nthVectorElement :: forall a. Integer -> Vector a -> Maybe a
- vectorLookup :: forall name value. (name -> Bool) -> Vector (name, value) -> Maybe value
- listToVector :: forall a. [a] -> Vector a
- vectorToList :: forall a. Vector a -> [a]
- emptyVector :: forall a. Vector a
- type ByteString = ByteString
- data ParseStop
- requireCompleteParse :: MonadThrow m => (ParseStop, a) -> m a
- completely :: MonadThrow m => m (ParseStop, a) -> m a
- readDsvFileStrictWithZippedHeader :: forall m. MonadIO m => Delimiter -> FilePath -> m (ParseStop, Vector (Vector (ByteString, ByteString)))
- readDsvFileStrictWithoutHeader :: forall m. MonadIO m => Delimiter -> FilePath -> m (ParseStop, Vector (Vector ByteString))
- readDsvFileStrictIgnoringHeader :: forall m. MonadIO m => Delimiter -> FilePath -> m (ParseStop, Vector (Vector ByteString))
- newtype Delimiter = Delimiter Word8
- comma :: Delimiter
- tab :: Delimiter
- delimiterWord8 :: Delimiter -> Word8
- charDelimiter :: Char -> Q Exp
- mapCsvFileStrictWithoutHeader :: forall m row. MonadIO m => FilePath -> (Vector ByteString -> IO row) -> m (ParseStop, Vector row)
- mapCsvFileStrictIgnoringHeader :: forall m row. MonadIO m => FilePath -> (Vector ByteString -> IO row) -> m (ParseStop, Vector row)
- mapCsvFileStrictUsingHeader :: forall m row. MonadIO m => FilePath -> (Vector ByteString -> IO (Vector ByteString -> IO row)) -> m (ParseStop, Vector row)
- mapDsvFileStrictWithoutHeader :: forall m row. MonadIO m => Delimiter -> FilePath -> (Vector ByteString -> IO row) -> m (ParseStop, Vector row)
- mapDsvFileStrictIgnoringHeader :: forall m row. MonadIO m => Delimiter -> FilePath -> (Vector ByteString -> IO row) -> m (ParseStop, Vector row)
- mapDsvFileStrictUsingHeader :: forall m row. MonadIO m => Delimiter -> FilePath -> (Vector ByteString -> IO (Vector ByteString -> IO row)) -> m (ParseStop, Vector row)
- foldCsvFileWithZippedHeader :: forall m result. MonadIO m => FilePath -> Fold (Vector (ByteString, ByteString)) result -> m (ParseStop, result)
- foldCsvFileWithZippedHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => FilePath -> FoldM m (Vector (ByteString, ByteString)) result -> m (ParseStop, result)
- foldCsvFileWithoutHeader :: forall m result. MonadIO m => FilePath -> Fold (Vector ByteString) result -> m (ParseStop, result)
- foldCsvFileWithoutHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => FilePath -> FoldM m (Vector ByteString) result -> m (ParseStop, result)
- foldCsvFileIgnoringHeader :: forall m result. MonadIO m => FilePath -> Fold (Vector ByteString) result -> m (ParseStop, result)
- foldCsvFileIgnoringHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => FilePath -> FoldM m (Vector ByteString) result -> m (ParseStop, result)
- data Fold a b = Fold (x -> a -> x) x (x -> b)
- data FoldM (m :: Type -> Type) a b = FoldM (x -> a -> m x) (m x) (x -> m b)
- foldDsvFileWithZippedHeader :: forall m result. MonadIO m => Delimiter -> FilePath -> Fold (Vector (ByteString, ByteString)) result -> m (ParseStop, result)
- foldDsvFileWithZippedHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => Delimiter -> FilePath -> FoldM m (Vector (ByteString, ByteString)) result -> m (ParseStop, result)
- foldDsvFileWithoutHeader :: forall m result. MonadIO m => Delimiter -> FilePath -> Fold (Vector ByteString) result -> m (ParseStop, result)
- foldDsvFileWithoutHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => Delimiter -> FilePath -> FoldM m (Vector ByteString) result -> m (ParseStop, result)
- foldDsvFileIgnoringHeader :: forall m result. MonadIO m => Delimiter -> FilePath -> Fold (Vector ByteString) result -> m (ParseStop, result)
- foldDsvFileIgnoringHeaderM :: forall m result. (MonadCatch m, MonadMask m, MonadIO m) => Delimiter -> FilePath -> FoldM m (Vector ByteString) result -> m (ParseStop, result)
- newtype View e a b = View (a -> Validation e b)
- data Validation err a
- constView :: forall e a b. b -> View e a b
- maybeView :: forall a b. (a -> Maybe b) -> View () a b
- overViewError :: forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
- inputAsViewError :: forall e a b. View e a b -> View a a b
- discardViewError :: View e a b -> View () a b
- (>>>) :: forall k cat (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c
- (<<<) :: forall k cat (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c
- (>>>-) :: View e2 a b -> View e1 b c -> View () a c
- (<<<-) :: View e1 b c -> View e2 a b -> View () a c
- applyView :: forall e a b. View e a b -> a -> Validation e b
- viewOrThrow :: forall m e a b. (Exception e, MonadThrow m) => View e a b -> a -> m b
- viewOrThrowInput :: forall m ex e a b. (Exception ex, MonadThrow m) => (a -> ex) -> View e a b -> a -> m b
- viewMaybe :: forall e a b. View e a b -> a -> Maybe b
- viewOr :: forall e a b. b -> View e a b -> a -> b
- viewOr' :: forall m e a b. Applicative m => (a -> e -> m b) -> View e a b -> a -> m b
- byteStringNatView :: View InvalidNat ByteString Natural
- textNatView :: View InvalidNat Text Natural
- data InvalidNat = InvalidNat
- byteStringNatView_ :: View () ByteString Natural
- textNatView_ :: View () Text Natural
- byteStringRationalView :: View InvalidRational ByteString Rational
- textRationalView :: View InvalidRational Text Rational
- data InvalidRational = InvalidRational
- byteStringRationalView_ :: View () ByteString Rational
- textRationalView_ :: View () Text Rational
- byteStringDollarsView :: View InvalidDollars ByteString Rational
- textDollarsView :: View InvalidDollars Text Rational
- data InvalidDollars = InvalidDollars
- byteStringDollarsView_ :: View () ByteString Rational
- textDollarsView_ :: View () Text Rational
- columnNumberView :: forall a. ColumnNumber -> View TooShort (Vector a) a
- data TooShort = TooShort
- data IndexError error
- = IndexError_TooShort
- | IndexError_FieldError error
- columnNumberView_ :: forall a. ColumnNumber -> View () (Vector a) a
- lookupView :: (a -> Bool) -> View LookupError (Vector (a, b)) b
- lookupView_ :: (a -> Bool) -> View () (Vector (a, b)) b
- data Duplicate = Duplicate
- data Missing = Missing
- data LookupError
- lookupTextViewUtf8 :: (Text -> Bool) -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
- lookupStringViewUtf8 :: (String -> Bool) -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
- data LookupErrorUtf8
- lookupTextViewUtf8_ :: (Text -> Bool) -> View () (Vector (ByteString, ByteString)) Text
- lookupStringViewUtf8_ :: (String -> Bool) -> View () (Vector (ByteString, ByteString)) String
- newtype ZipView headerError rowError a = ZipView (View headerError (Vector ByteString) (View rowError (Vector ByteString) a))
- overZipViewError :: forall headerError1 headerError2 rowError1 rowError2 a. (headerError1 -> headerError2) -> (rowError1 -> rowError2) -> ZipView headerError1 rowError1 a -> ZipView headerError2 rowError2 a
- overHeaderError :: (headerError1 -> headerError2) -> ZipView headerError1 rowError a -> ZipView headerError2 rowError a
- overRowError :: (rowError1 -> rowError2) -> ZipView headerError rowError1 a -> ZipView headerError rowError2 a
- zipViewPipe :: forall m headerError rowError row. Monad m => ZipView headerError rowError row -> Pipe (Vector ByteString) (Validation rowError row) m headerError
- zipViewPipeIgnoringAllErrors :: forall m headerError rowError row. Monad m => ZipView headerError rowError row -> Pipe (Vector ByteString) row m ()
- zipViewPipeThrowFirstError :: forall m headerError rowError row r. (Monad m, MonadThrow m, Exception headerError, Show rowError, Typeable rowError) => ZipView headerError rowError row -> Pipe (Vector ByteString) row m r
- byteStringZipView :: ByteString -> ZipView LookupError TooShort ByteString
- textZipViewUtf8 :: forall e a. Text -> View e ByteString a -> ZipView (At (ColumnName Text) LookupError) (At (ColumnName Text) (IndexError e)) a
- textZipViewUtf8' :: Text -> ZipView (At (ColumnName Text) LookupError) (At (ColumnName Text) TooShort) ByteString
- byteStringZipViewPosition :: forall headerError. ColumnNumber -> ZipView headerError TooShort ByteString
- entireRowZipView :: forall he re. ZipView he re (Vector ByteString)
- refineZipView :: forall headerError rowError a b. ZipView headerError rowError a -> View rowError a b -> ZipView headerError rowError b
- zipViewFold :: forall headerError rowError row result. ZipView headerError rowError row -> Fold (Validation rowError row) result -> Fold (Vector ByteString) (Validation (ZipViewError headerError) result)
- 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)
- data ZipViewError headerError
- = ZipViewError_Empty
- | ZipViewError_HeaderError headerError
- zipViewCsvFileStrict :: forall m headerError rowError row. MonadIO m => FilePath -> ZipView headerError rowError row -> m (ZipViewStop headerError, Vector (Validation rowError row))
- zipViewCsvFileStrictIgnoringAllErrors :: forall m headerError rowError row. MonadIO m => FilePath -> ZipView headerError rowError row -> m (Vector row)
- zipViewCsvFileStrictThrowFirstError :: forall m headerError rowError row. (MonadIO m, Exception headerError, Show rowError, Typeable rowError) => FilePath -> ZipView headerError rowError row -> m (Vector row)
- data ZipViewStop headerError
- = ZipViewEmpty
- | ZipViewComplete
- | ZipViewParseError
- | ZipViewHeaderError headerError
- zipViewDsvFileStrict :: forall m headerError rowError row. MonadIO m => Delimiter -> FilePath -> ZipView headerError rowError row -> m (ZipViewStop headerError, Vector (Validation rowError row))
- zipViewDsvFileStrictIgnoringAllErrors :: forall m headerError rowError row. MonadIO m => Delimiter -> FilePath -> ZipView headerError rowError row -> m (Vector row)
- zipViewDsvFileStrictThrowFirstError :: forall m headerError rowError row. (MonadIO m, Exception headerError, Show rowError, Typeable rowError) => Delimiter -> FilePath -> ZipView headerError rowError row -> m (Vector row)
- csvRowPipe :: forall m. Monad m => Pipe ByteString (Vector ByteString) m ParseError
- dsvRowPipe :: forall m. Monad m => Delimiter -> Pipe ByteString (Vector ByteString) m ParseError
- handleCsvRowProducer :: forall m. MonadIO m => Handle -> Producer (Vector ByteString) m ParseStop
- handleDsvRowProducer :: forall m. MonadIO m => Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
- zipHeaderPipe :: forall a m r. Monad m => Pipe (Vector a) (Vector (a, a)) m r
- zipHeaderWithPipe :: forall a b m r. Monad m => (a -> a -> b) -> Pipe (Vector a) (Vector b) m r
- type Pipe a b m r = Pipe a b m r
- type Producer b m r = Producer b m r
- type Consumer a m r = Consumer a m r
- type Effect m r = Effect m r
- runEffect :: Monad m => Effect m r -> m r
- (>->) :: Monad m => Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
- await :: forall (m :: Type -> Type) a. Functor m => Consumer' a m a
- yield :: forall (m :: Type -> Type) a x' x. Functor m => a -> Proxy x' x () a m ()
- type AttoParser = Parser
- attoPipe :: forall a m. Monad m => AttoParser a -> Pipe ByteString a m ParseError
- handleAttoProducer :: forall a m. MonadIO m => AttoParser a -> Handle -> Producer a m ParseStop
- data ParseError = ParseError
- data Position row col = Position row col
- newtype RowNumber = RowNumber Positive
- newtype ColumnNumber = ColumnNumber Positive
- newtype ColumnName str = ColumnName str
- newtype Positive = Positive Natural
- data At p a = At p a
- data Text
- stringToText :: String -> Text
- textToString :: Text -> String
- encodeTextUtf8 :: Text -> ByteString
- utf8TextView :: View InvalidUtf8 ByteString Text
- data InvalidUtf8 = InvalidUtf8
Reading a CSV file as a Vector
readCsvFileStrict
...
We present these functions first because they require the least amount of effort to use. Each function in this section:
- Assumes that the delimiter is a comma.
- Reads from a file (specified by a
FilePath
); - 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 ofByteString
s to other types.
readCsvFileStrictWithZippedHeader Source #
Arguments
:: forall m. MonadIO m | |
=> FilePath | The path of a CSV file to read |
-> m (ParseStop, Vector (Vector (ByteString, ByteString))) |
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.
readCsvFileStrictWithoutHeader Source #
Arguments
:: forall m. MonadIO m | |
=> FilePath | The path of a CSV file to read |
-> m (ParseStop, Vector (Vector ByteString)) |
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"] ] )
readCsvFileStrictIgnoringHeader Source #
Arguments
:: forall m. MonadIO m | |
=> FilePath | The path of a CSV file to read |
-> m (ParseStop, Vector (Vector ByteString)) |
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"] ] )
What is a Vector
See the Data.Vector module for more on the Vector
type.
nthVectorElement :: forall a. Integer -> Vector a -> Maybe a Source #
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
listToVector :: forall a. [a] -> Vector a Source #
vectorToList :: forall a. Vector a -> [a] Source #
emptyVector :: forall a. Vector a Source #
What is a ByteString
See the Data.ByteString module for more on the ByteString
type.
type ByteString = ByteString Source #
A read ends with a ParseStop
Constructors
ParseComplete | |
ParseIncomplete |
Instances
requireCompleteParse :: MonadThrow m => (ParseStop, a) -> m a Source #
completely :: MonadThrow m => m (ParseStop, a) -> m a Source #
Other delimiters
readDsvFileStrict
...
"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.
readDsvFileStrictWithZippedHeader Source #
Arguments
:: forall m. MonadIO m | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a CSV file to read |
-> m (ParseStop, Vector (Vector (ByteString, ByteString))) |
What is a Delimiter
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
',')
ASCII code point 0x09
, the "horizontal tab" character.
tab = $(charDelimiter
't')
delimiterWord8 :: Delimiter -> Word8 Source #
charDelimiter :: Char -> Q Exp Source #
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
(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).
Reading with a custom row type
mapCsvFileStrict
...
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).
mapCsvFileStrictUsingHeader Source #
Arguments
:: 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 |
-> m (ParseStop, Vector row) |
Using other delimiters
This section is the same as the previous, but generalized with a Delimiter
parameter.
mapDsvFileStrictUsingHeader Source #
Arguments
:: forall m row. MonadIO m | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> (Vector ByteString -> IO (Vector ByteString -> IO row)) | Function which interprets the header (the first |
-> m (ParseStop, Vector row) |
Iterating over a file with a Fold
foldCsvFile
...
The functions in this section are all parameterized on:
- A
FilePath
, which specifies what CSV file to read; - Either a
Fold
or aFoldM
, which specifies what action to take upon each row from the CSV file.
Use one of the functions with a Fold
parameter if you only need to collect information from the rows and aggregate it into some result
value. Use a function with a 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.
foldCsvFileWithZippedHeader Source #
Arguments
:: 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) |
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:
premap
(viewOr
0 $byteStringDollarsView
<<<-
lookupView
(== "Price"))sum
Result:
(ParseComplete
, 624.84)
foldCsvFileWithZippedHeaderM Source #
Arguments
:: 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) |
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:
mapM_
(traverse_
putStrLn
.vectorLookup
(== "Product")) *>generalize
length
Output printed to the terminal:
Dehydrated boulders Earthquake pills
Result:
(ParseComplete
, 2)
foldCsvFileWithoutHeader Source #
Arguments
:: 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) |
Example
CSV file:
2019-03-24,Acme Co,$599.89,Dehydrated boulders 2019-04-18,Acme Co,$24.95,Earthquake pills
Fold:
premap
(viewOr
0 $byteStringDollarsView
<<<-
columnNumberView
3)sum
Result:
(ParseComplete
, 624.84)
foldCsvFileWithoutHeaderM Source #
Arguments
:: 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) |
Example
CSV file:
2019-03-24,Acme Co,$599.89,Dehydrated boulders 2019-04-18,Acme Co,$24.95,Earthquake pills
Fold:
mapM_
(traverse_
putStrLn
.nthVectorElement
4) *>generalize
length
Output printed to the terminal:
Dehydrated boulders Earthquake pills
Result:
(ParseComplete
, 2)
foldCsvFileIgnoringHeader Source #
Arguments
:: 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) |
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:
premap
(viewOr
0 $byteStringDollarsView
<<<-
columnNumberView
3)sum
Result:
(ParseComplete
, 624.84)
foldCsvFileIgnoringHeaderM Source #
Arguments
:: 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) |
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:
mapM_
(traverse_
putStrLn
.nthVectorElement
4) *>generalize
length
Output printed to the terminal:
Dehydrated boulders Earthquake pills
Result:
(ParseComplete
, 2)
What is a Fold
See the Control.Foldl module for more on the Fold
and FoldM
types.
Efficient representation of a left fold that preserves the fold's step function, initial accumulator, and extraction function
This allows the Applicative
instance to assemble derived folds that
traverse the container only once
A 'Fold
a b' processes elements of type a and results in a
value of type b.
Constructors
Fold (x -> a -> x) x (x -> b) |
|
Instances
Profunctor Fold | |
Defined in Control.Foldl | |
Choice Fold | |
Functor (Fold a) | |
Applicative (Fold a) | |
Comonad (Fold a) | |
Extend (Fold a) | |
Semigroupoid Fold | |
Floating b => Floating (Fold a b) | |
Defined in Control.Foldl Methods sqrt :: Fold a b -> Fold a b # (**) :: Fold a b -> Fold a b -> Fold a b # logBase :: Fold a b -> Fold a b -> Fold a b # asin :: Fold a b -> Fold a b # acos :: Fold a b -> Fold a b # atan :: Fold a b -> Fold a b # sinh :: Fold a b -> Fold a b # cosh :: Fold a b -> Fold a b # tanh :: Fold a b -> Fold a b # asinh :: Fold a b -> Fold a b # acosh :: Fold a b -> Fold a b # atanh :: Fold a b -> Fold a b # log1p :: Fold a b -> Fold a b # expm1 :: Fold a b -> Fold a b # | |
Fractional b => Fractional (Fold a b) | |
Num b => Num (Fold a b) | |
Semigroup b => Semigroup (Fold a b) | |
Monoid b => Monoid (Fold a b) | |
data FoldM (m :: Type -> Type) a b #
Like Fold
, but monadic.
A 'FoldM
m a b' processes elements of type a and
results in a monadic value of type m b.
Constructors
FoldM (x -> a -> m x) (m x) (x -> m b) |
|
Instances
Functor m => Profunctor (FoldM m) | |
Defined in Control.Foldl Methods dimap :: (a -> b) -> (c -> d) -> FoldM m b c -> FoldM m a d # lmap :: (a -> b) -> FoldM m b c -> FoldM m a c # rmap :: (b -> c) -> FoldM m a b -> FoldM m a c # (#.) :: forall a b c q. Coercible c b => q b c -> FoldM m a b -> FoldM m a c # (.#) :: forall a b c q. Coercible b a => FoldM m b c -> q a b -> FoldM m a c # | |
Functor m => Functor (FoldM m a) | |
Applicative m => Applicative (FoldM m a) | |
Monad m => Extend (FoldM m a) | |
(Monad m, Floating b) => Floating (FoldM m a b) | |
Defined in Control.Foldl Methods exp :: FoldM m a b -> FoldM m a b # log :: FoldM m a b -> FoldM m a b # sqrt :: FoldM m a b -> FoldM m a b # (**) :: FoldM m a b -> FoldM m a b -> FoldM m a b # logBase :: FoldM m a b -> FoldM m a b -> FoldM m a b # sin :: FoldM m a b -> FoldM m a b # cos :: FoldM m a b -> FoldM m a b # tan :: FoldM m a b -> FoldM m a b # asin :: FoldM m a b -> FoldM m a b # acos :: FoldM m a b -> FoldM m a b # atan :: FoldM m a b -> FoldM m a b # sinh :: FoldM m a b -> FoldM m a b # cosh :: FoldM m a b -> FoldM m a b # tanh :: FoldM m a b -> FoldM m a b # asinh :: FoldM m a b -> FoldM m a b # acosh :: FoldM m a b -> FoldM m a b # atanh :: FoldM m a b -> FoldM m a b # log1p :: FoldM m a b -> FoldM m a b # expm1 :: FoldM m a b -> FoldM m a b # | |
(Monad m, Fractional b) => Fractional (FoldM m a b) | |
(Monad m, Num b) => Num (FoldM m a b) | |
Defined in Control.Foldl Methods (+) :: FoldM m a b -> FoldM m a b -> FoldM m a b # (-) :: FoldM m a b -> FoldM m a b -> FoldM m a b # (*) :: FoldM m a b -> FoldM m a b -> FoldM m a b # negate :: FoldM m a b -> FoldM m a b # abs :: FoldM m a b -> FoldM m a b # signum :: FoldM m a b -> FoldM m a b # fromInteger :: Integer -> FoldM m a b # | |
(Semigroup b, Monad m) => Semigroup (FoldM m a b) | |
(Monoid b, Monad m) => Monoid (FoldM m a b) | |
Using other delimiters
This section is the same as the previous, but generalized with a Delimiter
parameter.
foldDsvFileWithZippedHeader Source #
Arguments
:: forall m result. MonadIO m | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> Fold (Vector (ByteString, ByteString)) result | What to do with each row |
-> m (ParseStop, result) |
foldDsvFileWithZippedHeaderM Source #
Arguments
:: forall m result. (MonadCatch m, MonadMask m, MonadIO m) | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> FoldM m (Vector (ByteString, ByteString)) result | What to do with each row |
-> m (ParseStop, result) |
foldDsvFileWithoutHeaderM Source #
Arguments
:: forall m result. (MonadCatch m, MonadMask m, MonadIO m) | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> FoldM m (Vector ByteString) result | What to do with each row |
-> m (ParseStop, result) |
foldDsvFileIgnoringHeaderM Source #
Arguments
:: forall m result. (MonadCatch m, MonadMask m, MonadIO m) | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> FoldM m (Vector ByteString) result | What to do with each row |
-> m (ParseStop, result) |
Functions that can fail
What is a View
Constructors
View (a -> Validation e b) |
What is Validation
See the Data.Validation module for more on the Validation
type.
data Validation err a #
A Validation
is either a value of the type err
or a
, similar to Either
. However,
the Applicative
instance for Validation
accumulates errors using a Semigroup
on err
.
In contrast, the Applicative
for Either
returns only the first error.
A consequence of this is that Validation
has no Bind
or Monad
instance. This is because
such an instance would violate the law that a Monad's ap
must equal the
Applicative
's <*>
An example of typical usage can be found here.
Instances
Bifunctor Validation | |
Defined in Data.Validation Methods bimap :: (a -> b) -> (c -> d) -> Validation a c -> Validation b d # first :: (a -> b) -> Validation a c -> Validation b c # second :: (b -> c) -> Validation a b -> Validation a c # | |
Swap Validation | |
Defined in Data.Validation Methods swap :: Validation a b -> Validation b a # | |
Bitraversable Validation | |
Defined in Data.Validation Methods bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Validation a b -> f (Validation c d) # | |
Bifoldable Validation | |
Defined in Data.Validation Methods bifold :: Monoid m => Validation m m -> m # bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> Validation a b -> m # bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> Validation a b -> c # bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> Validation a b -> c # | |
Validate Validation | |
Defined in Data.Validation Methods _Validation :: Iso (Validation e a) (Validation g b) (Validation e a) (Validation g b) # _Either :: Iso (Validation e a) (Validation g b) (Either e a) (Either g b) # | |
Functor (Validation err) | |
Defined in Data.Validation Methods fmap :: (a -> b) -> Validation err a -> Validation err b # (<$) :: a -> Validation err b -> Validation err a # | |
Semigroup err => Applicative (Validation err) | |
Defined in Data.Validation Methods pure :: a -> Validation err a # (<*>) :: Validation err (a -> b) -> Validation err a -> Validation err b # liftA2 :: (a -> b -> c) -> Validation err a -> Validation err b -> Validation err c # (*>) :: Validation err a -> Validation err b -> Validation err b # (<*) :: Validation err a -> Validation err b -> Validation err a # | |
Foldable (Validation err) | |
Defined in Data.Validation Methods fold :: Monoid m => Validation err m -> m # foldMap :: Monoid m => (a -> m) -> Validation err a -> m # foldMap' :: Monoid m => (a -> m) -> Validation err a -> m # foldr :: (a -> b -> b) -> b -> Validation err a -> b # foldr' :: (a -> b -> b) -> b -> Validation err a -> b # foldl :: (b -> a -> b) -> b -> Validation err a -> b # foldl' :: (b -> a -> b) -> b -> Validation err a -> b # foldr1 :: (a -> a -> a) -> Validation err a -> a # foldl1 :: (a -> a -> a) -> Validation err a -> a # toList :: Validation err a -> [a] # null :: Validation err a -> Bool # length :: Validation err a -> Int # elem :: Eq a => a -> Validation err a -> Bool # maximum :: Ord a => Validation err a -> a # minimum :: Ord a => Validation err a -> a # sum :: Num a => Validation err a -> a # product :: Num a => Validation err a -> a # | |
Traversable (Validation err) | |
Defined in Data.Validation Methods traverse :: Applicative f => (a -> f b) -> Validation err a -> f (Validation err b) # sequenceA :: Applicative f => Validation err (f a) -> f (Validation err a) # mapM :: Monad m => (a -> m b) -> Validation err a -> m (Validation err b) # sequence :: Monad m => Validation err (m a) -> m (Validation err a) # | |
Semigroup err => Apply (Validation err) | |
Defined in Data.Validation Methods (<.>) :: Validation err (a -> b) -> Validation err a -> Validation err b # (.>) :: Validation err a -> Validation err b -> Validation err b # (<.) :: Validation err a -> Validation err b -> Validation err a # liftF2 :: (a -> b -> c) -> Validation err a -> Validation err b -> Validation err c # | |
Alt (Validation err) | For two errors, this instance reports only the last of them. |
Defined in Data.Validation Methods (<!>) :: Validation err a -> Validation err a -> Validation err a # some :: Applicative (Validation err) => Validation err a -> Validation err [a] # many :: Applicative (Validation err) => Validation err a -> Validation err [a] # | |
(Eq err, Eq a) => Eq (Validation err a) | |
Defined in Data.Validation Methods (==) :: Validation err a -> Validation err a -> Bool # (/=) :: Validation err a -> Validation err a -> Bool # | |
(Data err, Data a) => Data (Validation err a) | |
Defined in Data.Validation Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Validation err a -> c (Validation err a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Validation err a) # toConstr :: Validation err a -> Constr # dataTypeOf :: Validation err a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Validation err a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Validation err a)) # gmapT :: (forall b. Data b => b -> b) -> Validation err a -> Validation err a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Validation err a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Validation err a -> r # gmapQ :: (forall d. Data d => d -> u) -> Validation err a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Validation err a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Validation err a -> m (Validation err a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Validation err a -> m (Validation err a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Validation err a -> m (Validation err a) # | |
(Ord err, Ord a) => Ord (Validation err a) | |
Defined in Data.Validation Methods compare :: Validation err a -> Validation err a -> Ordering # (<) :: Validation err a -> Validation err a -> Bool # (<=) :: Validation err a -> Validation err a -> Bool # (>) :: Validation err a -> Validation err a -> Bool # (>=) :: Validation err a -> Validation err a -> Bool # max :: Validation err a -> Validation err a -> Validation err a # min :: Validation err a -> Validation err a -> Validation err a # | |
(Show err, Show a) => Show (Validation err a) | |
Defined in Data.Validation Methods showsPrec :: Int -> Validation err a -> ShowS # show :: Validation err a -> String # showList :: [Validation err a] -> ShowS # | |
Generic (Validation err a) | |
Defined in Data.Validation Associated Types type Rep (Validation err a) :: Type -> Type # Methods from :: Validation err a -> Rep (Validation err a) x # to :: Rep (Validation err a) x -> Validation err a # | |
Semigroup e => Semigroup (Validation e a) | |
Defined in Data.Validation Methods (<>) :: Validation e a -> Validation e a -> Validation e a # sconcat :: NonEmpty (Validation e a) -> Validation e a # stimes :: Integral b => b -> Validation e a -> Validation e a # | |
Monoid e => Monoid (Validation e a) | |
Defined in Data.Validation Methods mempty :: Validation e a # mappend :: Validation e a -> Validation e a -> Validation e a # mconcat :: [Validation e a] -> Validation e a # | |
(NFData e, NFData a) => NFData (Validation e a) | |
Defined in Data.Validation Methods rnf :: Validation e a -> () # | |
type Rep (Validation err a) | |
Defined in Data.Validation type Rep (Validation err a) = D1 ('MetaData "Validation" "Data.Validation" "validation-1.1.2-UKgYNle3TQ5l89yeb5YmG" 'False) (C1 ('MetaCons "Failure" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 err)) :+: C1 ('MetaCons "Success" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))) |
Constructing views
Modifying views
overViewError :: forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b Source #
inputAsViewError :: forall e a b. View e a b -> View a a b Source #
discardViewError :: View e a b -> View () a b Source #
Composing views
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.
(>>>) :: forall k cat (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c infixr 1 #
Left-to-right composition
(<<<) :: forall k cat (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c infixr 1 #
Right-to-left composition
Using views
applyView :: forall e a b. View e a b -> a -> Validation e b Source #
viewOrThrow :: forall m e a b. (Exception e, MonadThrow m) => View e a b -> a -> m b Source #
viewOrThrowInput :: forall m ex e a b. (Exception ex, MonadThrow m) => (a -> ex) -> View e a b -> a -> m b Source #
viewOr' :: forall m e a b. Applicative m => (a -> e -> m b) -> View e a b -> a -> m b Source #
Viewing strings as numbers
data InvalidNat Source #
Constructors
InvalidNat |
Instances
Eq InvalidNat Source # | |
Defined in DSV.NumberViews | |
Show InvalidNat Source # | |
Defined in DSV.NumberViews Methods showsPrec :: Int -> InvalidNat -> ShowS # show :: InvalidNat -> String # showList :: [InvalidNat] -> ShowS # | |
Exception InvalidNat Source # | |
Defined in DSV.NumberViews Methods toException :: InvalidNat -> SomeException # fromException :: SomeException -> Maybe InvalidNat # displayException :: InvalidNat -> String # |
byteStringRationalView :: View InvalidRational ByteString Rational Source #
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
textRationalView :: View InvalidRational Text Rational Source #
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
data InvalidRational Source #
Constructors
InvalidRational |
Instances
Eq InvalidRational Source # | |
Defined in DSV.NumberViews Methods (==) :: InvalidRational -> InvalidRational -> Bool # (/=) :: InvalidRational -> InvalidRational -> Bool # | |
Show InvalidRational Source # | |
Defined in DSV.NumberViews Methods showsPrec :: Int -> InvalidRational -> ShowS # show :: InvalidRational -> String # showList :: [InvalidRational] -> ShowS # | |
Exception InvalidRational Source # | |
Defined in DSV.NumberViews Methods toException :: InvalidRational -> SomeException # |
byteStringDollarsView :: View InvalidDollars ByteString Rational Source #
Read a dollar amount.
Examples
>>>
applyView byteStringDollarsView "$1234.567"
Success (1234567 % 1000)
>>>
applyView byteStringDollarsView "1234.567"
Failure InvalidDollars
textDollarsView :: View InvalidDollars Text Rational Source #
Read a dollar amount.
Examples
>>>
applyView textDollarsView "$1234.567"
Success (1234567 % 1000)
>>>
applyView textDollarsView "1234.567"
Failure InvalidDollars
data InvalidDollars Source #
Constructors
InvalidDollars |
Instances
Eq InvalidDollars Source # | |
Defined in DSV.NumberViews Methods (==) :: InvalidDollars -> InvalidDollars -> Bool # (/=) :: InvalidDollars -> InvalidDollars -> Bool # | |
Show InvalidDollars Source # | |
Defined in DSV.NumberViews Methods showsPrec :: Int -> InvalidDollars -> ShowS # show :: InvalidDollars -> String # showList :: [InvalidDollars] -> ShowS # | |
Exception InvalidDollars Source # | |
Defined in DSV.NumberViews Methods toException :: InvalidDollars -> SomeException # |
Viewing a position of a vector
columnNumberView :: forall a. ColumnNumber -> View TooShort (Vector a) a Source #
Constructors
TooShort |
Instances
Eq TooShort Source # | |
Show TooShort Source # | |
Exception TooShort Source # | |
Defined in DSV.IndexError Methods toException :: TooShort -> SomeException # fromException :: SomeException -> Maybe TooShort # displayException :: TooShort -> String # |
data IndexError error Source #
The general concept of what can go wrong when you look up something by position in a list.
Constructors
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. |
Instances
Eq error => Eq (IndexError error) Source # | |
Defined in DSV.IndexError Methods (==) :: IndexError error -> IndexError error -> Bool # (/=) :: IndexError error -> IndexError error -> Bool # | |
Show error => Show (IndexError error) Source # | |
Defined in DSV.IndexError Methods showsPrec :: Int -> IndexError error -> ShowS # show :: IndexError error -> String # showList :: [IndexError error] -> ShowS # | |
(Typeable error, Show error) => Exception (IndexError error) Source # | |
Defined in DSV.IndexError Methods toException :: IndexError error -> SomeException # fromException :: SomeException -> Maybe (IndexError error) # displayException :: IndexError error -> String # |
columnNumberView_ :: forall a. ColumnNumber -> View () (Vector a) a Source #
Finding something in a vector
lookupView :: (a -> Bool) -> View LookupError (Vector (a, b)) b Source #
Constructors
Duplicate |
Instances
Eq Duplicate Source # | |
Show Duplicate Source # | |
Exception Duplicate Source # | |
Defined in DSV.LookupError Methods toException :: Duplicate -> SomeException # fromException :: SomeException -> Maybe Duplicate # displayException :: Duplicate -> String # |
Constructors
Missing |
Instances
Eq Missing Source # | |
Show Missing Source # | |
Exception Missing Source # | |
Defined in DSV.LookupError Methods toException :: Missing -> SomeException # fromException :: SomeException -> Maybe Missing # displayException :: Missing -> String # |
data LookupError Source #
The general concept of what can go wrong when you look up the position of a particular element in a list.
Constructors
LookupError_Missing | There is no matching element. |
LookupError_Duplicate | There are more than one matching elements. |
Instances
Eq LookupError Source # | |
Defined in DSV.LookupError | |
Show LookupError Source # | |
Defined in DSV.LookupError Methods showsPrec :: Int -> LookupError -> ShowS # show :: LookupError -> String # showList :: [LookupError] -> ShowS # | |
Exception LookupError Source # | |
Defined in DSV.LookupError Methods toException :: LookupError -> SomeException # fromException :: SomeException -> Maybe LookupError # displayException :: LookupError -> String # |
Finding something in a vector of UTF-8 byte strings
lookupTextViewUtf8 :: (Text -> Bool) -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text Source #
lookupStringViewUtf8 :: (String -> Bool) -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String Source #
data LookupErrorUtf8 Source #
The general concept of what can go wrong when you look up the position of a particular element in a list.
Constructors
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. |
Instances
Eq LookupErrorUtf8 Source # | |
Defined in DSV.LookupErrorUtf8 Methods (==) :: LookupErrorUtf8 -> LookupErrorUtf8 -> Bool # (/=) :: LookupErrorUtf8 -> LookupErrorUtf8 -> Bool # | |
Show LookupErrorUtf8 Source # | |
Defined in DSV.LookupErrorUtf8 Methods showsPrec :: Int -> LookupErrorUtf8 -> ShowS # show :: LookupErrorUtf8 -> String # showList :: [LookupErrorUtf8] -> ShowS # | |
Exception LookupErrorUtf8 Source # | |
Defined in DSV.LookupErrorUtf8 Methods toException :: LookupErrorUtf8 -> SomeException # |
lookupTextViewUtf8_ :: (Text -> Bool) -> View () (Vector (ByteString, ByteString)) Text Source #
lookupStringViewUtf8_ :: (String -> Bool) -> View () (Vector (ByteString, ByteString)) String Source #
Header-and-row views
What is a ZipView
newtype ZipView headerError rowError a Source #
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 theheaderError
type is produced by the firstView
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 therowError
type is produced by the secondView
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.
Constructors
ZipView (View headerError (Vector ByteString) (View rowError (Vector ByteString) a)) |
Instances
Functor (ZipView headerError rowError) Source # | |
(Semigroup headerError, Semigroup rowError) => Applicative (ZipView headerError rowError) Source # |
|
Defined in DSV.ZipViewType Methods pure :: a -> ZipView headerError rowError a # (<*>) :: ZipView headerError rowError (a -> b) -> ZipView headerError rowError a -> ZipView headerError rowError b # liftA2 :: (a -> b -> c) -> ZipView headerError rowError a -> ZipView headerError rowError b -> ZipView headerError rowError c # (*>) :: ZipView headerError rowError a -> ZipView headerError rowError b -> ZipView headerError rowError b # (<*) :: ZipView headerError rowError a -> ZipView headerError rowError b -> ZipView headerError rowError a # |
Basic zip view operations
overZipViewError :: forall headerError1 headerError2 rowError1 rowError2 a. (headerError1 -> headerError2) -> (rowError1 -> rowError2) -> ZipView headerError1 rowError1 a -> ZipView headerError2 rowError2 a Source #
overHeaderError :: (headerError1 -> headerError2) -> ZipView headerError1 rowError a -> ZipView headerError2 rowError a Source #
overRowError :: (rowError1 -> rowError2) -> ZipView headerError rowError1 a -> ZipView headerError rowError2 a Source #
Converting a ZipView to a Pipe
Arguments
:: 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 |
zipViewPipeIgnoringAllErrors Source #
Arguments
:: 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 |
zipViewPipeThrowFirstError Source #
Arguments
:: 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 |
Some zip views
textZipViewUtf8 :: forall e a. Text -> View e ByteString a -> ZipView (At (ColumnName Text) LookupError) (At (ColumnName Text) (IndexError e)) a Source #
textZipViewUtf8' :: Text -> ZipView (At (ColumnName Text) LookupError) (At (ColumnName Text) TooShort) ByteString Source #
byteStringZipViewPosition :: forall headerError. ColumnNumber -> ZipView headerError TooShort ByteString Source #
entireRowZipView :: forall he re. ZipView he re (Vector ByteString) Source #
Refining a ZipView with a View
Combining a ZipView with a Fold
zipViewFold :: forall headerError rowError row result. ZipView headerError rowError row -> Fold (Validation rowError row) result -> Fold (Vector ByteString) (Validation (ZipViewError headerError) result) Source #
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) Source #
data ZipViewError headerError Source #
Constructors
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. |
Reading strictly from CSV files using ZipView
Arguments
:: 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)) |
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.
A read ends with a ZipViewStop
data ZipViewStop headerError Source #
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.
Constructors
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. |
Instances
Eq headerError => Eq (ZipViewStop headerError) Source # | |
Defined in DSV.ZipViewStop Methods (==) :: ZipViewStop headerError -> ZipViewStop headerError -> Bool # (/=) :: ZipViewStop headerError -> ZipViewStop headerError -> Bool # | |
Show headerError => Show (ZipViewStop headerError) Source # | |
Defined in DSV.ZipViewStop Methods showsPrec :: Int -> ZipViewStop headerError -> ShowS # show :: ZipViewStop headerError -> String # showList :: [ZipViewStop headerError] -> ShowS # |
Using other delimiters
Arguments
:: forall m headerError rowError row. MonadIO m | |
=> Delimiter | What character separates input values, e.g. |
-> 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)) |
zipViewDsvFileStrictThrowFirstError Source #
Arguments
:: forall m headerError rowError row. (MonadIO m, Exception headerError, Show rowError, Typeable rowError) | |
=> Delimiter | What character separates input values, e.g. |
-> FilePath | The path of a DSV file to read |
-> ZipView headerError rowError row | How to interpret the rows |
-> m (Vector row) |
Pipes
Pipes that parse DSV rows
csvRowPipe :: forall m. Monad m => Pipe ByteString (Vector ByteString) m ParseError Source #
This pipe await
s ByteString
input read from a CSV file, parses the input, and yield
s a
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 Vector
ByteString
return
s a ParseError
.
Arguments
:: forall m. Monad m | |
=> Delimiter | |
-> Pipe ByteString (Vector ByteString) m ParseError |
Like csvRowPipe
, but allows customizing the delimiter.
Creating row producers from file handles
Pipes that combine the header with subsequent rows
zipHeaderPipe :: forall a m r. Monad m => Pipe (Vector a) (Vector (a, a)) m r Source #
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")]
zipHeaderWithPipe :: forall a b m r. Monad m => (a -> a -> b) -> Pipe (Vector a) (Vector b) m r Source #
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"]
What are Pipes
See the Pipes module for more on pipes.
runEffect :: Monad m => Effect m r -> m r #
Run a self-contained Effect
, converting it back to the base monad
Attoparsec
See the Data.Attoparsec.ByteString module for more on parsing byte strings.
type AttoParser = Parser Source #
attoPipe :: forall a m. Monad m => AttoParser a -> Pipe ByteString a m ParseError Source #
Arguments
:: forall a m. MonadIO m | |
=> AttoParser a | |
-> Handle | File handle to read parser input from |
-> Producer a m ParseStop |
data ParseError Source #
Constructors
ParseError |
Instances
Eq ParseError Source # | |
Defined in DSV.ParseError | |
Show ParseError Source # | |
Defined in DSV.ParseError Methods showsPrec :: Int -> ParseError -> ShowS # show :: ParseError -> String # showList :: [ParseError] -> ShowS # | |
Exception ParseError Source # | |
Defined in DSV.ParseError Methods toException :: ParseError -> SomeException # fromException :: SomeException -> Maybe ParseError # displayException :: ParseError -> String # |
Position types
data Position row col Source #
Constructors
Position row col |
Instances
(Eq row, Eq col) => Eq (Position row col) Source # | |
(Ord row, Ord col) => Ord (Position row col) Source # | |
Defined in DSV.Position Methods compare :: Position row col -> Position row col -> Ordering # (<) :: Position row col -> Position row col -> Bool # (<=) :: Position row col -> Position row col -> Bool # (>) :: Position row col -> Position row col -> Bool # (>=) :: Position row col -> Position row col -> Bool # max :: Position row col -> Position row col -> Position row col # min :: Position row col -> Position row col -> Position row col # | |
(Show row, Show col) => Show (Position row col) Source # | |
Instances
Eq RowNumber Source # | |
Num RowNumber Source # | |
Ord RowNumber Source # | |
Show RowNumber Source # | |
newtype ColumnNumber Source #
Constructors
ColumnNumber Positive |
Instances
Eq ColumnNumber Source # | |
Defined in DSV.Position | |
Num ColumnNumber Source # | |
Defined in DSV.Position Methods (+) :: ColumnNumber -> ColumnNumber -> ColumnNumber # (-) :: ColumnNumber -> ColumnNumber -> ColumnNumber # (*) :: ColumnNumber -> ColumnNumber -> ColumnNumber # negate :: ColumnNumber -> ColumnNumber # abs :: ColumnNumber -> ColumnNumber # signum :: ColumnNumber -> ColumnNumber # fromInteger :: Integer -> ColumnNumber # | |
Ord ColumnNumber Source # | |
Defined in DSV.Position Methods compare :: ColumnNumber -> ColumnNumber -> Ordering # (<) :: ColumnNumber -> ColumnNumber -> Bool # (<=) :: ColumnNumber -> ColumnNumber -> Bool # (>) :: ColumnNumber -> ColumnNumber -> Bool # (>=) :: ColumnNumber -> ColumnNumber -> Bool # max :: ColumnNumber -> ColumnNumber -> ColumnNumber # min :: ColumnNumber -> ColumnNumber -> ColumnNumber # | |
Show ColumnNumber Source # | |
Defined in DSV.Position Methods showsPrec :: Int -> ColumnNumber -> ShowS # show :: ColumnNumber -> String # showList :: [ColumnNumber] -> ShowS # |
newtype ColumnName str Source #
Constructors
ColumnName str |
Instances
Eq str => Eq (ColumnName str) Source # | |
Defined in DSV.Position Methods (==) :: ColumnName str -> ColumnName str -> Bool # (/=) :: ColumnName str -> ColumnName str -> Bool # | |
Ord str => Ord (ColumnName str) Source # | |
Defined in DSV.Position Methods compare :: ColumnName str -> ColumnName str -> Ordering # (<) :: ColumnName str -> ColumnName str -> Bool # (<=) :: ColumnName str -> ColumnName str -> Bool # (>) :: ColumnName str -> ColumnName str -> Bool # (>=) :: ColumnName str -> ColumnName str -> Bool # max :: ColumnName str -> ColumnName str -> ColumnName str # min :: ColumnName str -> ColumnName str -> ColumnName str # | |
Show str => Show (ColumnName str) Source # | |
Defined in DSV.Position Methods showsPrec :: Int -> ColumnName str -> ShowS # show :: ColumnName str -> String # showList :: [ColumnName str] -> ShowS # |
Constructors
At | |
Fields
|
Instances
(Eq p, Eq a) => Eq (At p a) Source # | |
(Ord p, Ord a) => Ord (At p a) Source # | |
(Show p, Show a) => Show (At p a) Source # | |
(Typeable p, Typeable a, Show p, Show a) => Exception (At p a) Source # | |
Defined in DSV.Position Methods toException :: At p a -> SomeException # fromException :: SomeException -> Maybe (At p a) # displayException :: At p a -> String # |
Text
What is Text
A space efficient, packed, unboxed Unicode text type.
Instances
Chunk Text | |
Defined in Data.Attoparsec.Internal.Types | |
Hashable Text | |
Defined in Data.Hashable.Class | |
Ixed Text | |
Defined in Control.Lens.At | |
type State Text | |
Defined in Data.Attoparsec.Internal.Types | |
type ChunkElem Text | |
Defined in Data.Attoparsec.Internal.Types | |
type Item Text | |
type Index Text | |
Defined in Control.Lens.At | |
type IxValue Text | |
Defined in Control.Lens.At |
Relationship to String
stringToText :: String -> Text Source #
textToString :: Text -> String Source #
Relationship to Bytestring
encodeTextUtf8 :: Text -> ByteString Source #
data InvalidUtf8 Source #
Constructors
InvalidUtf8 |
Instances
Eq InvalidUtf8 Source # | |
Defined in DSV.UTF8 | |
Show InvalidUtf8 Source # | |
Defined in DSV.UTF8 Methods showsPrec :: Int -> InvalidUtf8 -> ShowS # show :: InvalidUtf8 -> String # showList :: [InvalidUtf8] -> ShowS # | |
Exception InvalidUtf8 Source # | |
Defined in DSV.UTF8 Methods toException :: InvalidUtf8 -> SomeException # fromException :: SomeException -> Maybe InvalidUtf8 # displayException :: InvalidUtf8 -> String # |