1 ! Copyright (C) 2011 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: assocs combinators combinators.short-circuit formatting
5 grouping hashtables io kernel make math math.parser sequences
6 splitting strings unicode ;
12 : decode-value ( string -- string' )
16 [ CHAR: \ = not ] [ CHAR: ` = ] bi* and ;
18 : (find-`) ( string -- n/f )
19 2 clump [ first2 `? ] find drop [ 1 + ] [ f ] if* ;
21 : find-` ( string -- n/f )
22 dup ?first CHAR: ` = [ drop 0 ] [ (find-`) ] if ;
24 : parse-name ( string -- remain name )
25 ":`" split1 swap decode-value ;
29 : (parse-value) ( string -- values )
30 decode-value split-lines
31 [ "" ] [ dup length 1 = [ first ] when ] if-empty ;
33 : parse-value ( string -- remain value )
35 dup 1 - pick ?nth CHAR: : =
36 [ drop name/values ] [ cut swap (parse-value) ] if
37 [ rest [ unicode:blank? ] trim-head ] dip
40 : (name=value) ( string -- remain term )
41 parse-name [ parse-value ] dip associate ;
43 : name=value ( string -- remain term )
44 [ unicode:blank? ] trim
45 dup ":`" subseq-index? [ (name=value) ] [ f swap ] if ;
47 : name/values ( string -- remain terms )
48 [ dup { [ empty? not ] [ first CHAR: ` = not ] } 1&& ]
49 [ name=value ] produce assoc-union-all ;
51 : parse-txon ( string -- objects )
52 [ dup empty? not ] [ name=value ] produce nip ;
56 : txon> ( string -- object )
57 parse-txon dup length 1 = [ first ] when ;
61 : encode-value ( string -- string' )
66 GENERIC: >txon ( object -- string )
69 [ >txon ] map join-lines ;
73 first2 [ encode-value ] [ >txon ] bi* "%s:`%s`" sprintf