(import (only (srfi srfi-1) filter-map fold last span) (ice-9 regex) (only (ice-9 ftw) scandir))

(define (directory? path) "test if path exists and is a directory"
  (eq? (quote directory) (stat:type (stat path))))

(define (string-indices a search-string)
  "string string -> (integer ...)
   result in a list of indices at which search-string occurs in a string"
  (let ((search-string-length (string-length search-string)) (a-length (string-length a)))
    (let loop ((index (string-contains a search-string)))
      (if index
        (if (= index a-length) (list index)
          (cons index
            (loop (string-contains a search-string (+ index (max 1 search-string-length))))))
        (list)))))

(define (string-replace-string a replace replacement)
  "string string string -> string
   replace all occurences of string \"replace\" inside string \"a\" with string \"replacement\".
   tests with guile 2.06 have shown it to be 22x faster than regexp-substitute/global"
  ;; this procedure is quite nice to debug - comment out one or all string-copy! calls,
  ;; and the result string will be a partial result.
  ; get match positions
  (let ((indices (string-indices a replace)))
    (if (null? indices) a
      (let
        ( (replace-length (string-length replace)) (replacement-length (string-length replacement))
          (a-length (string-length a)))
        ; calculate result string size and create result string
        (let ((r-length (+ a-length (* (length indices) (- replacement-length replace-length)))))
          (let ((r (make-string r-length)))
            ; each match index, copy characters before match-end to the result string
            (let loop ((r-index 0) (prev-index 0) (cur-index (car indices)) (rest (cdr indices)))
              (string-copy! r r-index a prev-index cur-index)
              (let ((r-index (- r-index (- prev-index cur-index))))
                (string-copy! r r-index replacement)
                (if (null? rest)
                  (begin
                    (if (< (+ cur-index replace-length) a-length)
                      (string-copy! r (+ r-index replacement-length)
                        a (+ cur-index replace-length) a-length))
                    r)
                  (loop (+ r-index replacement-length) (+ cur-index replace-length)
                    (car rest) (cdr rest)))))))))))

(define (string-replace-strings a strings-and-replacements)
  "string ((string:search . string:replacement) ...) -> string"
  (fold (lambda (b result) (string-replace-string result (car b) (cdr b))) a
    strings-and-replacements))

(define (fold-span filter-f f a)
  "procedure:{any -> any/false} procedure:{list -> any} list -> any
   fold over each list of elements that consecutively matched filter-f"
  (let loop ((rest a) (result (list)))
    (if (null? rest) (reverse result)
      (call-with-values (lambda () (span filter-f rest))
        (lambda (consecutive rest)
          (if (null? consecutive) (loop (cdr rest) (cons (car rest) result))
            (loop rest (f consecutive result))))))))

(define (map-consecutive filter-f f a)
  "{any -> boolean} {any any ... -> any} list -> list
   \"f\" is called with each list of elements that consecutively matched \"filter-f\". at least two elements at a time"
  (fold-span filter-f
    (lambda (a result) (if (< 1 (length a)) (cons (apply f a) result) (append a result))) a))

(define filesystem-glob
  (let*
    ( (double-asterisk (make-regexp "^\\*\\*([0-9]+)?$"))
      (parse-skip
        (lambda (a) "string -> number"
          (let ((a (regexp-exec double-asterisk a)))
            (and a (let ((depth (match:substring a 1))) (if depth (string->number depth) (inf)))))))
      (parse-match
        (lambda (a) "string -> regexp/string"
          (if (string-index a (lambda (a) (or (eqv? a #\*) (eqv? a #\?))))
            (make-regexp
              (string-append "^"
                (string-replace-strings
                  (regexp-quote (string-replace-strings a (quote (("*" . "/1/") ("?" . "/2/")))))
                  (quote (("/1/" . ".*") ("/2/ " . "."))))
                "$"))
            a)))
      (scandir*
        (lambda (a) "string -> (string:file-name ...)/false"
          (scandir (if (string-null? a) "." a) (lambda (a) (not (string-prefix? "." a))))))
      (get-directory-paths
        (lambda (path) "string -> (string:full-path ...)"
          (filter-map (lambda (a) (let ((a (string-append path "/" a))) (and (directory? a) a)))
            (scandir* path))))
      (parse-path
        (lambda (path) "string -> (number/string/regexp ...)"
          (let*
            ( (path (string-split path #\/))
              (path (if (regexp-exec double-asterisk (last path)) (append path (list "*")) path))
              (parsed (map (lambda (a) (or (parse-skip a) (parse-match a))) path)))
            (map-consecutive string? (lambda a (string-join a "/")) parsed)))))
    (lambda (path)
      "string -> (string ...)
       find files under directory matching a file system path with optional wildcard characters.
       * matches zero or more of any character in a file name.
       ? matches one of any character in a file name.
       ** skips any sub directories to match the rest of the path. at the end of a path it is the same as **/.* including .*
       **n where n is an integer. like ** but skips directories at most n subdirectories deep.
       example patterns
         a/b/*
         *.txt
         a/**/c/*.txt
         a/**
         **/*.txt
         a/**2/*"
      ; split path into literal and wildcard portions. check literal parts with file-exists?,
      ; check wildcard parts by reading and matching directory entries.
      ; to consider: result order, full/relative path
      (reverse
        (let loop ((parsed (parse-path path)) (path "") (result (list)) (skip 0))
          (if (null? parsed) result
            (let ((pattern (car parsed)))
              (cond
                ((number? pattern) (loop (cdr parsed) path result (+ pattern skip)))
                ( (string? pattern)
                  (let ((pattern-path (string-append path pattern)))
                    (if (file-exists? pattern-path)
                      (if (null? (cdr parsed)) (cons pattern-path result)
                        (loop (cdr parsed) (string-append pattern-path "/") result skip))
                      (if (< 0 skip)
                        (fold
                          ; try to match the same pattern in any next lower directory
                          (lambda (path result)
                            (loop parsed (string-append path "/") result (- skip 1)))
                          result (get-directory-paths path))
                        result))))
                ( (regexp? pattern)
                  ; read entries of directory, match files and collect directories
                  (let loop2
                    ( (files (scandir* path)) (directories (list)) (skip-directories (list))
                      (path path) (result result) (skip skip))
                    (if (null? files)
                      ; directory has been fully read.
                      ; if skip, try to match the same pattern in sub directories, then proceed with next pattern
                      (fold
                        (lambda (path result)
                          (loop (cdr parsed) (string-append path "/") result skip))
                        (if (< 0 skip)
                          (fold
                            (lambda (path result) "directory paths are full paths"
                              (loop2 (scandir* path) (list)
                                (list) (string-append path "/") result (- skip 1)))
                            result skip-directories)
                          result)
                        directories)
                      (let*
                        ( (file (car files)) (file-path (string-append path file))
                          (is-dir (directory? file-path)))
                        (if (regexp-exec pattern file)
                          (if (null? (cdr parsed))
                            (loop2 (cdr files) (if is-dir (cons file-path directories) directories)
                              (if is-dir (cons file-path skip-directories) skip-directories) path
                              (cons file-path result) skip)
                            (loop2 (cdr files) (if is-dir (cons file-path directories) directories)
                              skip-directories path result skip))
                          (loop2 (cdr files) directories
                            (if is-dir (cons file-path skip-directories) skip-directories) path
                            result skip))))))))))))))