(library
  (thin xml)
  (export generate-xml)
  (import (rnrs)
          (list-utils)
          (generators)
          (xml)
          (fmt fmt)
          (only (srfi s1 lists) iota))

  (define (div-down n d)
    (floor (/ n d)))

  (define (generate-dev dev-id nr-mappings data-offset)
    (tag 'device `((dev-id . ,dev-id)
                   (mapped-blocks . ,nr-mappings)
                   (transaction . 1)
                   (creation-time . 0)
                   (snap-time . 0))
         (tag 'range_mapping `((origin-begin . 0)
                               (data-begin . ,data-offset)
                               (length . ,nr-mappings)
                               (time . 1)))))

  (define (generate-xml max-thins max-mappings)
    (let ((nr-thins ((make-uniform-generator 1 max-thins)))
          (nr-mappings-g (make-uniform-generator (div-down max-mappings 2)
                                                 max-mappings)))
      (let ((nr-mappings (iterate nr-mappings-g nr-thins)))
       (tag 'superblock `((uuid . "")
                         (time . 1)
                         (transaction . 1)
                         (flags . 0)
                         (version . 2)
                         (data-block-size . 128)
                         (nr-data-blocks . ,(apply + nr-mappings)))
            (vcat (map generate-dev
                       (iota nr-thins)
                       nr-mappings
                       (accumulate nr-mappings))))))))