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