core/checksums/checksums.factor

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