sv-0.1: Encode and decode separated values (CSV, PSV, ...)

Copyright(C) CSIRO 2017-2018
LicenseBSD3
MaintainerGeorge Wilson <george.wilson@data61.csiro.au>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Data.Sv.Encode

Contents

Description

This module is intended to be imported qualified as follows

import Data.Sv.Encode 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 Encodes.

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

Documentation

newtype Encode a Source #

An Encode converts its argument into one or more textual fields, to be written out as CSV.

It is Semigroup, Contravariant', Divisible, and Decidable, allowing for composition of these values to build bigger Encodes from smaller ones.

Constructors

Encode 

Fields

Instances

Contravariant Encode Source # 

Methods

contramap :: (a -> b) -> Encode b -> Encode a #

(>$) :: b -> Encode b -> Encode a #

Divisible Encode Source # 

Methods

divide :: (a -> (b, c)) -> Encode b -> Encode c -> Encode a #

conquer :: Encode a #

Decidable Encode Source # 

Methods

lose :: (a -> Void) -> Encode a #

choose :: (a -> Either b c) -> Encode b -> Encode c -> Encode a #

Semigroup (Encode a) Source # 

Methods

(<>) :: Encode a -> Encode a -> Encode a #

sconcat :: NonEmpty (Encode a) -> Encode a #

stimes :: Integral b => b -> Encode a -> Encode a #

Monoid (Encode a) Source # 

Methods

mempty :: Encode a #

mappend :: Encode a -> Encode a -> Encode a #

mconcat :: [Encode a] -> Encode a #

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.

unsafeBuilder :: (a -> Builder) -> Encode a Source #

Make an encode from any function that returns a ByteString Builder.

Running an Encode

encode :: Encode a -> EncodeOptions -> [a] -> ByteString Source #

Encode the given list with the given Encode, configured by the given EncodeOptions.

encodeToHandle :: Encode a -> EncodeOptions -> [a] -> Handle -> IO () Source #

Encode, writing the output to a file handle.

encodeToFile :: Encode a -> EncodeOptions -> [a] -> FilePath -> IO () Source #

Encode, writing to a file. This is 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 ByteStrings.

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

encodeSv :: Encode a -> EncodeOptions -> Maybe (NonEmpty ByteString) -> [a] -> Sv ByteString Source #

Build an Sv rather than going straight to ByteString. This allows you to query the Sv or run sanity checks.

Options

Primitive encodes

Field-based

const :: ByteString -> Encode a Source #

Encode this ByteString every time, ignoring the input.

show :: Show a => Encode a Source #

Build an Encode using a type's Show instance.

nop :: Encode a Source #

Don't encode anything.

empty :: Encode a Source #

Encode anything as the empty string.

orEmpty :: Encode a -> Encode (Maybe a) Source #

Lift an Encode to be able to hanlde Maybe, by using the empty string in the case of Nothing

char :: Encode Char Source #

Encode a single Char

int :: Encode Int Source #

Encode an Int

boolTrueFalse :: Encode Bool Source #

Encode a Bool as False or True

booltruefalse :: Encode Bool Source #

Encode a Bool as false or true

boolyesno :: Encode Bool Source #

Encode a Bool as no or yes

boolYesNo :: Encode Bool Source #

Encode a Bool as No or Yes

boolYN :: Encode Bool Source #

Encode a Bool as N or Y

bool10 :: Encode Bool Source #

Encode a Bool as 0 or 1

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 -> Encode () -> Encode (Maybe a) Source #

Build an Encode for Maybe given a Just and a Nothing encode.

(<?) :: Encode () -> Encode a -> Encode (Maybe a) Source #

Build an Encode for Maybe given a Nothing and a Just encode.

(?>>) :: 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.

encodeOfMay :: Getting (First a) s a -> Encode (Maybe a) -> Encode s Source #

Like encodeOf, but you can handle Nothing however you'd like. In encodeOf, it is handled by the Encode which does nothing, but for example you might like to use orEmpty to encode an empty field.

Unsafe encodes

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