cryogen-core/src/cryogen_core/hierarchic.clj

(ns cryogen-core.hierarchic
  (:require 
    [clojure.string :as s]))

(defn normalized-page-root-uri [page-root-uri]
  (cond 
    (= "" page-root-uri) ""
    (and 
      (s/starts-with? page-root-uri "/")
      (s/ends-with? page-root-uri "/")) page-root-uri
    (and 
      (s/starts-with? page-root-uri "/")
      (not (s/ends-with? page-root-uri "/"))) (str page-root-uri "/")
    (and 
      (not (s/starts-with? page-root-uri "/"))
      (s/ends-with? page-root-uri "/")) (str "/" page-root-uri)
    (and 
      (not (s/starts-with? page-root-uri "/"))
      (not (s/ends-with? page-root-uri "/"))) (str "/" page-root-uri "/"))
  )

(defn uri-level [uri]
  (- (count 
       (s/split uri #"/"))
     1)
  )

(defn filter-pages-for-uri [uri pages]
  (let [html? (s/ends-with? uri ".html")
        clean? (s/ends-with? uri "/")
        clean-uri (cond 
                    html? (subs uri 0 (- (count uri) 5))
                    clean? (subs uri 0 (- (count uri) 1))
                    :default uri)]
    (filter #(s/starts-with? (:uri %) clean-uri) pages))
  )

(defn build-hierarchic-level
  "builds one level of hierarchic tree recurs to next level."
  [parent-uri pages]
  (let [current-level (+ 1 (uri-level parent-uri))
        pages-of-parent (filter-pages-for-uri parent-uri pages)
        pages-on-level (filter #(= current-level (uri-level (:uri %))) pages-of-parent)
        pages-on-child-level (filter #(< current-level (uri-level (:uri %))) pages-of-parent)        
        ]
    (sort-by :page-index
             (map #(let [page-on-level %
              child-pages (filter-pages-for-uri (:uri page-on-level) pages-on-child-level)]
                     (if (empty? child-pages)
                       page-on-level  
                       (merge page-on-level
                              {:children (build-hierarchic-level (:uri page-on-level) child-pages)}))) pages-on-level))
    ))

(defn build-hierarchic-map
  "builds a hierarchic tree from pages"
  [page-root-uri pages]
  (let [sorted-pages (sort-by :uri pages)]
     (build-hierarchic-level (normalized-page-root-uri page-root-uri) sorted-pages)
   ))