basis/csv/csv.factor

   1 ! Copyright (C) 2007, 2008 Phil Dawes
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 ! Simple CSV Parser
   5 ! Phil Dawes phil@phildawes.net
   6
   7 USING: kernel sequences io namespaces make
   8 combinators unicode.categories ;
   9 IN: csv
  10
  11 SYMBOL: delimiter
  12
  13 CHAR: , delimiter set-global
  14
  15 : delimiter> delimiter get ; inline
  16
  17 DEFER: quoted-field ( -- endchar )
  18
  19 ! trims whitespace from either end of string
  20 : trim-whitespace ( str -- str )
  21   [ blank? ] trim ; inline
  22
  23 : skip-to-field-end ( -- endchar )
  24   "\n" delimiter> suffix read-until nip ; inline
  25
  26 : not-quoted-field ( -- endchar )
  27   "\"\n" delimiter> suffix read-until   ! "
  28   dup
  29   { { CHAR: "     [ drop drop quoted-field ] }  ! "
  30     { delimiter> [ swap trim-whitespace % ] }
  31     { CHAR: \n    [ swap trim-whitespace % ] }
  32     { f           [ swap trim-whitespace % ] }       ! eof
  33   } case ;
  34
  35 : maybe-escaped-quote ( -- endchar )
  36   read1 dup
  37   { { CHAR: "    [ , quoted-field ] }  ! " is an escaped quote
  38     { delimiter> [ ] }                 ! end of quoted field
  39     { CHAR: \n   [ ] }
  40     [ 2drop skip-to-field-end ]       ! end of quoted field + padding
  41   } case ;
  42
  43 : quoted-field ( -- endchar )
  44   "\"" read-until                                 ! "
  45   drop % maybe-escaped-quote ;
  46
  47 : field ( -- sep string )
  48   [ not-quoted-field ] "" make  ; ! trim-whitespace
  49
  50 : (row) ( -- sep )
  51   field ,
  52   dup delimiter get = [ drop (row) ] when ;
  53
  54 : row ( -- eof? array[string] )
  55   [ (row) ] { } make ;
  56
  57 : append-if-row-not-empty ( row -- )
  58   dup { "" } = [ drop ] [ , ] if ;
  59
  60 : (csv) ( -- )
  61   row append-if-row-not-empty
  62   [ (csv) ] when ;
  63
  64 : csv-row ( stream -- row )
  65   [ row nip ] with-input-stream ;
  66
  67 : csv ( stream -- rows )
  68   [ [ (csv) ] { } make ] with-input-stream ;
  69
  70 : with-delimiter ( char quot -- )
  71   delimiter swap with-variable ; inline
  72
  73 : needs-escaping? ( cell -- ? )
  74   [ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! "
  75
  76 : escape-quotes ( cell -- cell' )
  77   [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline
  78
  79 : enclose-in-quotes ( cell -- cell' )
  80   CHAR: " [ prefix ] [ suffix ] bi ; inline ! "
  81
  82 : escape-if-required ( cell -- cell' )
  83   dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline
  84
  85 : write-row ( row -- )
  86   [ delimiter get write1 ] [ escape-if-required write ] interleave nl ; inline
  87
  88 : write-csv ( rows stream -- )
  89   [ [ write-row ] each ] with-output-stream ;