#lang racket/base

(require racket/contract
         racket/list)

(provide
 (contract-out
  [bits->bytes (-> (listof boolean?) bytes?)]
  [bits->integer (-> (listof boolean?) exact-nonnegative-integer?)]
  [bits->string (-> (listof boolean?) string?)]
  [bytes->bits (-> bytes? (listof boolean?))]
  [integer->bits (->* (exact-nonnegative-integer?)
                      ((or/c #f exact-nonnegative-integer?))
                      (listof boolean?))]))

(define (bits->bytes bits)
  (list->bytes
   (let loop ([n (length bits)]
              [bits bits])
     (cond
       [(zero? n) '()]
       [(< n 8) (list (arithmetic-shift (bits->integer bits) (- 8 n)))]
       [else (let-values ([(byte bits) (split-at bits 8)])
               (cons (bits->integer byte)
                     (loop (- n 8) bits)))]))))

(define (bits->integer bits)
  (for/fold ([a 0])
            ([b (in-list bits)])
    (bitwise-ior (arithmetic-shift a 1)
                 (if b 1 0))))

(define (bits->string bits)
  (define (convert bits n)
    (build-string n
                  (lambda (i)
                    (if (list-ref bits i) #\1 #\0))))
  (let loop ([n (length bits)]
             [bits bits]
             [s ""])
    (if (<= n 8)
        (string-append s (convert bits n))
        (loop (- n 8)
              (drop bits 8)
              (string-append s (convert bits 8) " ")))))
   
(define (bytes->bits bytes)
  (append*
   (map (lambda (b)
          (integer->bits b 8))
        (bytes->list bytes))))

(define (integer->bits m [length #f])
  (let ([n (or length
               (integer-length m))])
    (build-list n
                (lambda (b)
                  (bitwise-bit-set? m (- n b 1))))))