1 ! Copyright (C) 2010 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: arrays assocs combinators combinators.short-circuit
5 formatting hashtables io io.streams.string kernel make math
6 namespaces quoting sequences splitting strings strings.parser ;
12 : escape ( ch -- ch' )
29 } ?at [ bad-escape ] unless ;
31 : (unescape-string) ( str -- )
33 cut-slice [ % ] dip rest-slice
34 dup empty? [ "Missing escape code" throw ] when
35 unclip-slice escape , (unescape-string)
38 : unescape-string ( str -- str' )
39 [ (unescape-string) ] "" make ;
43 : escape-string ( str -- str' )
72 : unspace ( str -- str' )
75 : unwrap ( str -- str' )
76 1 swap [ length 1 - ] keep subseq ;
78 : uncomment ( str -- str' )
79 ";#" [ over index [ head ] when* ] each ;
81 : cleanup-string ( str -- str' )
82 unspace unquote unescape-string ;
87 : section? ( line -- index/f )
91 [ CHAR: ] swap last-index ]
94 : line-continues? ( line -- ? )
95 { [ empty? not ] [ last CHAR: \ = ] } 1&& ;
98 section get [ , ] when* ;
100 : option, ( name value -- )
101 section get [ second swapd set-at ] [ 2array , ] if* ;
103 : [section] ( line -- )
104 unwrap cleanup-string H{ } clone 2array section set ;
106 : name=value ( line -- )
108 [ swap [ first2 ] dip ] [
109 "=" split1 [ cleanup-string "" ] [ "" or ] bi*
111 dup line-continues? [
112 dup length 1 - head cleanup-string
113 dup last space? [ " " append ] unless append 2array
115 cleanup-string append option, f
119 : parse-line ( line -- )
120 uncomment unspace dup section? [
121 section, 1 + cut [ [section] ] [ unspace ] bi*
122 ] when* [ name=value ] unless-empty ;
126 : read-ini ( -- assoc )
127 section off option off
128 [ [ parse-line ] each-line section, ] { } make
131 : write-ini ( assoc -- )
134 [ [ escape-string ] bi@ "%s=%s\n" printf ]
136 [ escape-string "[%s]\n" printf ] dip
137 [ [ escape-string ] bi@ "%s=%s\n" printf ]
142 ! FIXME: escaped comments "\;" don't work
144 : string>ini ( str -- assoc )
145 [ read-ini ] with-string-reader ;
147 : ini>string ( assoc -- str )
148 [ write-ini ] with-string-writer ;