Copyright | (C) CSIRO 2017-2019 |
---|---|
License | BSD3 |
Maintainer | George Wilson <george.wilson@data61.csiro.au> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module is intended to be imported qualified as follows
import Data.Sv.Encode.Core as E
To produce a CSV file from data types, build an Encode
for your data
type. This module contains primitives, combinators, and type class instances
to help you to do so.
Encode
is a Contravariant
functor, as well as a Divisible
and
Decidable
. Divisible
is the contravariant form of Applicative
,
while Decidable
is the contravariant form of Alternative
.
These type classes will provide useful combinators for working with Encode
s.
Specialised to Encode
, the function divide
from Divisible
has the type:
divide :: (a -> (b,c)) -> Encode b -> Encode c -> Encode a
which can be read "if a
can be split into b
and c
, and I can handle
b
, and I can handle c
, then I can handle a
".
Here the "I can handle"
part corresponds to the Encode
. If we think of (covariant) functors as
being "full of" a
, then we can think of contravariant functors as being
"able to handle" a
.
How does it work? Perform the split on the a
, handle the b
by converting
it into some text,
handle the c
by also converting it to some text, then put each of those
text fragments into their own field in the CSV.
Similarly, the function choose
from Decidable
, specialsed to Encode
, has the type:
choose :: (a -> Either b c) -> Encode b -> Encode c -> Encode a
which can be read "if a
is either b
or c
, and I can handle b
,
and I can handle c
, then I can handle a
".
This works by performing the split, then checking whether b
or c
resulted,
then using the appropriate Encode
.
For an example of encoding, see Encoding.hs
Synopsis
- newtype Encode a = Encode {
- getEncode :: EncodeOptions -> a -> Seq Builder
- mkEncodeBS :: (a -> ByteString) -> Encode a
- mkEncodeWithOpts :: (EncodeOptions -> a -> Builder) -> Encode a
- encode :: Encode a -> EncodeOptions -> [a] -> ByteString
- encodeNamed :: NameEncode a -> EncodeOptions -> [a] -> ByteString
- encodeToHandle :: Encode a -> EncodeOptions -> [a] -> Handle -> IO ()
- encodeNamedToHandle :: NameEncode a -> EncodeOptions -> [a] -> Handle -> IO ()
- encodeToFile :: Encode a -> EncodeOptions -> [a] -> FilePath -> IO ()
- encodeNamedToFile :: NameEncode a -> EncodeOptions -> [a] -> FilePath -> IO ()
- encodeBuilder :: Encode a -> EncodeOptions -> [a] -> Builder
- encodeNamedBuilder :: NameEncode a -> EncodeOptions -> [a] -> Builder
- encodeRow :: Encode a -> EncodeOptions -> a -> ByteString
- encodeRowBuilder :: Encode a -> EncodeOptions -> a -> Builder
- class HasSeparator c where
- class HasSeparator c => HasEncodeOptions c
- data EncodeOptions = EncodeOptions {}
- data Quoting
- defaultEncodeOptions :: EncodeOptions
- named :: Builder -> Encode a -> NameEncode a
- (=:) :: Builder -> Encode a -> NameEncode a
- const :: ByteString -> Encode a
- show :: Show a => Encode a
- nop :: Encode a
- empty :: Encode a
- orEmpty :: Encode a -> Encode (Maybe a)
- char :: Encode Char
- int :: Encode Int
- integer :: Encode Integer
- float :: Encode Float
- double :: Encode Double
- doubleFast :: Encode Double
- boolTrueFalse :: Encode Bool
- booltruefalse :: Encode Bool
- boolyesno :: Encode Bool
- boolYesNo :: Encode Bool
- boolYN :: Encode Bool
- bool10 :: Encode Bool
- string :: Encode String
- text :: Encode Text
- byteString :: Encode ByteString
- lazyByteString :: Encode ByteString
- row :: Encode s -> Encode [s]
- (?>) :: Encode a -> Encode () -> Encode (Maybe a)
- (<?) :: Encode () -> Encode a -> Encode (Maybe a)
- (?>>) :: Encode a -> ByteString -> Encode (Maybe a)
- (<<?) :: ByteString -> Encode a -> Encode (Maybe a)
- encodeOf :: Getting (First a) s a -> Encode a -> Encode s
- encodeOfMay :: Getting (First a) s a -> Encode (Maybe a) -> Encode s
- unsafeBuilder :: (a -> Builder) -> Encode a
- unsafeString :: Encode String
- unsafeText :: Encode Text
- unsafeByteString :: Encode ByteString
- unsafeLazyByteString :: Encode ByteString
- unsafeByteStringBuilder :: Encode Builder
- unsafeConst :: ByteString -> Encode a
Documentation
An Encode
converts its argument into one or more textual fields, to be
written out as CSV.
It is Semigroup
, Monoid
, Contravariant
, Divisible
, and Decidable
,
allowing for composition of these values to build bigger Encode
s
from smaller ones.
Encode | |
|
Convenience constructors
mkEncodeBS :: (a -> ByteString) -> Encode a Source #
Make an Encode
from a function that builds one Field
.
mkEncodeWithOpts :: (EncodeOptions -> a -> Builder) -> Encode a Source #
Make an Encode
from a function that builds one Field
.
Running an Encode
encode :: Encode a -> EncodeOptions -> [a] -> ByteString Source #
Encode the given list using the given Encode
, configured by the given
EncodeOptions
.
encodeNamed :: NameEncode a -> EncodeOptions -> [a] -> ByteString Source #
Encode the given list with a header using the given NameEncode
,
configured by the given EncodeOptions
.
encodeToHandle :: Encode a -> EncodeOptions -> [a] -> Handle -> IO () Source #
Encode, writing the output to a file handle.
encodeNamedToHandle :: NameEncode a -> EncodeOptions -> [a] -> Handle -> IO () Source #
Encode with a header, writing the output to a file handle.
encodeToFile :: Encode a -> EncodeOptions -> [a] -> FilePath -> IO () Source #
Encode, writing to a file. This way is more efficient than encoding to
a ByteString
and then writing to file.
encodeNamedToFile :: NameEncode a -> EncodeOptions -> [a] -> FilePath -> IO () Source #
Encode with a header, writing to a file. This way is more efficient
than encoding to a ByteString
and then writing to file.
encodeBuilder :: Encode a -> EncodeOptions -> [a] -> Builder Source #
Encode to a ByteString Builder
, which is useful if you are going
to combine the output with other ByteString
s.
encodeNamedBuilder :: NameEncode a -> EncodeOptions -> [a] -> Builder Source #
Encode with column names to a ByteString Builder
, which is useful
if you are going to combine the output with other ByteString
s.
encodeRow :: Encode a -> EncodeOptions -> a -> ByteString Source #
Encode one row only
encodeRowBuilder :: Encode a -> EncodeOptions -> a -> Builder Source #
Encode one row only, as a ByteString Builder
Options
class HasSeparator c where Source #
Classy lens for Separator
Instances
HasSeparator Word8 Source # | |
HasSeparator EncodeOptions Source # | |
Defined in Data.Sv.Encode.Options |
class HasSeparator c => HasEncodeOptions c Source #
Classy lenses for EncodeOptions
import Control.Lens defaultEncodeOptions & newline .~ crlf & quoting .~ Always
Instances
HasEncodeOptions EncodeOptions Source # | |
data EncodeOptions Source #
These are options to configure encoding. A default is provided as
defaultEncodeOptions
.
EncodeOptions | |
|
Instances
HasSeparator EncodeOptions Source # | |
Defined in Data.Sv.Encode.Options | |
HasEncodeOptions EncodeOptions Source # | |
Should the output file have quotes around every value, or only when they are required?
Beware the Never
constructor. It can construct malformed CSV files if
there are fields containing quotes, newlines, or separators. It is the
fastest option though, so you might like to use it if you're sure none
of your encoded data will include those characters.
defaultEncodeOptions :: EncodeOptions Source #
The default options for encoding.
The default is a CSV file with quotes when necessary, LF lines, and no terminating newline.
Primitive encodes
Name-based
(=:) :: Builder -> Encode a -> NameEncode a Source #
Synonym for named
.
Mnemonic: Dot colon names Decoders, Equal colon names Encoders.
Field-based
const :: ByteString -> Encode a Source #
Encode this ByteString
every time, ignoring the input.
double :: Encode Double Source #
Encode a Double
This version satisfies the roundtrip property. If that doesn't matter to you,
use the faster version doubleFast
doubleFast :: Encode Double Source #
Encode a Double
really quickly. This version uses the double-conversion
package.
byteString :: Encode ByteString Source #
Encode a strict ByteString
lazyByteString :: Encode ByteString Source #
Encode a lazy ByteString
Row-based
row :: Encode s -> Encode [s] Source #
Encode a list as a whole row at once, using the same Encode
for every element
Combinators
(?>>) :: Encode a -> ByteString -> Encode (Maybe a) Source #
Build an Encode
for Maybe
given a Just
encode and a
ByteString
for the Nothing
case.
(<<?) :: ByteString -> Encode a -> Encode (Maybe a) Source #
Build an Encode
for Maybe
given a ByteString
for the Nothing
case and a Just
encode.
encodeOf :: Getting (First a) s a -> Encode a -> Encode s Source #
Given an optic from s
to a
, Try to use it to build an encode.
encodeOf :: Iso' s a -> Encode a -> Encode s encodeOf :: Lens' s a -> Encode a -> Encode s encodeOf :: Prism' s a -> Encode a -> Encode s encodeOf :: Traversal' s a -> Encode a -> Encode s encodeOf :: Fold s a -> Encode a -> Encode s encodeOf :: Getter s a -> Encode a -> Encode s
This is very useful when you have a prism for each constructor of your type.
You can define an Encode
as follows:
myEitherEncode :: Encode a -> Encode b -> Encode (Either a b) myEitherEncode encA encB = encodeOf _Left encA <> encodeOf _Right encB
In this example, when the prism lookup returns Nothing
, the empty encoder
is returned. This is the mempty
for the Encode
monoid, so it won't
add a field to the resulting CSV. This is the behaviour you want for
combining a collection of prisms.
But this encoder also works with lenses (or weaker optics), which will
never fail their lookup, in which case it never returns mempty
.
So this actually does the right thing for both sum and product types.
Unsafe encodes
unsafeBuilder :: (a -> Builder) -> Encode a Source #
Make an encode from any function that returns a ByteString Builder
.
unsafeString :: Encode String Source #
Encode a String
really quickly.
If the string has quotes in it, they will not be escaped properly, so
the result maybe not be valid CSV
unsafeText :: Encode Text Source #
Encode Text
really quickly.
If the text has quotes in it, they will not be escaped properly, so
the result maybe not be valid CSV
unsafeByteString :: Encode ByteString Source #
Encode a ByteString
really quickly.
If the string has quotes in it, they will not be escaped properly, so
the result maybe not be valid CSV
unsafeLazyByteString :: Encode ByteString Source #
Encode a ByteString
really quickly.
If the string has quotes in it, they will not be escaped properly, so
the result maybe not be valid CSV
unsafeByteStringBuilder :: Encode Builder Source #
Encode ByteString Builder
really quickly.
If the builder builds a string with quotes in it, they will not be escaped
properly, so the result maybe not be valid CSV
unsafeConst :: ByteString -> Encode a Source #
Encode this ByteString
really quickly every time, ignoring the input.
If the string has quotes in it, they will not be escaped properly, so
the result maybe not be valid CSV