#|-------------------- 0.1 |# "./breadcrumbs.meta" 316
;;; breadcrumbs.meta -*- scheme -*-

((egg "breadcrumbs.egg")
 (synopsis "Breadcrumbs for web pages")
 (author "<a href=\"http://chicken.wiki.br/users/mario-domenech-goulart\">Mario Domenech Goulart</a>")
 (license "BSD")
 (category web)
 (files "test.scm" "breadcrumbs.scm" "breadcrumbs.setup" "breadcrumbs.meta"))

#|-------------------- 0.1 |# "./breadcrumbs.scm" 2121
(module breadcrumbs

  (;; parameters
   breadcrumbs-home-path
   breadcrumbs-home-label
   breadcrumbs-separator
   breadcrumbs-link
   debug-breadcrumbs
   breadcrumbs

   ;; procedures
   add-breadcrumb!
   get-breadcrumb)

(import scheme chicken data-structures extras)
(use files srfi-1)

(define breadcrumbs-home-path (make-parameter "/"))

(define breadcrumbs-home-label (make-parameter "Home"))

(define breadcrumbs (make-parameter '()))

(define breadcrumbs-separator (make-parameter " &gt; "))

(define debug-breadcrumbs (make-parameter #f))

(define (path-join parts)
  (string-intersperse parts "/"))

(define (path-split path)
  (string-split path "/"))

(define (path-diff path)
  (let ((path (path-split path)))
    (lset-difference equal? path (path-split (breadcrumbs-home-path)))))

(define breadcrumbs-link
  (make-parameter
   (lambda (uri text)
     (string-append "<a href='" uri "'>" text "</a>"))))

(define (add-breadcrumb! path title)
  (let ((diff (path-diff path)))
    (unless (alist-ref diff (breadcrumbs) equal?)
      (breadcrumbs (cons (cons diff title) (breadcrumbs))))))

(define (get-breadcrumb path)
  (let ((diff (path-diff path)))

    (when (debug-breadcrumbs)
      (print "Current breadcrumbs table:")
      (pp (breadcrumbs))
      (display "\nRequested path: ")
      (pp path)
      (display "Diff: ")
      (pp diff))

    (if (null? diff)
        ""
        (string-intersperse
         (append
          (list ((breadcrumbs-link) (breadcrumbs-home-path) (breadcrumbs-home-label)))
          (reverse
           (let loop ((parts (butlast diff)))
             (if (null? parts)
                 '()
                 (let ((bc (alist-ref parts (breadcrumbs) equal?)))
                   (if bc
                       (cons ((breadcrumbs-link)
                              (make-pathname (breadcrumbs-home-path) (path-join parts))
                              bc)
                             (loop (butlast parts)))
                       (loop (cdr parts)))))))
          (list (alist-ref  diff (breadcrumbs) equal?)))
         (breadcrumbs-separator)))))

) ; end module

#|-------------------- 0.1 |# "./breadcrumbs.setup" 267
;;; breadcrumbs.setup -*- scheme -*-

(compile -s -O2 -d1 -j breadcrumbs breadcrumbs.scm)
(compile -s -O2 -d1 breadcrumbs.import.scm)

(install-extension 'breadcrumbs
                   '("breadcrumbs.so" "breadcrumbs.import.so")
                   '((version 0.1)))

#|-------------------- 0.1 |# "./test.scm" 599
#!/usr/bin/csi -script

(load "breadcrumbs.scm")
(import breadcrumbs)

(use test)

(test-begin "breadcrumbs")

(add-breadcrumb! "/a" "A")
(test "" (get-breadcrumb "/"))
(test "<a href='/'>Home</a> &gt; A" (get-breadcrumb "/a"))

(add-breadcrumb! "/a/b" "B")
(test "<a href='/'>Home</a> &gt; <a href='/a'>A</a> &gt; B"
      (get-breadcrumb "/a/b"))

;; Changing the home path
(breadcrumbs '())
(breadcrumbs-home-path "/a")
(add-breadcrumb! "/a" "A")
(add-breadcrumb! "/a/b" "B")
(test "" (get-breadcrumb "/a"))
(test "<a href='/a'>Home</a> &gt; B" (get-breadcrumb "/a/b"))

(test-end "breadcrumbs")