;;; Disarchive
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Disarchive.
;;;
;;; Disarchive is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Disarchive is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Disarchive.  If not, see <http://www.gnu.org/licenses/>.

(define-module (disarchive disassemblers)
  #:use-module (gcrypt hash)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-26)
  #:export (<disassembler>
            make-disassembler
            disassembler?
            disassembler-x-file?
            disassembler-disassemble-x
            disassemble))

;;; Commentary:
;;;
;;; This module provides a generalized interface for disassemblers.  A
;;; disassembler is a procedure that takes a filename and disassembles
;;; that file into its metadata and a reference to its data.
;;;
;;; Code:

(define-record-type <disassembler>
  (make-disassembler pred disassemble)
  disassembler?
  (pred disassembler-pred)
  (disassemble disassembler-disassemble))

(define (name->disassembler name)
  (let ((module `(disarchive assemblers ,name)))
    (module-ref (resolve-interface module)
                (symbol-append name '-disassembler))))

(define %disassemblers
  (delay (map name->disassembler
              '(gzip-member
                xz-file
                tarball
                directory-ref))))

(define* (disassemble filename #:optional
                      (algorithm (hash-algorithm sha256))
                      #:key name)
  (and=> (stat filename #f)
         (lambda (st)
           (let loop ((disassemblers (force %disassemblers)))
             (match disassemblers
               (() #f)
               ((($ <disassembler> x-file? disassemble-x) . rest)
                (if (x-file? filename st)
                    (apply disassemble-x filename algorithm
                           (if name `(#:name ,name) '()))
                    (loop rest))))))))
