txon: adding reader and writer words for TXON format.
parent
bc5139e8ff
commit
06469a4865
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -0,0 +1 @@
|
||||||
|
TXON (http://www.hxa.name/txon/) reader and writer
|
|
@ -0,0 +1,76 @@
|
||||||
|
|
||||||
|
USING: tools.test txon ;
|
||||||
|
|
||||||
|
IN: txon.tests
|
||||||
|
|
||||||
|
[ "ABC" ] [ "ABC" >txon ] unit-test
|
||||||
|
|
||||||
|
[ "A\\`C" ] [ "A`C" >txon ] unit-test
|
||||||
|
|
||||||
|
[ "123" ] [ 123 >txon ] unit-test
|
||||||
|
|
||||||
|
[ "1\n2\n3" ] [ { 1 2 3 } >txon ] unit-test
|
||||||
|
|
||||||
|
[ "a:`123`\nb:`456`" ] [ H{ { "a" 123 } { "b" 456 } } >txon ] unit-test
|
||||||
|
|
||||||
|
[ "foo" ] [ "foo" txon> ] unit-test
|
||||||
|
|
||||||
|
[ "foo" ] [ " foo " txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "foo" "" } } ]
|
||||||
|
[ "foo:``" txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "foo" " " } } ]
|
||||||
|
[ "foo:` `" txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "name" "value" } } ]
|
||||||
|
[ "name:`value`" txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "name" "value" } } ]
|
||||||
|
[ " name:`value` " txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "foo`bar" "value" } } ]
|
||||||
|
[ "foo\\`bar:`value`" txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "foo" "bar`baz" } } ]
|
||||||
|
[ "foo:`bar\\`baz`" txon> ] unit-test
|
||||||
|
|
||||||
|
[ { H{ { "name1" "value1" } } H{ { "name2" "value2" } } } ]
|
||||||
|
[ "name1:`value1`name2:`value2`" txon> ] unit-test
|
||||||
|
|
||||||
|
[ H{ { "name1" H{ { "name2" "nested value" } } } } ]
|
||||||
|
[ "name1:` name2:`nested value` `" txon> ] unit-test
|
||||||
|
|
||||||
|
[ "name1:`name2:`nested value``" ]
|
||||||
|
[
|
||||||
|
H{ { "name1" H{ { "name2" "nested value" } } } } >txon
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
H{
|
||||||
|
{ "name1" H{ { "name2" "value2" } { "name3" "value3" } } }
|
||||||
|
}
|
||||||
|
] [
|
||||||
|
"
|
||||||
|
name1:`
|
||||||
|
name2:`value2`
|
||||||
|
name3:`value3`
|
||||||
|
`
|
||||||
|
" txon>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
H{
|
||||||
|
{ "name1" H{ { "name2" H{ { "name3" "value3" } } } } }
|
||||||
|
}
|
||||||
|
] [
|
||||||
|
"
|
||||||
|
name1:`
|
||||||
|
name2:`
|
||||||
|
name3:`value3`
|
||||||
|
`
|
||||||
|
`
|
||||||
|
" txon>
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ H{ { "a" { "1" "2" "3" } } } ] [ "a:`1\n2\n3`" txon> ] unit-test
|
|
@ -0,0 +1,79 @@
|
||||||
|
! Copyright (C) 2011 John Benediktsson
|
||||||
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
|
||||||
|
USING: assocs combinators combinators.short-circuit formatting
|
||||||
|
grouping hashtables io kernel make math math.parser regexp
|
||||||
|
sequences splitting strings unicode.categories ;
|
||||||
|
|
||||||
|
IN: txon
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: decode-value ( string -- string' )
|
||||||
|
R" \\`" "`" re-replace ;
|
||||||
|
|
||||||
|
: `? ( ch1 ch2 -- ? )
|
||||||
|
[ CHAR: \ = not ] [ CHAR: ` = ] bi* and ;
|
||||||
|
|
||||||
|
: (find-`) ( string -- n/f )
|
||||||
|
2 clump [ first2 `? ] find drop [ 1 + ] [ f ] if* ;
|
||||||
|
|
||||||
|
: find-` ( string -- n/f )
|
||||||
|
dup ?first CHAR: ` = [ drop 0 ] [ (find-`) ] if ;
|
||||||
|
|
||||||
|
: parse-name ( string -- remain name )
|
||||||
|
":`" split1 swap decode-value ;
|
||||||
|
|
||||||
|
DEFER: name/values
|
||||||
|
|
||||||
|
: (parse-value) ( string -- values )
|
||||||
|
decode-value string-lines dup length 1 = [ first ] when ;
|
||||||
|
|
||||||
|
: parse-value ( string -- remain value )
|
||||||
|
dup find-` [
|
||||||
|
dup 1 - pick ?nth CHAR: : =
|
||||||
|
[ drop name/values ] [ cut swap (parse-value) ] if
|
||||||
|
[ rest [ blank? ] trim-head ] dip
|
||||||
|
] [ f swap ] if* ;
|
||||||
|
|
||||||
|
: (name=value) ( string -- remain term )
|
||||||
|
parse-name [ parse-value ] dip associate ;
|
||||||
|
|
||||||
|
: name=value ( string -- remain term )
|
||||||
|
[ blank? ] trim
|
||||||
|
":`" over subseq? [ (name=value) ] [ f swap ] if ;
|
||||||
|
|
||||||
|
: name/values ( string -- remain terms )
|
||||||
|
[ dup { [ empty? not ] [ first CHAR: ` = not ] } 1&& ]
|
||||||
|
[ name=value ] produce assoc-combine ;
|
||||||
|
|
||||||
|
: parse-txon ( string -- objects )
|
||||||
|
[ dup empty? not ] [ name=value ] produce nip ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: txon> ( string -- object )
|
||||||
|
parse-txon dup length 1 = [ first ] when ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: encode-value ( string -- string' )
|
||||||
|
R" `" "\\`" re-replace ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
GENERIC: >txon ( object -- string )
|
||||||
|
|
||||||
|
M: sequence >txon
|
||||||
|
[ >txon ] map "\n" join ;
|
||||||
|
|
||||||
|
M: assoc >txon
|
||||||
|
>alist [
|
||||||
|
first2 [ encode-value ] [ >txon ] bi* "%s:`%s`" sprintf
|
||||||
|
] map "\n" join ;
|
||||||
|
|
||||||
|
M: string >txon
|
||||||
|
encode-value ;
|
||||||
|
|
||||||
|
M: number >txon
|
||||||
|
number>string >txon ;
|
Loading…
Reference in New Issue