#lang racket/base

(require racket/sequence
         racket/generator
         racket/string
         racket/path
         file/glob)

(provide make-file-walker
         make-file-admin
         fw-add-step
         os-path
         )

(define (os-path str)
  (let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")))
    (string-replace str "/" delim)))

(define (make-file-walker base-path glob-pattern filter-func)
  (let* ((gen (sequence->generator
               (sequence-filter
                (λ (p)
                  (let ((basename (file-name-from-path p)))
                    (glob-match? glob-pattern basename)))
                (in-directory base-path))))
         (str-base-path* (format "~a" (normalize-path base-path)))
         (delim (if (eq? (system-path-convention-type) 'windows) "\\" "/"))
         (str-base-path (if (string-suffix? str-base-path* delim)
                            str-base-path*
                            (string-append str-base-path* delim)))
         (base-path-len (string-length str-base-path))
         (result #f)
         )
    (λ ()
      (let ((path (gen)))
        (if (void? path)
            (values #f #f #f)
            (let* ((str-path (path->string path))
                   (ext* (path-get-extension path))
                   (ext (string->symbol
                         (substring
                          (if (eq? ext* #f)
                              "."
                              (let ((e (string-downcase (bytes->string/utf-8 ext*))))
                                (if (string-contains? e " ")
                                    "."
                                    e))) 1)))
                   (path-part (substring str-path base-path-len))
                   (str-n-path (string-replace path-part "\\" "/"))
                   (info (let ((h (make-hash (list
                                              (cons 'type 'dir)
                                              (cons 'path str-n-path)
                                              (cons 'ext ext)))))
                           (when (file-exists? path)
                             (hash-set! h 'type 'file)
                             (hash-set! h 'size (file-size path))
                             (hash-set! h 'mtime (file-or-directory-modify-seconds path))
                             )
                           h))
                   )
              (filter-func base-path path info)))
        )
      )
    )
  )

(define (make-file-admin base-path db-hash)

  (define (file-info-equal? i1 i2)
    (if (eq? (hash-ref i1 'type) (hash-ref i2 'type))
        (if (eq? (hash-ref i1 'type) 'file)
            (and
             (string=? (hash-ref i1 'path) (hash-ref i2 'path))
             (= (hash-ref i1 'size) (hash-ref i2 'size))
             (= (hash-ref i1 'mtime) (hash-ref i2 'mtime)))
            (string=? (hash-ref i1 'path) (hash-ref i2 'path))
            )
        #f))
  
  (define (file-admin base-path path info)
    (let* ((normalized-sub-path (hash-ref info 'path))
           (in-db (hash-ref db-hash normalized-sub-path #f))
           )
      (cond
        ((eq? in-db #f)
         (hash-set! info 'file-db 'new)
         (hash-set! db-hash normalized-sub-path info)
         )
        (else
         (if (file-info-equal? info in-db)
             (hash-set! info 'file-db 'unchanged)
             (hash-set! info 'file-db 'changed))
         (hash-set! db-hash normalized-sub-path info)
         )
        )
      (values base-path path info)
      ))

  (define (init-db-sweep)
    (hash-for-each db-hash
                   (λ (key value)
                     (if (eq? (hash-ref value 'file-db #f) 'deleted)
                         (hash-remove! db-hash key)
                         (hash-set! value 'file-db 'unknown)))))

  (define (get-deleted)
    (let ((keys (hash-keys db-hash)))
      (map (λ (key)
             (let ((info (hash-ref db-hash key)))
               (hash-set! info 'file-db 'deleted)
               info))
           (filter (λ (key)
                     (let ((v (hash-ref db-hash key)))
                       (eq? (hash-ref v 'file-db) 'unknown)))
                   keys))))
  
  (let* ((fw (make-file-walker base-path "*" file-admin))
         (deleted #f))
    (init-db-sweep)
    (letrec ((f (λ ()
                  (if (list? deleted)
                      (if (null? deleted)
                          (values #f #f #f)
                          (let ((r (car deleted)))
                            (set! deleted (cdr deleted))
                            (values base-path (build-path base-path (os-path (hash-ref r 'path))) r))
                          )
                      (let-values (((base-path path info) (fw)))
                        (if (eq? info #f)
                            (begin
                              (set! deleted (get-deleted))
                              (f))
                            (values base-path path info))
                        )
                      )
                  )
                ))
      f))
  )

(define (fw-add-step fw step-func)
  (λ ()
    (let-values (((base-path path info) (fw)))
      (if (eq? info #f)
          (values #f #f #f)
          (step-func base-path path info))))
  )