bson: some cleanup.
							parent
							
								
									47a0ebcc99
								
							
						
					
					
						commit
						47e6b2e8fe
					
				| 
						 | 
				
			
			@ -4,7 +4,7 @@ io.streams.byte-array tools.test literals calendar kernel math ;
 | 
			
		|||
IN: bson.tests
 | 
			
		||||
 | 
			
		||||
: turnaround ( value -- value )
 | 
			
		||||
    assoc>bv >byte-array binary [ H{ } clone stream>assoc ] with-byte-reader ;
 | 
			
		||||
    assoc>bv binary [ H{ } clone stream>assoc ] with-byte-reader ;
 | 
			
		||||
 | 
			
		||||
[ H{ { "a" "a string" } } ] [ H{ { "a" "a string" } } turnaround ] unit-test
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -35,15 +35,13 @@ IN: bson.tests
 | 
			
		|||
                   { second 40+15437/200000 }
 | 
			
		||||
                   { gmt-offset T{ duration { hour 2 } } } } } } turnaround
 | 
			
		||||
] unit-test
 | 
			
		||||
                   
 | 
			
		||||
 | 
			
		||||
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
 | 
			
		||||
     { "ref" T{ dbref f "a" "b" "c" } }
 | 
			
		||||
     { "array" H{ { "a list" { 1 2.234 "hello world" } } } }
 | 
			
		||||
     { "quot" [ 1 2 + ] } }
 | 
			
		||||
]     
 | 
			
		||||
]
 | 
			
		||||
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
 | 
			
		||||
     { "ref" T{ dbref f "a" "b" "c" } }
 | 
			
		||||
     { "array" H{ { "a list" { 1 2.234 "hello world" } } } }
 | 
			
		||||
     { "quot" [ 1 2 + ] } } turnaround ] unit-test
 | 
			
		||||
     
 | 
			
		||||
     
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,8 +12,8 @@ IN: bson.writer
 | 
			
		|||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
CONSTANT: INT32-SIZE { 0 1 2 3 }
 | 
			
		||||
CONSTANT: INT64-SIZE { 0 1 2 3 4 5 6 7 }
 | 
			
		||||
CONSTANT: INT32-SIZE 4
 | 
			
		||||
CONSTANT: INT64-SIZE 8
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -30,18 +30,20 @@ TYPED: with-length ( quot -- bytes-written: integer start-index: integer )
 | 
			
		|||
 | 
			
		||||
: with-length-prefix ( quot: ( .. -- .. ) -- )
 | 
			
		||||
    [ ] (with-length-prefix) ; inline
 | 
			
		||||
    
 | 
			
		||||
 | 
			
		||||
: with-length-prefix-excl ( quot: ( .. -- .. ) -- )
 | 
			
		||||
    [ 4 - ] (with-length-prefix) ; inline
 | 
			
		||||
 | 
			
		||||
: (>le) ( x n -- )
 | 
			
		||||
    [ nth-byte write1 ] with each ; inline
 | 
			
		||||
    
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
TYPED: write-int32 ( int: integer -- ) INT32-SIZE (>le) ; inline
 | 
			
		||||
: write-le ( x n -- )
 | 
			
		||||
    iota [ nth-byte write1 ] with each ; inline
 | 
			
		||||
 | 
			
		||||
TYPED: write-double ( real: float -- ) double>bits INT64-SIZE (>le) ; inline
 | 
			
		||||
TYPED: write-int32 ( int: integer -- )
 | 
			
		||||
    INT32-SIZE write-le ; inline
 | 
			
		||||
 | 
			
		||||
TYPED: write-double ( real: float -- )
 | 
			
		||||
    double>bits INT64-SIZE write-le ; inline
 | 
			
		||||
 | 
			
		||||
TYPED: write-utf8-string ( string: string -- )
 | 
			
		||||
    get-output utf8 encode-string ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -49,7 +51,8 @@ TYPED: write-utf8-string ( string: string -- )
 | 
			
		|||
TYPED: write-cstring ( string: string -- )
 | 
			
		||||
    write-utf8-string 0 write1 ; inline
 | 
			
		||||
 | 
			
		||||
: write-longlong ( object -- ) INT64-SIZE (>le) ; inline
 | 
			
		||||
: write-longlong ( object -- )
 | 
			
		||||
    INT64-SIZE write-le ; inline
 | 
			
		||||
 | 
			
		||||
: write-eoo ( -- ) T_EOO write1 ; inline
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -164,5 +167,10 @@ TYPED: assoc>stream ( assoc: hashtables -- )
 | 
			
		|||
    write-assoc ; inline
 | 
			
		||||
 | 
			
		||||
TYPED: mdb-special-value? ( value -- ?: boolean )
 | 
			
		||||
   { [ timestamp? ] [ quotation? ] [ mdbregexp? ]
 | 
			
		||||
     [ oid? ] [ byte-array? ] } 1|| ; inline
 | 
			
		||||
    {
 | 
			
		||||
        [ timestamp? ]
 | 
			
		||||
        [ quotation? ]
 | 
			
		||||
        [ mdbregexp? ]
 | 
			
		||||
        [ oid? ]
 | 
			
		||||
        [ byte-array? ]
 | 
			
		||||
    } 1|| ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue