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