1 ! Copyright (C) 2011 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: arrays assocs combinators formatting hashtables kernel
5 math math.parser sequences splitting strings ;
11 : parse-payload ( data -- remain payload payload-type )
12 ":" split1 swap string>number cut unclip swapd ;
14 DEFER: parse-tnetstring
16 : parse-list ( data -- value )
18 [ dup empty? not ] [ parse-tnetstring ] produce nip
21 : parse-pair ( data -- extra value key )
23 [ "Unbalanced dictionary store" throw ] when-empty
25 [ "Invalid value, null not allowed" throw ] unless*
28 : parse-dict ( data -- value )
30 [ dup empty? not ] [ parse-pair swap 2array ] produce
34 : parse-bool ( data -- ? )
38 [ "Invalid bool: %s" sprintf throw ]
41 : parse-null ( data -- f )
42 [ f ] [ drop "Payload must be 0 length" throw ] if-empty ;
44 : parse-tnetstring ( data -- remain value )
46 { CHAR: # [ string>number ] }
48 { CHAR: } [ parse-dict ] }
49 { CHAR: ] [ parse-list ] }
50 { CHAR: ! [ parse-bool ] }
51 { CHAR: ~ [ parse-null ] }
53 [ "Invalid payload type: %c" sprintf throw ]
58 : tnetstring> ( string -- value )
59 parse-tnetstring swap [
60 "Had trailing junk: %s" sprintf throw
65 DEFER: dump-tnetstring
67 : dump ( string type -- string )
68 [ [ length ] keep ] dip "%d:%s%s" sprintf ;
70 : dump-number ( data -- string ) number>string "#" dump ;
72 : dump-string ( data -- string ) "\"" dump ;
74 : dump-list ( data -- string )
75 [ dump-tnetstring ] map "" concat-as "]" dump ;
77 : dump-dict ( data -- string )
78 >alist [ first2 [ dump-tnetstring ] bi@ append ] map
79 "" concat-as "}" dump ;
81 : dump-bool ( ? -- string )
82 "4:true!" "5:false!" ? ;
84 : dump-tnetstring ( data -- string )
86 { [ dup boolean? ] [ dump-bool ] }
87 { [ dup number? ] [ dump-number ] }
88 { [ dup string? ] [ dump-string ] }
89 { [ dup sequence? ] [ dump-list ] }
90 { [ dup assoc? ] [ dump-dict ] }
91 [ "Can't serialize object" throw ]
96 : >tnetstring ( value -- string )