2017-02-09 07:52:42 +00:00
|
|
|
(ns cryogen-core.hierarchic
|
2017-02-08 18:22:15 +00:00
|
|
|
(:require
|
|
|
|
[clojure.string :as s]))
|
|
|
|
|
2017-02-08 19:09:01 +00:00
|
|
|
(defn uri-level [uri]
|
|
|
|
(- (count
|
|
|
|
(s/split uri #"/"))
|
|
|
|
1)
|
|
|
|
)
|
2017-02-08 18:22:15 +00:00
|
|
|
|
2017-02-08 19:09:01 +00:00
|
|
|
(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))
|
|
|
|
)
|
2017-02-08 18:22:15 +00:00
|
|
|
|
2017-02-09 07:52:42 +00:00
|
|
|
(defn build-hierarchic-level
|
2017-02-08 18:22:15 +00:00
|
|
|
"builds one level of nav-map and 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
|
2017-02-09 07:52:42 +00:00
|
|
|
{:children (build-hierarchic-level (:uri page-on-level) child-pages)}))) pages-on-level))
|
2017-02-08 18:22:15 +00:00
|
|
|
))
|
|
|
|
|
2017-02-09 07:52:42 +00:00
|
|
|
(defn build-hierarchic-map
|
2017-02-08 18:22:15 +00:00
|
|
|
"builds a nav-map from pages"
|
|
|
|
[pages]
|
|
|
|
(let [sorted-pages (sort-by :uri pages)]
|
2017-02-09 07:52:42 +00:00
|
|
|
(build-hierarchic-level "/pages/" sorted-pages)
|
2017-02-08 18:22:15 +00:00
|
|
|
))
|