#!/gnu/store/33kf987rzmdjg3328f52cszgza78i7wv-guile-piped-process-2.2.7/bin/guile --no-auto-compile
-*- scheme -*-
!#

(define-module (simulate)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 getopt-long)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 receive)
  #:use-module (json)
  #:use-module (gash job)
  #:use-module (gash pipe)
  #:use-module (ide command-line)
  #:use-module (ide disable-imports)
  #:export (main))

(define (parse-opts args)
  (let* ((option-spec
          '((debug (single-char #\d))
            (help (single-char #\h))
            (import (single-char #\I) (value #t))
            (model (single-char #\m) (value #t))
            (error (single-char #\e) (value #t))
            (spectrace (single-char #\S) (value #t))
            (trace (single-char #\T) (value #t))))
	 (options (getopt-long args option-spec))
	 (help? (option-ref options 'help #f))
	 (files (option-ref options '() '()))
         (usage? (and (not help?) (null? files))))
    (or
     (and (or help? usage?)
          (format (if usage? (current-error-port) (current-output-port))
                  "\
Usage: simulate [OPTION]... DZN-FILE
Run seqdiag and lseligible and concat result

  -d, --debug            enable debug ouput
  -e, --error            error found during verification
  -h, --help             display this help and exit
  -I, --import=DIR+      add directory DIR to import path
  -m, --model=MODEL      explore model MODEL
  -S, --spectrace=TRACE  use named event trace TRACE as spectrace
  -T, --trace=TRACE      use named event trace TRACE
")
          (exit (if usage? 2 0))))
    options))

(define (main args)
  (let* ((options (parse-opts args))
         (debug? (option-ref options 'debug #f))
         (error (option-ref options 'error #f))
         (imports (multi-opt options 'import))
         (imports (map (cut list "-I" <>) imports))
         (model (option-ref options 'model #f))
         (spectrace (option-ref options 'spectrace #f))
         (trace (option-ref options 'trace #f))

         (files (option-ref options '() #f))
         (file-name (if (pair? files) (car files) "-"))
         (file-port (if (equal? file-name "-") (current-input-port)
                        (open-input-file file-name)))
         (content (read-string file-port))
         (content (if (not (equal? file-name "-")) content
                      (disable-imports content)))
         (foo (when debug? (format (current-error-port) "content: ~s\n" content)))
         (seqdiag-argv (append
                         (if debug? `("-D") '())
                         imports
                         (if model `("-m" ,model) '())
                         (if error `("-e" ,error) '())
                         (if trace `("-T" ,trace) '())
                         (if spectrace `("-S" ,spectrace) '())
                         (list "-")))
         (foo (when debug? (format (current-error-port) "seqdiag-argv: ~s\n" seqdiag-argv)))
         (lseligible-argv (append
                            imports
                            (if model `("-m" ,model) '())
                            (if trace `("-T" ,trace)) '()
                            (list "-")))
         (foo (when debug? (format (current-error-port) "lseligible-argv: ~s\n" lseligible-argv))))
    (receive (seqdiag-out seqdiag-status)
        (pipeline->string `(,(cut display content) ("seqdiag" ,@seqdiag-argv)))
      (let* ((foo (when debug? (format (current-error-port) "seqdiag-out: ~s\n" seqdiag-out)))
             (foo (when debug? (format (current-error-port) "seqdiag-status: ~s\n" seqdiag-status))))
        (if (eq? seqdiag-status 0)
            (let* ((lseligible (with-error-to-port (%make-void-port "w") (cut pipeline->string `(,(cut display content) ("lseligible" ,@lseligible-argv)))))
                   (foo (when debug? (format (current-error-port) "lseligible: ~s\n" lseligible))))
              (display (scm->json-string
                        `((seqdiag . ,(json-string->scm seqdiag-out))
                          (lseligible . ,lseligible))))))
        (exit seqdiag-status)))))

(main (command-line))
