Copyright | Ozgun Ataman Johan Tibell |
---|---|
License | BSD3 |
Maintainer | Ozgun Ataman <ozataman@gmail.com> |
Stability | experimental |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This module has been shamelessly taken from Johan Tibell's nicely
put together cassava package, which itself borrows the approach
from Bryan OSullivan
s widely used aeson package.
We make the necessary adjustments and some simplifications here to bolt this parsing interface onto our underlying CSV typeclass.
Synopsis
- newtype Only a = Only {
- fromOnly :: a
- newtype Named a = Named {
- getNamed :: a
- newtype NamedOrdered a = NamedOrdered {
- getNamedOrdered :: a
- type Record = Vector ByteString
- type NamedRecord = Map ByteString ByteString
- type NamedRecordOrdered = OMap ByteString ByteString
- class FromRecord a where
- parseRecord :: Record -> Parser a
- class FromNamedRecord a where
- parseNamedRecord :: NamedRecord -> Parser a
- class FromNamedRecordOrdered a where
- class ToNamedRecord a where
- toNamedRecord :: a -> NamedRecord
- class ToNamedRecordOrdered a where
- class FromField a where
- parseField :: Field -> Parser a
- class ToRecord a where
- class ToField a where
- type Field = ByteString
- data Parser a
- runParser :: Parser a -> Either String a
- index :: FromField a => Record -> Int -> Parser a
- (.!) :: FromField a => Record -> Int -> Parser a
- unsafeIndex :: FromField a => Record -> Int -> Parser a
- lookup :: FromField a => NamedRecord -> ByteString -> Parser a
- lookupOrdered :: FromField a => NamedRecordOrdered -> ByteString -> Parser a
- (.:) :: FromField a => NamedRecord -> ByteString -> Parser a
- namedField :: ToField a => ByteString -> a -> (ByteString, ByteString)
- (.=) :: ToField a => ByteString -> a -> (ByteString, ByteString)
- record :: [ByteString] -> Record
- namedRecord :: [(ByteString, ByteString)] -> NamedRecord
- namedRecordOrdered :: [(ByteString, ByteString)] -> NamedRecordOrdered
Type conversion
Haskell lacks a single-element tuple type, so if you CSV data
with just one column you can use the Only
type to represent a
single-column result.
A wrapper around custom haskell types that can directly be converted/parsed from an incoming CSV stream.
We define this wrapper to stop GHC from complaining
about overlapping instances. Just use getNamed
to get your
object out of the wrapper.
Instances
(FromNamedRecord a, ToNamedRecord a, CSV s (MapRow ByteString)) => CSV s (Named a) Source # | Conversion of stream directly to/from a custom complex haskell type. |
Defined in Data.CSV.Conduit | |
Read a => Read (Named a) Source # | |
Show a => Show (Named a) Source # | |
Eq a => Eq (Named a) Source # | |
Ord a => Ord (Named a) Source # | |
Defined in Data.CSV.Conduit.Conversion |
newtype NamedOrdered a Source #
Instances
type Record = Vector ByteString Source #
A record corresponds to a single line in a CSV file.
type NamedRecord = Map ByteString ByteString Source #
A shorthand for the ByteString case of MapRow
class FromRecord a where Source #
A type that can be converted from a single CSV record, with the possibility of failure.
When writing an instance, use empty
, mzero
, or fail
to make a
conversion fail, e.g. if a Record
has the wrong number of
columns.
Given this example data:
John,56 Jane,55
here's an example type and instance:
data Person = Person { name :: !Text, age :: !Int } instance FromRecord Person where parseRecord v | length v == 2 = Person <$> v .! 0 <*> v .! 1 | otherwise = mzero
parseRecord :: Record -> Parser a Source #
Instances
class FromNamedRecord a where Source #
A type that can be converted from a single CSV record, with the possibility of failure.
When writing an instance, use empty
, mzero
, or fail
to make a
conversion fail, e.g. if a Record
has the wrong number of
columns.
Given this example data:
name,age John,56 Jane,55
here's an example type and instance:
{-# LANGUAGE OverloadedStrings #-} data Person = Person { name :: !Text, age :: !Int } instance FromNamedRecord Person where parseNamedRecord m = Person <$> m .: "name" <*> m .: "age"
Note the use of the OverloadedStrings
language extension which
enables ByteString
values to be written as string literals.
parseNamedRecord :: NamedRecord -> Parser a Source #
Instances
FromField a => FromNamedRecord (Map ByteString a) Source # | |
Defined in Data.CSV.Conduit.Conversion parseNamedRecord :: NamedRecord -> Parser (Map ByteString a) Source # |
class FromNamedRecordOrdered a where Source #
Instances
FromField a => FromNamedRecordOrdered (OMap ByteString a) Source # | |
Defined in Data.CSV.Conduit.Conversion |
class ToNamedRecord a where Source #
A type that can be converted to a single CSV record.
An example type and instance:
data Person = Person { name :: !Text, age :: !Int } instance ToNamedRecord Person where toNamedRecord (Person name age) = namedRecord [ "name" .= name, "age" .= age]
toNamedRecord :: a -> NamedRecord Source #
Instances
ToField a => ToNamedRecord (Map ByteString a) Source # | |
Defined in Data.CSV.Conduit.Conversion toNamedRecord :: Map ByteString a -> NamedRecord Source # |
class ToNamedRecordOrdered a where Source #
Instances
ToField a => ToNamedRecordOrdered (OMap ByteString a) Source # | |
Defined in Data.CSV.Conduit.Conversion |
class FromField a where Source #
A type that can be converted from a single CSV field, with the possibility of failure.
When writing an instance, use empty
, mzero
, or fail
to make a
conversion fail, e.g. if a Field
can't be converted to the given
type.
Example type and instance:
{-# LANGUAGE OverloadedStrings #-} data Color = Red | Green | Blue instance FromField Color where parseField s | s == "R" = pure Red | s == "G" = pure Green | s == "B" = pure Blue | otherwise = mzero
parseField :: Field -> Parser a Source #
Instances
class ToRecord a where Source #
A type that can be converted to a single CSV record.
An example type and instance:
data Person = Person { name :: !Text, age :: !Int } instance ToRecord Person where toRecord (Person name age) = record [ toField name, toField age]
Outputs data on this form:
John,56 Jane,55
Instances
ToField a => ToRecord (Only a) Source # | |
ToField a => ToRecord (Vector a) Source # | |
(ToField a, Unbox a) => ToRecord (Vector a) Source # | |
ToField a => ToRecord [a] Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b) => ToRecord (a, b) Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b, ToField c) => ToRecord (a, b, c) Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b, ToField c, ToField d) => ToRecord (a, b, c, d) Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b, ToField c, ToField d, ToField e) => ToRecord (a, b, c, d, e) Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToRecord (a, b, c, d, e, f) Source # | |
Defined in Data.CSV.Conduit.Conversion | |
(ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToRecord (a, b, c, d, e, f, g) Source # | |
Defined in Data.CSV.Conduit.Conversion |
class ToField a where Source #
A type that can be converted to a single CSV field.
Example type and instance:
{-# LANGUAGE OverloadedStrings #-} data Color = Red | Green | Blue instance ToField Color where toField Red = "R" toField Green = "G" toField Blue = "B"
Instances
ToField Int16 Source # | Uses decimal encoding with optional sign. |
ToField Int32 Source # | Uses decimal encoding with optional sign. |
ToField Int64 Source # | Uses decimal encoding with optional sign. |
ToField Int8 Source # | Uses decimal encoding with optional sign. |
ToField Word16 Source # | Uses decimal encoding. |
ToField Word32 Source # | Uses decimal encoding. |
ToField Word64 Source # | Uses decimal encoding. |
ToField Word8 Source # | Uses decimal encoding. |
ToField ByteString Source # | |
Defined in Data.CSV.Conduit.Conversion toField :: ByteString -> Field Source # | |
ToField ByteString Source # | |
Defined in Data.CSV.Conduit.Conversion toField :: ByteString -> Field Source # | |
ToField Text Source # | Uses UTF-8 encoding. |
ToField Text Source # | Uses UTF-8 encoding. |
ToField Integer Source # | Uses decimal encoding with optional sign. |
ToField Char Source # | Uses UTF-8 encoding. |
ToField Double Source # | Uses decimal notation or scientific notation, depending on the number. |
ToField Float Source # | Uses decimal notation or scientific notation, depending on the number. |
ToField Int Source # | Uses decimal encoding with optional sign. |
ToField Word Source # | Uses decimal encoding. |
ToField a => ToField (Maybe a) Source # | |
ToField [Char] Source # | Uses UTF-8 encoding. |
type Field = ByteString Source #
A single field within a record.
Parser
Conversion of a field to a value might fail e.g. if the field is
malformed. This possibility is captured by the Parser
type, which
lets you compose several field conversions together in such a way
that if any of them fail, the whole record conversion fails.
Accessors
index :: FromField a => Record -> Int -> Parser a Source #
Retrieve the nth field in the given record. The result is
empty
if the value cannot be converted to the desired type.
Raises an exception if the index is out of bounds.
index
is a simple convenience function that is equivalent to
. If you're certain that the index is not
out of bounds, using parseField
(v !
idx)unsafeIndex
is somewhat faster.
unsafeIndex :: FromField a => Record -> Int -> Parser a Source #
Like index
but without bounds checking.
lookup :: FromField a => NamedRecord -> ByteString -> Parser a Source #
Retrieve a field in the given record by name. The result is
empty
if the field is missing or if the value cannot be converted
to the desired type.
lookupOrdered :: FromField a => NamedRecordOrdered -> ByteString -> Parser a Source #
(.:) :: FromField a => NamedRecord -> ByteString -> Parser a Source #
Alias for lookup
.
namedField :: ToField a => ByteString -> a -> (ByteString, ByteString) Source #
Construct a pair from a name and a value. For use with
namedRecord
.
(.=) :: ToField a => ByteString -> a -> (ByteString, ByteString) Source #
Alias for namedField
.
record :: [ByteString] -> Record Source #
Construct a record from a list of ByteString
s. Use toField
to convert values to ByteString
s for use with record
.
namedRecord :: [(ByteString, ByteString)] -> NamedRecord Source #
Construct a named record from a list of name-value ByteString
pairs. Use .=
to construct such a pair from a name and a value.
namedRecordOrdered :: [(ByteString, ByteString)] -> NamedRecordOrdered Source #