(uiop:define-package :fwoar.bin-parser
    (:use :cl)
  (:mix :fw.lu :alexandria :serapeum)
  (:export :le->int
           :read-bytes
           :extract
           :extract-let))

(in-package :fwoar.bin-parser)

(defun read-bytes (n s)
  (with (seq (make-array n :element-type 'octet))
    (values seq
            (read-sequence seq s))))

(defun calculate-sizes (desc)
  (reduce #'+ desc
          :key #'cadr
          :initial-value 0))

(defun le->int (bytes)
  (cadr
   (reduce (op (destructuring-bind (count val) _1
                 (list (1+ count)
                       (+ val
                          (ash _2
                               (* count 8))))))
           bytes
           :initial-value (list 0 0))))

(defun get-extractable-bytes (desc &optional (bindings ()))
  (loop for ((name size . other) . rest) on (resolve-sizes desc bindings)
     until (symbolp size)
     collect (list* name size other) into extractable
     finally (return (values extractable
                             (append (unsplice
                                      (when (symbolp size)
                                        (list* name size other)))
                                     rest))))) 

(defun resolve-sizes (desc extant-bindings)
  (declare (optimize (debug 3)))
  (loop with bindings = (copy-seq extant-bindings)
     for (name size . rest) in desc
     for resolved = (when (symbolp size)
                      (cdr (assoc size bindings)))
     when resolved do (push (cons name resolved)
                            bindings)
     if resolved collect (list* name resolved rest) into new-desc
     else collect (list* name size rest) into new-desc
     finally (return (values new-desc
                             (remove-duplicates (append (mapcar (op (apply #'cons (subseq _ 0 2)))
                                                                new-desc)
                                                        bindings)
                                                :key 'car
                                                :from-end t)))))

(defun extract-bytes (desc bytes)
  (loop
     with cur-idx = 0
     for (name size . rest) in desc
     for next-seq = (subseq bytes cur-idx
                            (+ cur-idx size))
     collect (cons name (if rest
                            (funcall (car rest) next-seq)
                            next-seq))
     do (incf cur-idx size)))

(defun parse-struct (desc s)
  (let* ((struct-size (calculate-sizes desc))
         (bytes (read-bytes struct-size s)))
    (extract-bytes desc bytes)))

(defun make-zipfile-stream (fn)
  (open fn :element-type '(unsigned-byte 8)))


(defun extract (raw-desc s &optional bindings)
  (multiple-value-bind (desc remainder) (get-extractable-bytes raw-desc bindings)
    (let ((next-segment (parse-struct desc s)))
      (if remainder
          (append next-segment
                  (extract remainder s (append next-segment bindings)))
          next-segment))))

(defmacro extract-let ((&rest bindings) parser s &body body)
  (labels ((collect-binding (binding-spec)
             (destructuring-bind (name target) binding-spec
               `(,name (cdr (assoc ,target it)))))
           (collect-bindings ()
             (mapcar #'collect-binding bindings)))
    `(let* ((it (extract ,parser ,s))
            ,@(collect-bindings))
       ,@body)))