;; Copyright 2022 Idiomdrottning. LGPL 3.0 (or later). See COPYING.

(define-options
  zshbrev
  `((dir "What directory does zshbrev own? Defaults to .zshbrev"
    (value #t)
    (default ".zshbrev"))))

(define d (c conc
	     (if (absolute-pathname? dir) dir
		 (make-absolute-pathname
		  (sixth (user-information (current-user-name)))
		  dir)) '/))

(create-directory (d 'bin) #t)

(define zz (d 'bin/zshrun))

;; thanks to llua in libera/#zsh for the (q-) solution
(unless (file-exists? zz)
  (with-output-to-file zz
    (fn (print "#!/usr/bin/zsh\nsource "
	       (sixth (user-information (current-user-name)))
	       "/.zshrc\neval \"${(q-)@}\""))))

(import (chicken bitwise))

(set-file-permissions! zz (bitwise-ior perm/ixusr (file-permissions zz)))


(define s-define?
  (conjoin symbol?
	   (as-string
	    (conjoin number? zero?)
	    (c substring-index "define"))))

(define keywords (call-table))

(define (store-keywords name params)
	(eif (filter-map (?-> list car default: #f)
									 (scdr (member '#!key
																 ((o (?-> dotted-list?
																					(fn (append (butlast x)
																											(with (last-pair x)
																														(list (car it)
																																	(cdr it))))))
																		 (?-> atom? list)) params))))
			 (keywords name it)
			 #f))

(define (grab-defines . _) #f)
(define (grab-defines ((? s-define? _) ((_ *** (? symbol? name)) . _) . _)) name)
(define (grab-defines ((? s-define? _) (? symbol? name) . _)) name)
(define (grab-defines ((? s-define? _) (name . params) _))
	(store-keywords name params)
	name)
(define (grab-defines ('define-closure _ (name . params) _))
	(store-keywords name params)
	name)

(if (file-exists? (d 'functions.scm))
    (let* ((fun (with-input-from-file (d 'functions.scm) read-list))
					 (names (filter-map grab-defines fun)))
      (with-output-to-file (d 'brevbox.scm)
				(lambda ()
					(pp `(define zz ,(d 'bin/zshrun)))
					(for-each
					 pp
					 '((import (chicken keyword) brev mdg)
						 (import-for-syntax brev-separate (chicken string))
						 (define-ir-syntax*
							 ((zsh-import) #t)
							 ((zsh-import (type name) . more)
								`(begin
									 (define (,(inject name) . flags)
										 ,(case (strip-syntax type)
												((stdout)
												 `(run (,(list 'unquote 'zz) ,(inject name) ,(list 'unquote-splicing 'flags)) stdports))
												((chomp)
												 `(string-chomp (run/string (,(list 'unquote 'zz) ,(inject name) ,(list 'unquote-splicing 'flags)) stdports)))
												((dwim)
												 `(string->dwim (string-chomp (run/string (,(list 'unquote 'zz) ,(inject name) ,(list 'unquote-splicing 'flags)) stdports))))
												(else
												 `(,((as-string conc) 'run/ (strip-syntax type))
													 (,(list 'unquote 'zz) ,(inject name) ,(list 'unquote-splicing 'flags)) stdports))))
									 (zsh-import ,@more)))
							 ((zsh-import name . more)
								`(begin
									 (define (,(inject name) . flags)
										 (run/string (,(list 'unquote 'zz) ,(inject name) ,(list 'unquote-splicing 'flags)) stdports))
									 (zsh-import ,@more))))))
					(for-each pp fun)
					(pp
					 `(let* ((func (with-input-from-string (pathname-strip-directory (car (argv))) read))
									 (keywords (alist-ref func ',(hash-table->alist (keywords)) eq? '())))
							(if (symbol? func)
									(with
									 (apply
										(eval func)
										((over (acond ((strse x
																					(truly (: bos "--"
																										(=> keep (+ graphic))
																										eos))
																					keep)
																	 (string->keyword it))
																	((strse x
																					(truly (: bos "-" (=> keep alphanumeric)
																										eos))
																					keep)
																	 (eif (find (strse?* `(: bos ,it)) keywords)
																				(string->keyword (symbol->string it))
																				(string->dwim x)))
																	(else (string->dwim x))))
										 (cdr (argv))))
									 (cond
										((string? it)
										 (print it))
										((string=? "#<unspecified>\n" (with-output-to-string (fn (pp it))))
										 (void))
										(it (pp it))
										(else (exit 1))))
									(error "Borkable command name"))))))
      (run (csc ,(d 'brevbox.scm)))
      (for-each (fn (unless (file-exists? (d 'bin/ x)) (create-symbolic-link (d 'brevbox) (d 'bin/ x)))) names))
    (print "Define some functions in " (d 'functions.scm) " first."))