diff --git a/extra/tnetstrings/authors.txt b/extra/tnetstrings/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/tnetstrings/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/tnetstrings/summary.txt b/extra/tnetstrings/summary.txt new file mode 100644 index 0000000000..4db1c3fc18 --- /dev/null +++ b/extra/tnetstrings/summary.txt @@ -0,0 +1 @@ +Reader and writer for "tagged netstrings" diff --git a/extra/tnetstrings/tnetstrings-tests.factor b/extra/tnetstrings/tnetstrings-tests.factor new file mode 100644 index 0000000000..f6d73291a7 --- /dev/null +++ b/extra/tnetstrings/tnetstrings-tests.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: kernel tnetstrings sequences tools.test ; + +[ t ] [ + { + { H{ } "0:}" } + { { } "0:]" } + { "" "0:\"" } + { t "4:true!" } + { f "5:false!" } + { 12345 "5:12345#" } + { "this is cool" "12:this is cool\"" } + { + H{ { "hello" { 12345678901 "this" } } } + "34:5:hello\"22:11:12345678901#4:this\"]}" + } + { + { 12345 67890 "xxxxx" } + "24:5:12345#5:67890#5:xxxxx\"]" + } + } [ + first2 [ tnetstring> = ] [ swap >tnetstring = ] 2bi and + ] all? +] unit-test diff --git a/extra/tnetstrings/tnetstrings.factor b/extra/tnetstrings/tnetstrings.factor new file mode 100644 index 0000000000..d9b9f1ccf8 --- /dev/null +++ b/extra/tnetstrings/tnetstrings.factor @@ -0,0 +1,98 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: arrays assocs combinators formatting hashtables kernel +math math.parser sequences splitting strings ; + +IN: tnetstrings + +number cut unclip swapd ; + +DEFER: parse-tnetstring + +: parse-list ( data -- value ) + [ { } ] [ + [ dup empty? not ] [ parse-tnetstring ] produce nip + ] if-empty ; + +: parse-pair ( data -- extra value key ) + parse-tnetstring [ + [ "Unbalanced dictionary store" throw ] when-empty + parse-tnetstring + [ "Invalid value, null not allowed" throw ] unless* + ] dip ; + +: parse-dict ( data -- value ) + [ H{ } ] [ + [ dup empty? not ] [ parse-pair swap 2array ] produce + nip >hashtable + ] if-empty ; + +: parse-bool ( data -- ? ) + { + { "true" [ t ] } + { "false" [ f ] } + [ "Invalid bool: %s" sprintf throw ] + } case ; + +: parse-null ( data -- f ) + [ f ] [ drop "Payload must be 0 length" throw ] if-empty ; + +: parse-tnetstring ( data -- remain value ) + parse-payload { + { CHAR: # [ string>number ] } + { CHAR: " [ ] } + { CHAR: } [ parse-dict ] } + { CHAR: ] [ parse-list ] } + { CHAR: ! [ parse-bool ] } + { CHAR: ~ [ parse-null ] } + { CHAR: , [ ] } + [ "Invalid payload type: %c" sprintf throw ] + } case ; + +PRIVATE> + +: tnetstring> ( string -- value ) + parse-tnetstring swap [ + "Had trailing junk: %s" sprintf throw + ] unless-empty ; + +string "#" dump ; + +: dump-string ( data -- string ) "\"" dump ; + +: dump-list ( data -- string ) + [ dump-tnetstring ] map "" concat-as "]" dump ; + +: dump-dict ( data -- string ) + >alist [ first2 [ dump-tnetstring ] bi@ append ] map + "" concat-as "}" dump ; + +: dump-bool ( ? -- string ) + "4:true!" "5:false!" ? ; + +: dump-tnetstring ( data -- string ) + { + { [ dup boolean? ] [ dump-bool ] } + { [ dup number? ] [ dump-number ] } + { [ dup string? ] [ dump-string ] } + { [ dup sequence? ] [ dump-list ] } + { [ dup assoc? ] [ dump-dict ] } + [ "Can't serialize object" throw ] + } cond ; + +PRIVATE> + +: >tnetstring ( value -- string ) + dump-tnetstring ; +