steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

msgpack: support for MessagePack protocol.

db4
John Benediktsson 2013-10-14 11:04:34 -07:00
parent a5f59da7e1
commit 99883a348b
4 changed files with 214 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/msgpack/authors.txt Normal file
View File

@ -0,0 +1 @@
John Benediktsson

55
extra/msgpack/msgpack-tests.factor Normal file
View File

@ -0,0 +1,55 @@
USING: io.streams.string kernel math sequences tools.test ;
IN: msgpack
{
{
+msgpack-nil+
f
t
-1
-31
128
-1152921504606846976
1.5
1.23434536
"hello"
{ 1 1234 123456789 }
H{ { 1 "hello" } { 2 "goodbye" } }
}
} [
{
"\xc0"
"\xc2"
"\xc3"
"\xff"
"\xe1"
"\xcc\x80"
"\xd3\xf0\x00\x00\x00\x00\x00\x00\x00"
"\xcb?\xf8\x00\x00\x00\x00\x00\x00"
"\xcb?\xf3\xbf\xe0\xeb\x92\xb5\xa5"
"\xa5hello"
"\x93\x01\xcd\x04\xd2\xce\x07[\xcd\x15"
"\x82\x01\xa5hello\x02\xa7goodbye"
} [ msgpack> ] map
] unit-test
{ t } [
{
+msgpack-nil+
f
t
-1
-31
128
-1152921504606846976
1.5
1.23434536
"hello"
{ 1 1234 123456789 }
H{ { 1 "hello" } { 2 "goodbye" } }
} [ dup >msgpack msgpack> = ] all?
] unit-test
[ 64 2^ >msgpack ] [ cannot-convert? ] must-fail-with

157
extra/msgpack/msgpack.factor Normal file
View File

