core/checksums/checksums.factor

   1 ! Copyright (c) 2008 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors io io.backend io.files kernel math math.parser
   4 sequences byte-arrays byte-vectors quotations ;
   5 IN: checksums
   6
   7 MIXIN: checksum
   8
   9 TUPLE: checksum-state
  10     { bytes-read integer } { block-size integer } { bytes byte-vector } ;
  11
  12 : new-checksum-state ( class -- checksum-state )
  13     new
  14         BV{ } clone >>bytes ; inline
  15
  16 M: checksum-state clone
  17     call-next-method
  18     [ clone ] change-bytes ;
  19
  20 GENERIC: initialize-checksum-state ( class -- checksum-state )
  21
  22 GENERIC: checksum-block ( bytes checksum -- )
  23
  24 GENERIC: get-checksum ( checksum -- value )
  25
  26 : add-checksum-bytes ( checksum-state data -- checksum-state )
  27     over bytes>> [ push-all ] keep
  28     [ dup length pick block-size>> >= ]
  29     [
  30         over block-size>> cut-slice [ >byte-array ] dip [
  31             over [ checksum-block ]
  32             [ [ ] [ block-size>> ] bi [ + ] curry change-bytes-read drop ] bi
  33         ] dip
  34     ] while
  35     >byte-vector
  36     [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
  37
  38 : add-checksum-stream ( checksum-state stream -- checksum-state )
  39     [
  40         [ [ swap add-checksum-bytes drop ] curry each-block ] keep
  41     ] with-input-stream ;
  42
  43 : add-checksum-file ( checksum-state path -- checksum-state )
  44     normalize-path (file-reader) add-checksum-stream ;
  45
  46 GENERIC: checksum-bytes ( bytes checksum -- value )
  47
  48 GENERIC: checksum-stream ( stream checksum -- value )
  49
  50 GENERIC: checksum-lines ( lines checksum -- value )
  51
  52 M: checksum checksum-stream
  53     [ stream-contents ] dip checksum-bytes ;
  54
  55 M: checksum checksum-lines
  56     [ B{ CHAR: \n } join ] dip checksum-bytes ;
  57
  58 : checksum-file ( path checksum -- value )
  59     #! normalize-path (file-reader) is equivalent to
  60     #! binary <file-reader>. We use the lower-level form
  61     #! so that we can move io.encodings.binary to basis/.
  62     [ normalize-path (file-reader) ] dip checksum-stream ;
  63
  64 : hex-string ( seq -- str )
  65     [ >hex 2 CHAR: 0 pad-head ] { } map-as concat ;