IN: csv
HELP: csv
-{ $values { "stream" "a stream" }
+{ $values { "stream" "an input stream" }
{ "rows" "an array of arrays of fields" } }
{ $description "parses a csv stream into an array of row arrays"
} ;
HELP: csv-row
-{ $values { "stream" "a stream" }
+{ $values { "stream" "an input stream" }
{ "row" "an array of fields" } }
{ $description "parses a row from a csv stream"
} ;
+HELP: write-csv
+{ $values { "rows" "an sequence of sequences of strings" }
+ { "stream" "an output stream" } }
+{ $description "writes csv to the output stream, escaping where necessary"
+} ;
+
HELP: with-delimiter
{ $values { "char" "field delimiter (e.g. CHAR: \t)" }
{ "quot" "a quotation" } }
{ $description "Sets the field delimiter for csv or csv-row words "
} ;
+
-USING: io.streams.string csv tools.test shuffle ;
IN: csv.tests
+USING: io.streams.string csv tools.test shuffle kernel strings ;
! I like to name my unit tests
: named-unit-test ( name output input -- )
[ { { "foo" "bar" }
{ "1" "2" } } ]
[ "foo,\"bar\"\n1,2" <string-reader> csv ] named-unit-test
+
+"can write csv too!"
+[ "foo1,bar1\nfoo2,bar2\n" ]
+[ { { "foo1" "bar1" } { "foo2" "bar2" } } <string-writer> tuck write-csv >string ] named-unit-test
+
+"escapes quotes commas and newlines when writing"
+[ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ]
+[ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } <string-writer> tuck write-csv >string ] named-unit-test ! "
DEFER: quoted-field
VAR: delimiter
-
+
! trims whitespace from either end of string
: trim-whitespace ( str -- str )
[ blank? ] trim ; inline
[ (csv) ] when ;
: init-vars ( -- )
- delimiter> [ CHAR: , >delimiter ] unless ; inline
+ delimiter> [ CHAR: , >delimiter ] unless ; inline
: csv-row ( stream -- row )
init-vars
: with-delimiter ( char quot -- )
delimiter swap with-variable ; inline
+
+
+
+: needs-escaping? ( cell -- ? )
+ [ "\n\"" delimiter> suffix member? ] contains? ; inline ! "
+
+: escape-quotes ( cell -- cell' )
+ [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline
+
+: enclose-in-quotes ( cell -- cell' )
+ CHAR: " [ prefix ] [ suffix ] bi ; inline ! "
+
+: escape-if-required ( cell -- cell' )
+ dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline
+
+: write-row ( row -- )
+ [ delimiter> write1 ] [ escape-if-required write ] interleave nl ; inline
+
+: write-csv ( rows outstream -- )
+ init-vars
+ [ [ write-row ] each ] with-output-stream ;