#!/usr/bin/guile
!#

(use-modules (srfi srfi-1) (sph filesystem)
  (sph hashtable) (sph io)
  (sph list) (sph alist)
  (sph number) (sph other) (sph process) (sph string) (sph vector) (sph) (sph process create))

(define (execute->error-and-status executable-path arguments)
  "string (string ...) -> string:error-port-output integer:exit-code"
  (execute-with-pipes (l (error) (begin-first (port->string error) (close-port error)))
    executable-path arguments #f #f #t))

(define (execute->number path . arguments)
  "execute program and convert the result from standard output to a number with string->number"
  (string->number (string-trim-right (apply execute->string path arguments))))

(define (test-error-output executable-path . arguments)
  "string string ... -> boolean
   execute a program and display a success message or a failure message and the output written to standard error"
  (apply-values
    (l (a exit-status)
      (if
        (and (zero? exit-status)
          (or (string-null? a) (not (string-contains-some? a (list "warning:" "backtrace")))))
        (begin (display-line (string-append executable-path " success")) #t)
        (begin (display-line (string-append executable-path " failure")) (display a) #f)))
    (execute->error-and-status executable-path arguments)))

(define (test-cli-help)
  "execute all programs that have a --help option and check output.
   these tests show missing variable references and other compile errors.
   unfortunately, guile writes its auto-compile info to standard error"
  (every (l (a) (test-error-output a "--help"))
    (list "1/filesystem/collect-file" "1/filesystem/late-write"
      "1/filesystem/mount-home" "1/filesystem/mount-sshfs-home"
      "1/text/lines-filter" "2/text/tabular-select"
      "1/filesystem/splice" "2/filesystem/move-and-link"
      "2/filesystem/merge-files" "2/other/scm-format"
      "2/media/video-extract-audio" "1/other/restart-on-end"
      "2/time/hms-to-ks" "2/filesystem/tag-remove"
      "2/filesystem/tag-sort" "2/filesystem/tag-add" "2/convert/hex" "2/convert/binary")))

(define (test-compress-whitespace-columns)
  (execute-with-pipes
    (l (input output error)
      (display
        (string-append (string-multiply " " 3) "ab"
          (string-multiply " " 4) "c" (string-multiply " " 5))
        input)
      (close-port input) (begin-first (equal? " ab c " (port->string output)) (close-port output)))
    "1/text/compress-whitespace-columns" (list) #t #t #t))

(define (test-lowercase)
  (execute-with-pipes
    (l (input output error) (display "tEsT" input)
      (close-port input) (begin-first (equal? "test" (port->string output)) (close-port output)))
    "1/text/lowercase" (list) #t #t #t))

(define (test-iso-week-number) (integer? (execute->number "1/time/iso-week-number")))
(define (test-day-seconds) (integer? (execute->number "1/time/day-seconds")))
(define (test-uptime-start-ks) (number? (execute->number "2/time/uptime-start-ks")))
(define (test-uptime-duration-ks) (number? (execute->number "2/time/uptime-start-ks")))
(define (test-ks-time) (number? (execute->number "2/time/ks-time")))

(define untested-description
  "; yet untested:
   ;; time/ks-to-hms
   ;; filesystem/path-directories
   ;; filesystem/delete-if-empty
   ;; filesystem/prefix-sort
   ;; filesystem/searchl
   ;; filesystem/group
   ;; filesystem/unique-path
   ;; filesystem/rename-lowercase
   ;; filesystem/search
   ;; text/file-lines-set-operations
   ;; text/newline-to-space
   ;; text/space-to-newline
   ;; text/comma-to-newline
   ;; text/remove-double-newlines
   ;; text/newline-to-comma
   ;; other/golden-ratio")

(define (test-sph-script)
  (let
    (result
      (every
        (l (a)
          (let (name (symbol->string (procedure-name a)))
            (if (a) (begin (display-line (string-append name " success")) #t)
              (begin (display-line (string-append name " failure")) #f))))
        (list test-cli-help test-compress-whitespace-columns
          test-iso-week-number test-uptime-start-ks
          test-day-seconds test-uptime-duration-ks test-ks-time test-lowercase)))
    (exit (boolean->integer (not result)))))

(test-sph-script)