steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

csv: cleanup some of the words a bit.

db4
John Benediktsson 2013-03-19 11:03:30 -07:00
parent 67a2b9dc9a
commit 06eaac026c
1 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
basis/csv/csv.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2007, 2008 Phil Dawes ! Copyright (C) 2007, 2008 Phil Dawes, 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators fry io io.files io.streams.string kernel USING: combinators fry io io.files io.streams.string kernel
make math memoize namespaces sbufs sequences sequences.private make math memoize namespaces sbufs sequences sequences.private
@ -11,24 +11,27 @@ CHAR: , delimiter set-global
<PRIVATE <PRIVATE
MEMO: field-delimiters ( delimiter -- field-end quoted-field ) MEMO: field-delimiters ( delimiter -- field-seps quote-seps )
[ "\n" swap suffix ] [ "\"\n" swap suffix ] bi ; inline [ "\n" swap prefix ] [ "\"\n" swap prefix ] bi ; inline
DEFER: quoted-field DEFER: quoted-field,
: maybe-escaped-quote ( delimeter stream quoted? -- delimiter stream endchar/f ) : maybe-escaped-quote ( delimeter stream quoted? -- delimiter stream sep/f )
2over stream-read1 swap over = 2over stream-read1 swap over =
[ nip ] [ [ nip ] [
{ {
{ CHAR: " [ [ CHAR: " , ] when quoted-field ] } { CHAR: " [ [ CHAR: " , ] when quoted-field, ] }
{ CHAR: \n [ ] } ! Error: newline inside string? { CHAR: \n [ ] } ! Error: newline inside string?
[ [ , drop f maybe-escaped-quote ] when* ] [ [ , drop f maybe-escaped-quote ] when* ]
} case } case
] if ; inline recursive ] if ; inline recursive
: quoted-field ( delimiter stream -- delimiter stream endchar/f ) : quoted-field, ( delimiter stream -- delimiter stream sep/f )
"\"" over stream-read-until drop % t maybe-escaped-quote ; "\"" over stream-read-until drop % t maybe-escaped-quote ;
: quoted-field ( delimiter stream -- sep/f field )
[ quoted-field, 2nip ] "" make ;
: ?trim ( string -- string' ) : ?trim ( string -- string' )
dup length [ drop "" ] [ dup length [ drop "" ] [
over first-unsafe blank? over first-unsafe blank?
@ -36,31 +39,29 @@ DEFER: quoted-field
[ [ blank? ] trim ] when [ [ blank? ] trim ] when
] if-zero ; inline ] if-zero ; inline
: field ( delimiter stream field-end quoted-field -- delimiter sep/f field ) : continue-field ( delimiter stream field-seps seq -- sep/f field )
pick stream-read-until dup CHAR: " = [ swap rot stream-read-until [ "\"" glue ] dip
drop swap ?trim [ drop ] 2dip ; inline
[ drop [ quoted-field nip ] "" make ]
[
swap rot stream-read-until
[ "\"" glue ] dip swap ?trim
]
if-empty
] [ [ 2drop ] 2dip swap ?trim ] if ;
: (stream-read-row) ( delimiter stream field-end quoted-field -- delimiter sep/f fields ) : field ( delimiter stream field-seps quote-seps -- sep/f field )
[ dup [ 2dup = ] ] 3dip '[ drop _ _ _ field ] produce ; pick stream-read-until dup CHAR: " = [
drop [ drop quoted-field ] [ continue-field ] if-empty
] [ [ 3drop ] 2dip swap ?trim ] if ;
: (stream-read-row) ( delimiter stream field-end quoted-field -- sep/f fields )
[ [ dup '[ dup _ = ] ] keep ] 3dip
'[ drop _ _ _ _ field ] produce ; inline
: (stream-read-csv) ( stream -- ) : (stream-read-csv) ( stream -- )
delimiter get
[ dup [ empty? ] all? [ drop ] [ , ] if ] [ dup [ empty? ] all? [ drop ] [ , ] if ]
rot pick field-delimiters delimiter get rot over field-delimiters
'[ _ _ _ (stream-read-row) ] do while drop ; '[ _ _ _ _ (stream-read-row) ] do while ;
PRIVATE> PRIVATE>
: stream-read-row ( stream -- row ) : stream-read-row ( stream -- row )
delimiter get swap over field-delimiters delimiter get swap over field-delimiters
(stream-read-row) 2nip ; inline (stream-read-row) nip ; inline
: read-row ( -- row ) : read-row ( -- row )
input-stream get stream-read-row ; inline input-stream get stream-read-row ; inline
@ -90,7 +91,7 @@ PRIVATE>
CHAR: " over stream-write1 swap [ CHAR: " over stream-write1 swap [
[ over stream-write1 ] [ over stream-write1 ]
[ dup CHAR: " = [ over stream-write1 ] [ drop ] if ] bi [ dup CHAR: " = [ over stream-write1 ] [ drop ] if ] bi
] each CHAR: " swap stream-write1 ; inline ] each CHAR: " swap stream-write1 ;
: escape-if-required ( cell delimiter stream -- ) : escape-if-required ( cell delimiter stream -- )
[ dupd needs-escaping? ] dip [ dupd needs-escaping? ] dip