extra/bencode/bencode.factor

   1 USING: arrays assocs byte-arrays combinators io
   2 io.encodings.binary io.streams.byte-array io.streams.string
   3 kernel linked-assocs math math.parser sequences sequences.extras strings ;
   4 IN: bencode
   5
   6 GENERIC: >bencode ( obj -- bencode )
   7
   8 M: integer >bencode
   9     number>string "i" "e" surround ;
  10
  11 M: string >bencode
  12     [ length number>string ":" ] keep 3append ;
  13
  14 M: byte-array >bencode "" like >bencode ;
  15
  16 M: sequence >bencode
  17     [ >bencode ] map concat "l" "e" surround ;
  18
  19 M: assoc >bencode
  20     [ [ >bencode ] bi@ append ] { } assoc>map concat
  21     "d" "e" surround ;
  22
  23 DEFER: read-bencode
  24
  25 <PRIVATE
  26
  27 : read-integer ( -- obj )
  28     "e" read-until CHAR: e assert= string>number ;
  29
  30 : read-list ( -- obj )
  31     [ read-bencode ] loop>array ;
  32
  33 : read-dictionary ( -- obj )
  34     [
  35         read-bencode [ read-bencode 2array ] [ f ] if*
  36     ] loop>array >linked-hash ;
  37
  38 : read-string ( prefix -- obj )
  39     ":" read-until CHAR: : assert= swap prefix
  40     string>number read "" like ;
  41
  42 PRIVATE>
  43
  44 : read-bencode ( -- obj )
  45     read1 {
  46         { CHAR: i [ read-integer ] }
  47         { CHAR: l [ read-list ] }
  48         { CHAR: d [ read-dictionary ] }
  49         { CHAR: e [ f ] }
  50         [ read-string ]
  51     } case ;
  52
  53 GENERIC: bencode> ( bencode -- obj )
  54
  55 M: byte-array bencode>
  56     binary [ read-bencode ] with-byte-reader ;
  57
  58 M: string bencode>
  59     [ read-bencode ] with-string-reader ;