diff --git a/extra/csv/csv-docs.factor b/extra/csv/csv-docs.factor index c16ed46522..c9f39900ab 100644 --- a/extra/csv/csv-docs.factor +++ b/extra/csv/csv-docs.factor @@ -12,3 +12,10 @@ HELP: csv-row { "row" "an array of fields" } } { $description "parses a row from a csv stream" } ; + + +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 " +} ; diff --git a/extra/csv/csv-tests.factor b/extra/csv/csv-tests.factor index edd22751b5..6ab26c7e40 100644 --- a/extra/csv/csv-tests.factor +++ b/extra/csv/csv-tests.factor @@ -46,6 +46,7 @@ IN: csv.tests [ "Year,Make,Model\n1997,Ford,E350\n2000,Mercury,Cougar" csv ] named-unit-test + ! !!!!!!!! other tests @@ -59,3 +60,8 @@ IN: csv.tests "trims leading and trailing whitespace - n.b. this isn't really conformant, but lots of csv seems to assume this" [ { { "foo yeah" "bah" "baz" } } ] [ " foo yeah , bah ,baz\n" csv ] named-unit-test + + +"allows setting of delimiting character" +[ { { "foo" "bah" "baz" } } ] +[ "foo\tbah\tbaz\n" CHAR: \t [ csv ] with-delimiter ] named-unit-test diff --git a/extra/csv/csv.factor b/extra/csv/csv.factor index fbb3677491..3953ce057b 100644 --- a/extra/csv/csv.factor +++ b/extra/csv/csv.factor @@ -4,32 +4,33 @@ ! Simple CSV Parser ! Phil Dawes phil@phildawes.net -USING: kernel sequences io namespaces combinators -unicode.categories ; +USING: kernel sequences io namespaces combinators unicode.categories vars ; IN: csv DEFER: quoted-field +VAR: delimiter + ! trims whitespace from either end of string : trim-whitespace ( str -- str ) [ blank? ] trim ; inline : skip-to-field-end ( -- endchar ) - ",\n" read-until nip ; inline + "\n" delimiter> suffix read-until nip ; inline : not-quoted-field ( -- endchar ) - ",\"\n" read-until ! " + "\"\n" delimiter> suffix read-until ! " dup - { { CHAR: " [ drop drop quoted-field ] } ! " - { CHAR: , [ swap trim-whitespace % ] } - { CHAR: \n [ swap trim-whitespace % ] } - { f [ swap trim-whitespace % ] } ! eof + { { CHAR: " [ drop drop quoted-field ] } ! " + { delimiter> [ swap trim-whitespace % ] } + { CHAR: \n [ swap trim-whitespace % ] } + { f [ swap trim-whitespace % ] } ! eof } case ; : maybe-escaped-quote ( -- endchar ) read1 dup - { { CHAR: " [ , quoted-field ] } ! " is an escaped quote - { CHAR: , [ ] } ! end of quoted field + { { CHAR: " [ , quoted-field ] } ! " is an escaped quote + { delimiter> [ ] } ! end of quoted field [ 2drop skip-to-field-end ] ! end of quoted field + padding } case ; @@ -42,7 +43,7 @@ DEFER: quoted-field : (row) ( -- sep ) field , - dup CHAR: , = [ drop (row) ] when ; + dup delimiter> = [ drop (row) ] when ; : row ( -- eof? array[string] ) [ (row) ] { } make ; @@ -54,8 +55,16 @@ DEFER: quoted-field row append-if-row-not-empty [ (csv) ] when ; +: init-vars ( -- ) + delimiter> [ CHAR: , >delimiter ] unless ; inline + : csv-row ( stream -- row ) + init-vars [ row nip ] with-stream ; : csv ( stream -- rows ) + init-vars [ [ (csv) ] { } make ] with-stream ; + +: with-delimiter ( char quot -- ) + delimiter swap with-variable ; inline