(module foldo mzscheme
  (require (lib "file.rkt") (lib "match.rkt"))
  (provide apply-to-scheme-files)

   (define-syntax (define-excluder stx)

    (define (path->clause c)
      (syntax-case c ()
        [(item ...)
         #`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]]
        [item
         #`[`(item) #t]]))

    (syntax-case stx ()
      [(_ name path ...)
       (with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))])
       #`(define (name p )
           (let* ([dirnames (map path->string (explode-path p))])
             (match (reverse dirnames) ; goofy backwards matching because ... matches greedily
               match-clause ...
               [_ #f]))))]))

  (define-excluder default-excluder
    "compiled" ".git")

  (define exclude-directory?  (make-parameter default-excluder))

  ;; ----------------------------------------
  ;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X)
  ;; applies the given function to each .rkt or .ss or .scm file in the given
  ;; directory hierarchy; returns all results in a list
  (define  (apply-to-scheme-files f root )
     ;;FOLD-FILES

    (fold-files
     (lambda (path kind acc)
       (case kind
         [(file)
          (let ([extension (filename-extension path)])
            (cond
              [(not extension) acc ]
              [(regexp-match #rx"(rkt|rktl|ss|scm)$" extension)
               (let ([resl (f path)])
                 (if resl
                     (cons resl acc)
                     acc ))]
              [else acc ]))]
        [(dir)
          (let* ([p (normalize-path path root)])
            (if ((exclude-directory?) p)
              (values acc #f)
               acc ))]
         [(link) acc ]
         [else (error "never happen")]))
     '()
      root
      ))
  )
