;;;; posix-utils.scm
;;;; Kon Lovett, Nov '10
;;;; Kon Lovett, Feb '18

;; Issues
;;

(module posix-utils

(;export
  string-trim-eol software-eol-string
  environment-variables->environment-list
  environment-variable-bound?
  environment-variable-true?
  register-environment-variable-feature!
  get-shell-variable
  shell-variable-bound?
  shell-variable-true?
  register-shell-variable-feature!)

(import scheme chicken)
(use
  (only (srfi 1) member)
  (only data-structures identity ->string)
  (only posix process process-wait)
  (only utils read-all)
  (only (srfi 13) string-trim-both string-index string-take string-null? string-downcase)
  (only (srfi 14) list->char-set)
  (only check-errors check-string) )

;;

(define-constant *SHELL-TRUE-VALUES* '("y" "yes" "1"))

(: shell-value-bound? ((or boolean string) -> (or boolean string)))
(define (shell-value-bound? varval)
  (and-let* (
    (str varval)
    ((not (string-null? str))) )
    str ) )

(: shell-value-true? ((or boolean string) (or boolean (list-of string)) -> boolean))
(define (shell-value-true? varval truedat)
  (and-let* (
    (str varval) )
    (let* (
      (truedat (or truedat *SHELL-TRUE-VALUES*))
      (str (string-trim-both str))
      (str (string-downcase str)) )
      (member str truedat string=?) ) ) )

(: register-shell-value-feature! ((or boolean string) procedure -> (or boolean symbol)))
(define (register-shell-value-feature! varval filter)
  (and-let* (
    (str (shell-value-bound? varval))
    (str (filter str)) )
    (let (
      (varsym (string->symbol str)) )
      (register-feature! varsym)
      varsym ) ) )

;;

(define software-eol-sequence
  (cond-expand
    (windows
     '(#\return #\newline))
    (unix
     '(#\newline))
    (else
     '(#\return)) ) )

(define char-set:software-eol (list->char-set software-eol-sequence))

(define software-eol-string (list->string software-eol-sequence))
(define software-eol-length (string-length software-eol-string))

(define (string-trim-eol str)
  (let* (
    (end (string-length str))
    (start (fx- end software-eol-length))
    (index
      (and
        (fx<= 0 start) (fx< start end)
        ;order of multi-char sequences is not imposed !
        (string-index str char-set:software-eol start end))) )
    (if (not index)
      str
      (string-take str index) ) ) )

;;

(define (environment-variables->environment-list al)
  (map
    (lambda (pare)
      (let ((nam (check-string 'environment-variables->environment-list (car pare) "item variable name")))
        (string-append nam "=" (->string (cdr pare))) ) )
    al) )

;;

(: environment-variable-bound? (string -> (or boolean string)))
(define (environment-variable-bound? nam)
  (shell-value-bound? (get-environment-variable nam)) )

(: environment-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
(define (environment-variable-true? nam #!optional truedat)
  (shell-value-true? (get-environment-variable nam) truedat) )

(: register-environment-variable-feature! (string -> (or boolean symbol)))
(define (register-environment-variable-feature! nam #!optional (filter identity))
  (register-shell-value-feature! (get-environment-variable nam) filter) )

;;

(: get-shell-variable (string -> (or boolean string)))
(define (get-shell-variable nam)
  (let ((in (void)) (out (void)) (pid (void)))
    (dynamic-wind
      (lambda ()
        (set!-values (in out pid)
          (process (string-append "echo \"$" nam  "\""))) )
      (lambda ()
        (and-let* (
          ;echo command result (w/ eol)
          (instr (read-all in))
          ;remove trailing eol from echo command
          (str (string-trim-eol instr)) )
          ;the shell variable value
          str ) )
      (lambda ()
        (close-input-port in)
        (close-output-port out) ) ) ) )

(: shell-variable-bound? (string -> (or boolean string)))
(define (shell-variable-bound? nam)
  (shell-value-bound? (get-shell-variable nam)) )

(: shell-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
(define (shell-variable-true? nam #!optional truedat)
  (shell-value-true? (get-shell-variable nam) truedat) )

(: register-shell-variable-feature! (string -> (or boolean symbol)))
(define (register-shell-variable-feature! nam #!optional (filter identity))
  (register-shell-value-feature! (get-shell-variable nam) filter) )

;;;

) ;module posix-utils