siphon-0.8.2.1: Encode and decode CSV files
Safe HaskellSafe-Inferred
LanguageHaskell2010

Siphon

Description

Build CSVs using the abstractions provided in the colonnade library, and parse CSVs using Siphon, which is the dual of Colonnade. Read the documentation for colonnade before reading the documentation for siphon. All of the examples on this page assume a common set of imports that are provided at the bottom of this page.

Synopsis

Encode CSV

encodeCsv Source #

Arguments

:: (Foldable f, Headedness h) 
=> Colonnade h a Text

Tablular encoding

-> f a

Value of each row

-> Builder 

Encode a collection to a CSV as a text Builder. For example, we can take the following columnar encoding of a person:

>>> :{
let colPerson :: Colonnade Headed Person Text
    colPerson = mconcat
      [ C.headed "Name" name
      , C.headed "Age" (T.pack . show . age)
      , C.headed "Company" (fromMaybe "N/A" . company)
      ]
:}

And we have the following people whom we wish to encode in this way:

>>> :{
let people :: [Person]
    people =
      [ Person "Chao" 26 (Just "Tectonic, Inc.")
      , Person "Elsie" 41 (Just "Globex Corporation")
      , Person "Arabella" 19 Nothing
      ]
:}

We pair the encoding with the rows to get a CSV:

>>> LTIO.putStr (TB.toLazyText (encodeCsv colPerson people))
Name,Age,Company
Chao,26,"Tectonic, Inc."
Elsie,41,Globex Corporation
Arabella,19,N/A

encodeCsvStream :: (Monad m, Headedness h) => Colonnade h a Text -> Stream (Of a) m r -> Stream (Of Text) m r Source #

Streaming variant of encodeCsv. This is particularly useful when you need to produce millions of rows without having them all loaded into memory at the same time.

encodeCsvUtf8 Source #

Arguments

:: (Foldable f, Headedness h) 
=> Colonnade h a ByteString

Tablular encoding

-> f a

Value of each row

-> Builder 

Encode a collection to a CSV as a bytestring Builder.

Decode CSV

decodeCsvUtf8 Source #

Arguments

:: Monad m 
=> Siphon Headed ByteString a 
-> Stream (Of ByteString) m ()

encoded csv

-> Stream (Of a) m (Maybe SiphonError) 

Backwards-compatibility alias for decodeHeadedCsvUtf8.

decodeHeadedCsvUtf8 Source #

Arguments

:: Monad m 
=> Siphon Headed ByteString a 
-> Stream (Of ByteString) m ()

encoded csv

-> Stream (Of a) m (Maybe SiphonError) 

Decode a CSV whose first row is contains headers identify each column.

decodeIndexedCsvUtf8 Source #

Arguments

:: Monad m 
=> Int

How many columns are there? This number should be greater than any indices referenced by the scheme.

-> Siphon Indexed ByteString a 
-> Stream (Of ByteString) m ()

encoded csv

-> Stream (Of a) m (Maybe SiphonError) 

Decode a CSV without a header.

Build Siphon

headed :: c -> (c -> Maybe a) -> Siphon Headed c a Source #

Uses the second argument to parse a CSV column whose header content matches the first column exactly.

headless :: (c -> Maybe a) -> Siphon Headless c a Source #

Uses the argument to parse a CSV column.

indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a Source #

Uses the second argument to parse a CSV column that is positioned at the index given by the first argument.

Types

data Siphon f c a Source #

This just actually a specialization of the free applicative. Check out Control.Applicative.Free in the free library to learn more about this. The meanings of the fields are documented slightly more in the source code. Unfortunately, haddock does not play nicely with GADTs.

Instances

Instances details
Applicative (Siphon f c) Source # 
Instance details

Defined in Siphon.Types

Methods

pure :: a -> Siphon f c a #

(<*>) :: Siphon f c (a -> b) -> Siphon f c a -> Siphon f c b #

liftA2 :: (a -> b -> c0) -> Siphon f c a -> Siphon f c b -> Siphon f c c0 #

(*>) :: Siphon f c a -> Siphon f c b -> Siphon f c b #

(<*) :: Siphon f c a -> Siphon f c b -> Siphon f c a #

Functor (Siphon f c) Source # 
Instance details

Defined in Siphon.Types

Methods

fmap :: (a -> b) -> Siphon f c a -> Siphon f c b #

(<$) :: a -> Siphon f c b -> Siphon f c a #

newtype Indexed a Source #

Constructors

Indexed 

Fields

Instances

Instances details
Eq1 Indexed Source # 
Instance details

Defined in Siphon.Types

Methods

liftEq :: (a -> b -> Bool) -> Indexed a -> Indexed b -> Bool #

Show1 Indexed Source # 
Instance details

Defined in Siphon.Types

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Indexed a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Indexed a] -> ShowS #

Functor Indexed Source # 
Instance details

Defined in Siphon.Types

Methods

fmap :: (a -> b) -> Indexed a -> Indexed b #

(<$) :: a -> Indexed b -> Indexed a #

Read (Indexed a) Source # 
Instance details

Defined in Siphon.Types

Show (Indexed a) Source # 
Instance details

Defined in Siphon.Types

Methods

showsPrec :: Int -> Indexed a -> ShowS #

show :: Indexed a -> String #

showList :: [Indexed a] -> ShowS #

Eq (Indexed a) Source # 
Instance details

Defined in Siphon.Types

Methods

(==) :: Indexed a -> Indexed a -> Bool #

(/=) :: Indexed a -> Indexed a -> Bool #

Ord (Indexed a) Source # 
Instance details

Defined in Siphon.Types

Methods

compare :: Indexed a -> Indexed a -> Ordering #

(<) :: Indexed a -> Indexed a -> Bool #

(<=) :: Indexed a -> Indexed a -> Bool #

(>) :: Indexed a -> Indexed a -> Bool #

(>=) :: Indexed a -> Indexed a -> Bool #

max :: Indexed a -> Indexed a -> Indexed a #

min :: Indexed a -> Indexed a -> Indexed a #

For Testing

headedToIndexed Source #

Arguments

:: forall c a. Eq c 
=> (c -> Text) 
-> Vector c

Headers in the source document

-> Siphon Headed c a

Decolonnade that contains expected headers

-> Either SiphonError (Siphon Indexed c a) 

Maps over a Decolonnade that expects headers, converting these expected headers into the indices of the columns that they correspond to.

Utility

humanizeSiphonError :: SiphonError -> String Source #

This adds one to the index because text editors consider line number to be one-based, not zero-based.

eqSiphonHeaders :: (Eq1 f, Eq c) => Siphon f c a -> Siphon f c b -> Bool Source #

Imports

This code is copied from the head section. It has to be run before every set of tests.

>>> :set -XOverloadedStrings
>>> import Siphon (Siphon)
>>> import Colonnade (Colonnade,Headed)
>>> import qualified Siphon as S
>>> import qualified Colonnade as C
>>> import qualified Data.Text as T
>>> import Data.Text (Text)
>>> import qualified Data.Text.Lazy.IO as LTIO
>>> import qualified Data.Text.Lazy.Builder as LB
>>> import Data.Maybe (fromMaybe)
>>> data Person = Person { name :: Text, age :: Int, company :: Maybe Text}