| Copyright | (c) Atze Dijkstra 2015 |
|---|---|
| License | BSD3 |
| Maintainer | atze@uu.nl |
| Stability | experimental |
| Portability | POSIX |
| Safe Haskell | None |
| Language | Haskell98 |
Text.DelimiterSeparated
Contents
Description
The library provides parsing/unparsing of Records as well as interpreting those records to a datatype of your choice,
via toRecords and fromRecords using class DelimSepRecord, where each individual field can be interpreted via class DelimSepField.
The following example demonstrates the basic parsing/unparsing:
module Main where
import Text.DelimiterSeparated
import System.IO
import Control.Monad
main = do
txt <- readFile "data.csv"
putStrLn txt
case recordsFromDelimiterSeparated csv txt of
Left es -> forM_ es putStrLn
Right recs -> do
putStrLn $ show recs
writeFile "data-out-csv.csv" $ recordsToDelimiterSeparated csv recs
writeFile "data-out-csv.tsv" $ recordsToDelimiterSeparated tsv recs
txt <- readFile "data.tsv"
-- putStrLn txt
case recordsFromDelimiterSeparated tsv txt of
Left es -> forM_ es putStrLn
Right recs -> do
putStrLn $ show recs
writeFile "data-out-tsv.csv" $ recordsToDelimiterSeparated csv recs- data Field = Field {}
- type Record = [Field]
- type Records = [Record]
- data DelimiterStyle
- csv :: DelimiterStyle
- tsv :: DelimiterStyle
- emptyField :: Field
- recordsToDelimiterSeparated :: DelimiterStyle -> Records -> String
- recordsFromDelimiterSeparated :: DelimiterStyle -> String -> Either [String] Records
- data Check
- checkAll :: [Check]
- recordsCheck :: Bool -> [Check] -> Records -> Maybe String
- data Fix
- recordsFix :: Bool -> [Fix] -> Records -> Records
- recordsFromHeaderStr :: String -> Records
- recordsAddHeaderStr :: String -> Records -> Records
- recordsPartitionRows :: Bool -> ([String] -> Bool) -> Records -> (Records, Records)
- recordsPartitionColsBasedOnHeader :: (String -> Bool) -> Records -> (Records, Records)
- recordsSpan :: Bool -> ([String] -> Bool) -> Records -> (Records, Records)
- recordsSplitHeader :: Records -> (Record, Records)
- recordsToStrings :: Records -> [[String]]
- recordsFromStrings :: [[String]] -> Records
- class DelimSepField x where
- class DelimSepRecord x where
- toRecords :: DelimSepRecord x => [x] -> Records
- toRecordsWithHeader :: DelimSepRecord x => [Record] -> [x] -> Records
- toRecordsWithHeaderStr :: DelimSepRecord x => String -> [x] -> Records
- fromRecords :: DelimSepRecord x => Records -> [x]
Types
Field
type Records = [Record] Source #
Records is sequence of records (representation may change in future)
data DelimiterStyle Source #
Style of delimitation
Constructors
| CSV | |
Fields
| |
| TSV | |
csv :: DelimiterStyle Source #
Predefined delimiter style for comma field separated, newline/return record separated
tsv :: DelimiterStyle Source #
Predefined delimiter style for tab field separated, newline/return record separated
Construction
emptyField :: Field Source #
Empty field
Encoding, decoding
recordsToDelimiterSeparated :: DelimiterStyle -> Records -> String Source #
Encode internal representation in external delimiter separated format
recordsFromDelimiterSeparated :: DelimiterStyle -> String -> Either [String] Records Source #
Decode internal representation from external delimiter separated format, possible failing with error messages
Checks, fixes
Which checks are to be done by recordsCheck
Constructors
| Check_DupHdrNms | check for duplicate header names |
| Check_EqualSizedRecs | check for equal sized records (ignoring possible header) |
| Check_AtLeast1Rec | check for at least 1 record (ignoring possible header) |
| Check_EqualSizedHdrRecs | check for equal sized header and records |
| Check_NoRecsLargerThanHdr | check for records not larger than header |
| Check_NoRecsSmallerThanHdr | check for records not smaller than header |
recordsCheck :: Bool -> [Check] -> Records -> Maybe String Source #
Check records, possibly yielding errors
Which fixes are to be done by recordsCheck
Constructors
| Fix_Pad | pad |
| Fix_PadToHdrLen | in combi with pad, pad to header len |
recordsFix :: Bool -> [Fix] -> Records -> Records Source #
Fix sizes of records by padding to max size
Construction
recordsFromHeaderStr :: String -> Records Source #
Convert a String representation of a header to actual record
recordsAddHeaderStr :: String -> Records -> Records Source #
Add a header described by string holding whitespaced separated labels
Manipulation
recordsPartitionRows :: Bool -> ([String] -> Bool) -> Records -> (Records, Records) Source #
Partition record rows. Fst of tuple holds the possible header, if indicated it is present. Snd of tuple holds records failing the predicate. Assumes >0 records
recordsPartitionColsBasedOnHeader :: (String -> Bool) -> Records -> (Records, Records) Source #
Partition record columns, fst of tuple holds the obligatory header upon wich partitioning is done Assumes header and records all have same nr of fields
recordsSpan :: Bool -> ([String] -> Bool) -> Records -> (Records, Records) Source #
Partition records, fst of tuple holds the possible header, if indicated it is present. Assumes >0 records
Conversion
recordsToStrings :: Records -> [[String]] Source #
Get all fields as strings
recordsFromStrings :: [[String]] -> Records Source #
Lift strings as Records
Overloaded conversion
class DelimSepField x where Source #
Conversion tofrom Field, i.e. kinda showread
Minimal complete definition
Instances
toRecords :: DelimSepRecord x => [x] -> Records Source #
Convert to records
toRecordsWithHeader :: DelimSepRecord x => [Record] -> [x] -> Records Source #
Convert to records, with a header described by string holding whitespaced separated labels
toRecordsWithHeaderStr :: DelimSepRecord x => String -> [x] -> Records Source #
Convert to records, with a header described by string holding whitespaced separated labels
fromRecords :: DelimSepRecord x => Records -> [x] Source #
Convert from records