#lang racket/base

(require racket/sequence
         racket/generator
         racket/string
         racket/path
         "store.rkt"
         "log.rkt"
         "util.rkt"
         file/glob)

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

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

(define (make-next-gen base-path glob-pattern)
  (sequence->generator
   (sequence-filter
    (λ (p)
      (let ((basename (file-name-from-path p)))
        (glob-match? glob-pattern basename)))
    (in-directory base-path))))
        

(define (make-file-walker base-path glob-pattern filter-func
                          #:filename-cleaner [filename-cleaner-func (λ (f) f)]
                          #:clean-os-name [clean-os-name #t])
  (let* ((gen (make-next-gen base-path glob-pattern))
         (next-gens '())
         (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)
         )
    (letrec ((walker-func
      (λ ()
        (let ((path (gen)))
          (if (void? path)
              (if (null? next-gens)
                  (values #f #f #f)
                  (let ((n (car next-gens)))
                    (set! gen (cadr n))
                    (info-am "Walking ~a..." (car n))
                    (set! next-gens (cdr next-gens))
                    (walker-func)))
              (let* ((bd (basedir path))
                     (bn (format "~a" (basename path)))
                     (nbn* (if (eq? clean-os-name #t) (clean-os-basename bn) bn))
                     (nbn (format "~a" (filename-cleaner-func nbn*)))
                     )

                (unless (string=? bn nbn)
                  (with-handlers ([exn? (λ (e)
                                          (warn-am "Cannot rename dirty filename: ~a, ~a" nbn e))])
                    (info-am "Renaming '~a' to '~a' (basedir: ~a)" bn nbn bd)
                    (rename-file-or-directory (build-path bd bn)
                                              (build-path bd nbn) #f)
                    (set! path (build-path bd nbn))
                    (when (directory-exists? path)
                      (info-am "Adding directory ~a to next gens" nbn)
                      (set! next-gens (cons (list
                                             nbn
                                             (make-next-gen path glob-pattern))
                                            next-gens)))
                    ))
              
                (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)))
              )))))
             walker-func
      )
    ))

(define (reset-file-admin-info path info)
  (when (eq? (hash-ref info 'type #f) 'file)
    (hash-set! info 'size (file-size path))
    (hash-set! info 'mtime (file-or-directory-modify-seconds path))
    )
  )

(define (make-file-admin base-path db-store #:filename-cleaner [fc-f (λ (f) f)])

  (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 (store-ref db-store normalized-sub-path #f))
           )
      (cond
        ((eq? in-db #f)
         (hash-set! info 'file-db 'new)
         (store-set! db-store normalized-sub-path info)
         (values base-path path info)
         )
        (else
         (if (file-info-equal? info in-db)
             (hash-set! in-db 'file-db 'unchanged)
             (begin
               (hash-set! in-db 'type (hash-ref info 'type))
               (hash-set! in-db 'file-db 'changed)
               (when (eq? (hash-ref info 'type #f) 'file)
                 (hash-set! in-db 'size (hash-ref info 'size))
                 (hash-set! in-db 'mtime (hash-ref info 'mtime)))))
         (store-set! db-store normalized-sub-path in-db)
         (values base-path path in-db)
         )
        )
      ))

  (define (init-db-sweep)
    (store-transaction db-store
      (let ((count (store-count db-store))
            (k 0)
            (last-perc 0))
        (store-for-each db-store
                        (λ (key value)
                          (set! k (+ k 1))
                          (let ((perc (quotient (* k 100) count)))
                            (when (and (= (remainder perc 10) 0) (> perc last-perc))
                              (set! last-perc perc)
                              (info-am "init-db-sweep: ~a%, k=~a" perc k)))
                          (if (eq? (hash-ref value 'file-db #f) 'deleted)
                              (store-remove! db-store key)
                              (begin
                                (hash-set! value 'file-db 'unknown)
                                (store-set! db-store key value))
                              )
                          )
                        )
        )
      )
    )

  (define (get-deleted)
    (let ((count (store-count db-store))
          (k 0)
          (last-perc 0))
      (let ((keys (store-keys db-store)))
        (map (λ (key)
               (let ((info (store-ref db-store key)))
                 (hash-set! info 'file-db 'deleted)
                 info))
             (filter (λ (key)
                       (set! k (+ k 1))
                       (let ((perc (quotient (* k 100) count)))
                         (when (and (= (remainder perc 10) 0) (> perc last-perc))
                           (set! last-perc perc)
                           (info-am "get-deleted: ~a%" perc)))
                       (let ((v (store-ref db-store key)))
                         (eq? (hash-ref v 'file-db) 'unknown)))
                     keys))))
    )
  
  (let* ((walker-count 0)
         (last-commit-s (current-seconds))
         (fw (make-file-walker base-path "*"
                               (λ (base-path path info)
                                 (let ((tm (current-seconds)))
                                   (cond
                                     ((= walker-count 0)
                                      (store-begin db-store))
                                     ((or (= (remainder walker-count 250) 0)
                                          (> (- tm last-commit-s) 5))
                                      (store-commit db-store)
                                      (store-begin db-store)
                                      (set! last-commit-s tm)
                                      )
                                     )
                                   )
                                 (set! walker-count (+ walker-count 1))
                                 (let-values (((base-path* path* info*) (file-admin base-path path info)))
                                   (values base-path* path* info*)))
                               #:filename-cleaner fc-f
                               ))
         (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
			      (info-am "LAST COMMIT")
                              (store-commit db-store)
                              (set! deleted (get-deleted))
			      (info-am "Got ~a deleted entries" (length 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))))
  )


(define (clean-os-basename name)
  (let* ((s0 (format "~a" name))

         ;; Laatste .ext apart houden.
         ;; Bewust eenvoudig: .flac, .opus, .jpg, .pdf, enz.
         ;; Namen als "Gypsy Festival vol. 2" matchen niet als extensie,
         ;; want daar zit een spatie na de punt.
         (m (regexp-match #px"^(.*)(\\.[A-Za-z0-9][A-Za-z0-9_-]{0,15})$" s0))
         (stem0 (if m (list-ref m 1) s0))
         (ext (if m (list-ref m 2) ""))

         ;; Ongeldige OS-tekens vervangen door '-'.
         (stem1 (list->string
                 (for/list ((ch (in-string stem0)))
                   (if (or (< (char->integer ch) 32)
                           (memq ch '(#\< #\> #\: #\" #\/ #\\ #\| #\? #\*)))
                       #\-
                       ch))))

         ;; Whitespace normaliseren.
         (stem2 (regexp-replace* #px"\\s+" stem1 " "))

         ;; Alleen de stem trimmen.
         ;; Spatie/punt zijn Windows-probleem aan het einde.
         ;; '-' trimmen we hier ook zodat foo:bar?.opus -> foo-bar.opus.
         (stem3 (string-trim stem2 " .-"))

         ;; Windows reserved device names gelden ook met extensie,
         ;; dus CON.flac blijft probleem als stem CON is.
         (reserved? (regexp-match?
                     #px"(?i:^(con|prn|aux|nul|com[1-9]|lpt[1-9])$)"
                     stem3))

         (stem4 (cond
                  ((string=? stem3 "") "_")
                  (reserved? (string-append "_" stem3))
                  (else stem3))))
    (string-trim
      (string-append 
         (string-trim stem4) (string-trim ext)))))