@ -0,0 +1,157 @@
! Copyright (C) 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: arrays assocs byte-arrays byte-vectors combinators
grouping hashtables io io.binary io.streams.string kernel math
math.bitwise math.order sbufs sequences strings ;
IN: msgpack
DEFER: read-msgpack
<PRIVATE
: read-array ( n -- obj )
[ read-msgpack ] replicate ;
: read-map ( n -- obj )
2 * read-array 2 group >hashtable ;
: read-ext ( n -- obj )
read be> [ 1 read signed-be> ] dip read 2array ;
PRIVATE>
SINGLETON: +msgpack-nil+
ERROR: unknown-format n ;
: read-msgpack ( -- obj )
read1 {
{ [ dup 0xc0 = ] [ drop +msgpack-nil+ ] }
{ [ dup 0xc2 = ] [ drop f ] }
{ [ dup 0xc3 = ] [ drop t ] }
{ [ dup 0x00 0x7f between? ] [ ] }
{ [ dup 0xe0 mask? ] [ 1array signed-be> ] }
{ [ dup 0xcc = ] [ drop read1 ] }
{ [ dup 0xcd = ] [ drop 2 read be> ] }
{ [ dup 0xce = ] [ drop 4 read be> ] }
{ [ dup 0xcf = ] [ drop 8 read be> ] }
{ [ dup 0xd0 = ] [ drop 1 read signed-be> ] }
{ [ dup 0xd1 = ] [ drop 2 read signed-be> ] }
{ [ dup 0xd2 = ] [ drop 4 read signed-be> ] }
{ [ dup 0xd3 = ] [ drop 8 read signed-be> ] }
{ [ dup 0xca = ] [ drop 4 read be> bits>float ] }
{ [ dup 0xcb = ] [ drop 8 read be> bits>double ] }
{ [ dup 0xe0 mask 0xa0 = ] [ 0x1f mask read ] }
{ [ dup 0xd9 = ] [ drop read1 read "" like ] }
{ [ dup 0xda = ] [ drop 2 read be> read "" like ] }
{ [ dup 0xdb = ] [ drop 4 read be> read "" like ] }
{ [ dup 0xc4 = ] [ drop read1 read B{ } like ] }
{ [ dup 0xc5 = ] [ drop 2 read be> read B{ } like ] }
{ [ dup 0xc6 = ] [ drop 4 read be> read B{ } like ] }
{ [ dup 0xf0 mask 0x90 = ] [ 0x0f mask read-array ] }
{ [ dup 0xdc = ] [ drop 2 read be> read-array ] }
{ [ dup 0xdd = ] [ drop 4 read be> read-array ] }
{ [ dup 0xf0 mask 0x80 = ] [ 0x0f mask read-map ] }
{ [ dup 0xde = ] [ drop 2 read be> read-map ] }
{ [ dup 0xdf = ] [ drop 4 read be> read-map ] }
{ [ dup 0xd4 = ] [ drop 1 read-ext ] }
{ [ dup 0xd5 = ] [ drop 2 read-ext ] }
{ [ dup 0xd6 = ] [ drop 4 read-ext ] }
{ [ dup 0xd7 = ] [ drop 8 read-ext ] }
{ [ dup 0xd8 = ] [ drop 16 read-ext ] }
{ [ dup 0xc7 = ] [ drop read1 read-ext ] }
{ [ dup 0xc8 = ] [ drop 2 read be> read-ext ] }
{ [ dup 0xc9 = ] [ drop 4 read be> read-ext ] }
[ unknown-format ]
} cond ;
ERROR: cannot-convert obj ;
GENERIC: write-msgpack ( obj -- )
<PRIVATE
M: +msgpack-nil+ write-msgpack drop 0xc0 write1 ;
M: f write-msgpack drop 0xc2 write1 ;
M: t write-msgpack drop 0xc3 write1 ;
M: integer write-msgpack
dup 0 >= [
{
{ [ dup 0x7f <= ] [ write1 ] }
{ [ dup 0xff <= ] [ 0xcc write1 1 >be write ] }
{ [ dup 0xffff <= ] [ 0xcd write1 2 >be write ] }
{ [ dup 0xffffffff <= ] [ 0xce write1 4 >be write ] }
{ [ dup 0xffffffffffffffff <= ] [ 0xcf write1 8 >be write ] }
[ cannot-convert ]
} cond
] [
{
{ [ dup -0x1f >= ] [ 1 >be write ] }
{ [ dup -0x80 >= ] [ 0xd0 write1 1 >be write ] }
{ [ dup -0x8000 >= ] [ 0xd1 write1 2 >be write ] }
{ [ dup -0x80000000 >= ] [ 0xd2 write1 4 >be write ] }
{ [ dup -0x8000000000000000 >= ] [ 0xd3 write1 8 >be write ] }
[ cannot-convert ]
} cond
] if ;
M: float write-msgpack
0xcb write1 double>bits 8 >be write ;
: write-string ( obj -- )
dup length {
{ [ dup 0x1f <= ] [ 0xa0 bitor write1 write ] }
{ [ dup 0xff <= ] [ 0xd9 write1 write1 write ] }
{ [ dup 0xffff <= ] [ 0xda write1 2 >be write write ] }
{ [ dup 0xffffffff <= ] [ 0xdb write1 4 >be write write ] }
[ cannot-convert ]
} cond ;
M: string write-msgpack write-string ;
M: sbuf write-msgpack write-string ;
: write-bytes ( obj -- )
dup length {
{ [ dup 0xff <= ] [ 0xc4 write1 write1 write ] }
{ [ dup 0xffff <= ] [ 0xc5 write1 2 >be write write ] }
{ [ dup 0xffffffff <= ] [ 0xc6 write1 4 >be write write ] }
[ cannot-convert ]
} cond ;
M: byte-array write-msgpack write-bytes ;
M: byte-vector write-msgpack write-bytes ;
: write-array ( obj -- )
[ write-msgpack ] each ; inline
: write-map ( obj -- )
[ [ write-msgpack ] bi@ ] assoc-each ; inline
M: sequence write-msgpack
dup length {
{ [ dup 0xf <= ] [ 0x90 bitor write1 write-array ] }
{ [ dup 0xffff <= ] [ 0xdc write1 2 >be write write-array ] }
{ [ dup 0xffffffff <= ] [ 0xdd write1 4 >be write write-array ] }
[ cannot-convert ]
} cond ;
M: assoc write-msgpack
dup assoc-size {
{ [ dup 0xf <= ] [ 0x80 bitor write1 write-map ] }
{ [ dup 0xffff <= ] [ 0xde write1 2 >be write write-map ] }
{ [ dup 0xffffffff <= ] [ 0xdf write1 4 >be write write-map ] }
[ cannot-convert ]
} cond ;
PRIVATE>
: msgpack> ( string -- obj )
[ read-msgpack ] with-string-reader ;
: >msgpack ( obj -- string )
[ write-msgpack ] with-string-writer ;

1
extra/msgpack/summary.txt Normal file
View File

@ -0,0 +1 @@
Support for msgpack protocol.