(define-module (pathgro base path-traverse)
  #:export (path-traverse)
  #:use-module (ice-9 common-list)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11))

(use-modules (pathgro base combine-paths) (pathgro base path-strings))
(use-modules (pathgro util stdio) (pathgro util clean-list))
(use-modules (pathgro base path-traverse))

(define-values (forward-slash backward-slash) (values #\/ #\\))
(define seperator forward-slash)

(define ascii-separate-zeroen #("/" "\\" "-"))
(define ascii-separate-single #("%2F" "%5C"))
(define ascii-separate-nibble #("%%42%36%%42%36" "%%43%30%%43%30"))
(define ascii-separate-double #("%252F" "%255C" "%25C0%25AF"))

(define ucode-separate-zeroen #())
(define ucode-separate-single #("%U002F" "%U005C" "%C0%AF" "%C0%9V" "%C1%1C" "%C0%1C" "%C0%AF" "%C1%AF" "%C1%9C" "%C1%PC" "%C0%QF" "%C1%8S" "%E0%80" "%F0%80%80%AF" "%F8%80%80%80"))
(define ucode-separate-double #("%U252F" "%U255C"))
(define ucode-separate-nibble #("%2%46" "%2%66" "%5%43" "%5%63" "%%45C"))

(define ascii-traverse-zeroen #(".."))
(define ascii-traverse-single #("%2E%2E"))
(define ascii-traverse-nibble #("%%32%45%%32%65" "%%43%31%%31%43" "%%43%30%%41%46" "%%43%31%%43%31")) ;see udelimiters1
(define ascii-traverse-double #("%252E%252E"))

(define ucode-traverse-zeroen #())
(define ucode-traverse-single #("%U002E%U002E" "%E0%80%AE" "%F0%80%80%AE" "%F8%80%80%80%AE" "%FC%80%80%80%80%AE"))
(define ucode-traverse-double #("%U252E%U252E"))

;(seed->random-state (random (current-time)))
(seed->random-state 1)

(define (cdup-strings vs vt)
  (let-values ((sl (vector-length vs)) (tl (vector-length vt)))
    (let-values ((si (iota (car sl))) (ti (iota (car tl))))
      (map (lambda (y)
        (map (lambda (x) (string-append (vector-ref vt (car y)) (vector-ref vs (car x)))) si))
        ti)))) 
          
(define (rand-cdup-string vads vats)
    (let-values ((delin (random (vector-length vads))) (trlin (random (vector-length vats))))
      (string-append (vector-ref vats (car trlin)) (vector-ref vads (car delin)))))

(define (rand-grow-cdup-path astr)
  (define (rand-grow-cdup-path-helper acnt xstr)
    (if (zero? acnt)
      astr
      (string-append xstr (rand-grow-cdup-path-helper (- acnt 1) xstr))))
  (rand-grow-cdup-path-helper (random 5) astr))

(define (normal-path apn)
  (let ((i (- (string-length apn) 1)))
    (if (string=? (substring apn i (string-length apn)) "/")
      (normal-path (substring apn 0 i))
      (string-append apn "/"))))

(define (path-depth apn)
  (letrec* ((drl (delete-duplicates! (string-split apn seperator))))
    (- (length drl) 1)))

;(define (path-traverse atrav adirs)
;  (if (null? adirs)
;    '()
;    (cons (string-append (car adirs) atrav) (path-traverse atrav (cdr adirs)))))

(define (string-increase anum atrv)
  (define (string-increase-helper hnum)
    (if (zero? hnum)
      atrv
      (string-append atrv (string-increase-helper (- hnum 1)))))
  (string-increase-helper (- anum 1)))

(define (string-increases smaxd strav)
  (define (string-increases-helper scnt)
    (if (zero? scnt)
      '()
      (cons (string-increase scnt strav) (string-increases-helper (- scnt 1)))))
  (string-increases-helper smaxd))

(define (path-traverse amaxd atrav adirs)
  (if (null? adirs)
    '()
    (if (string=? (car adirs) "/")
      (cons "/" (path-traverse amaxd atrav (cdr adirs)))
      (letrec* ((npath (normal-path (car adirs))) 
         (adept (path-depth npath))
         (acdup (string-increases amaxd atrav))
         (cdups (map (lambda (x) (string-append npath x)) acdup))) 
        (append cdups (path-traverse amaxd atrav (cdr adirs)))))))

;(define cdup-string (rand-cdup-string ascii-separate-single ascii-traverse-single))
;(define cdup-strs (cdup-strings ascii-separate-single ascii-traverse-single))
;(define cdup-path (rand-grow-cdup-path cdup-string))
(define cdup-path-static "../")
(define apath "/cgi-bin/test///")
;(define npath (normal-path apath))
;(define adepth (path-depth npath))
;(define atraverse (car (path-traverse cdup-path (list npath))))
;(define cdup (string-increase adepth cdup-path-static))
;(define anewstr (string-append npath cdup))

;(newline)
;(newline)
;(display (path-traverse cdup-path-static (list apath)))
;(newline)
;(newline)

;(display cdup-string)(newline)
;(display cdup-strs)(newline)
;(display cdup-path)(newline)
;(display cdup-path-static)(newline)
;(display apath)(newline)
;(display npath)(newline)
;(display adepth)(newline)
;(display atraverse)(newline)
;(display cdup)(newline)
;(display anewstr)(newline)
