;------------------------------------------------ -*- scheme -*-
(use-modules (srfi srfi-1)
             (ice-9 pretty-print)
             (alterator algo)
             (alterator vm defs)
             (alterator vm tree)
             (alterator vm task)
             (evms))

;---------------------------------------------------------------
(define (control-node command junk . args)
  (case command
    ((name) "control")
    ((value) #t)
    ((tree) '("control"))
    ((read)
     (case (assv-ref args 'control)
       ((version) `(version ,(evms 'version)))
       ((pending) `(pending ,(evms 'pending)))
       ((assigned) `(assigned ,(evms 'assigned)))
       ((postponed) `(postponed ,(evms 'postponed)))
       (else '())))
    ((write)
     (case (assv-ref args 'control)
       ((open)
        (if evms '()
            (evms-catch
             (lambda ()
               (set! evms-prefix (if (assv-ref args 'installer) "/mnt/destination" #f))
               (set! evms (engine #:mode 'rw #:prefix evms-prefix))
               (or (not (evms 'pending)) (evms 'commit)) ; activate volumes, just in case
               '()))))
       ((reset)
        (evms-catch
         (lambda ()
           (evms 'close)
           (set! evms (engine #:mode 'rw #:logfile #f #:prefix evms-prefix))
           '())))
       ((update) (set! /evms (create-tree control-node)) '()) ;;(evms 'update))
       ((commit) (evms-catch (lambda () (evms 'commit) '())))
       ((close) ;; assumes all changes commited
        (if evms (evms-close-with (assv-ref args 'ignore))
            '()))))))

(define (evms-close-with args)
  (format #t "CLOSE-WITH: ~S\n" args)
  (cond ((not (or #t (eqv? 'bootable args)))  ; don't care about bootable from now
         '(quote bootable "There is no bootable partitions. Some BIOS'es will not work correctly. Continue?"))
        (#t
         (evms-catch (lambda ()
                       (evms 'finalize)
                       (evms 'close)
                       (set! evms #f)
                       '())))))

(define (evms-catch thunk)
  (catch 'swig-system-error thunk
         (lambda (key func msg . rest) `(error ,msg))))

;---------------------------------------------------------------
(define /evms (create-compound (create-node "evms") control-node))

(lambda (self path args)
  (let ((args (alist-delete 'language (plist->alist args)))) ;no wayz
    (apply /evms
           (sure-symbol (assv-ref args 'action))
           path
           (alist-delete 'action args))))
