create dirs from md works

This commit is contained in:
jem 2019-12-20 15:55:53 +01:00
parent 399ed2d8ec
commit 8ecdb8c3c6
14 changed files with 338 additions and 306 deletions

View file

@ -169,8 +169,7 @@
(get-resources-recursive
fs-prefix base-path paths
:from-cp from-cp
:from-fs from-fs))
)
:from-fs from-fs)))
; TODO: Add files to keep
(s/defn delete-resource-recursive!
@ -217,3 +216,32 @@
target-path ignore-patterns)
(copy-resources! fs-prefix (str theme-path "/html") ["404.html"]
target-path ignore-patterns)))
(defn distinct-resources-by-path
[resources]
(loop [paths (set (map :path resources))
resources resources
acc []]
(cond (empty? resources) acc
(contains? paths (:path (first resources))) (recur (disj paths (:path (first resources)))
(rest resources)
(conj acc (first resources)))
:else (recur paths (rest resources) acc))))
(defn get-distinct-markup-dirs
[fs-prefix posts pages ignore-patterns]
(let [base-path "templates/md"
resources (get-resources-recursive
fs-prefix base-path [pages posts])
filtered-resources (->> (filter #(= (:resource-type %) :dir) resources)
(distinct-resources-by-path))]
filtered-resources))
(defn create-dirs-from-markup-folders!
"Copy resources from markup folders. This does not copy the markup entries."
[fs-prefix posts pages target-path ignore-patterns]
(let [resources (get-distinct-markup-dirs fs-prefix posts pages
ignore-patterns)]
(doseq [resource resources]
(io/make-parents (io/file (str target-path "/" (:path resource))))
(.mkdir (io/file (str target-path "/" (:path resource)))))))

View file

@ -548,7 +548,12 @@
ignored-files)
;TODO: replace this
; Nur directories kopieren
(copy-resources-from-markup-folders config)
;(copy-resources-from-markup-folders config)
(cp-io/create-dirs-from-markup-folders! "resources/"
(:posts config)
(:pages config)
(cp-io/path "resources/public" blog-prefix)
ignored-files)
(compile-pages params modelled-pages)
(compile-posts params posts)
(compile-tags params posts-by-tag)

View file

@ -16,14 +16,12 @@
(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 "/"))
)
(not (s/ends-with? page-root-uri "/"))) (str "/" page-root-uri "/")))
(defn uri-level [uri]
(- (count
(s/split uri #"/"))
1)
)
1))
(defn filter-pages-for-uri [uri pages]
(let [html? (s/ends-with? uri ".html")
@ -32,8 +30,7 @@
html? (subs uri 0 (- (count uri) 5))
clean? (subs uri 0 (- (count uri) 1))
:default uri)]
(filter #(s/starts-with? (:uri %) clean-uri) pages))
)
(filter #(s/starts-with? (:uri %) clean-uri) pages)))
(defn build-hierarchic-level
"builds one level of hierarchic tree recurs to next level."
@ -41,20 +38,17 @@
(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)
]
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))
))
{: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)
))
(build-hierarchic-level (normalized-page-root-uri page-root-uri) sorted-pages)))

View file

@ -4,7 +4,6 @@
[cryogen-core.io :as cryogen-io])
(:import java.util.Date))
(defn posts-to-items [^String site-url posts]
(map
(fn [{:keys [uri title content date enclosure author description]}]

View file

@ -64,7 +64,6 @@
(rest items))))
(z/root zp))))
(defn- make-toc-entry
"Given an anchor link and some text, construct a toc entry
consisting of link to the anchor using the given text, wrapped
@ -73,7 +72,6 @@
(when (and anchor text)
[:li [:a {:href (str "#" anchor)} text]]))
(defn- build-toc
"Given the root of a toc tree and either :ol or :ul,
generate the table of contents and return it as a hiccup tree."

View file

@ -77,54 +77,73 @@
(map filter-object
(sut/get-resources-recursive
"" "templates/themes/bootstrap4-test" ["js/dummy.js"]))))
(is (=
[]
(sut/get-resources-recursive
"" "templates/themes/bootstrap4-test" ["js/dummy.js"] :from-cp false)))
(is (=
["js/subdir"
"js/subdir/test.js"
"js/subdir/subdummy.js"]
(map #(:path %)
"js/subdir/subdummy.js"
"js/subdir/test.js"]
(sort (map :path
(sut/get-resources-recursive
"" "templates/themes/bootstrap4-test" ["js/subdir"])))))
(deftest test-get-resource-paths-recursive
(is (=
[]
(sut/get-resource-paths-recursive "" "templates/themes/bootstrap4-test" ["not-existing"])))
(is (=
["js/dummy.js"]
(sut/get-resource-paths-recursive
"" "templates/themes/bootstrap4-test" ["js/dummy.js"])))
(is (=
[]
(sut/get-resource-paths-recursive
"" "templates/themes/bootstrap4-test" ["js/dummy.js"]
:from-cp false)))
(is (=
["js/subdir"
"js/subdir/test.js"
"js/subdir/subdummy.js"]
(sut/get-resource-paths-recursive
"" "templates/themes/bootstrap4-test" ["js/subdir"])))
(is (=
["."
"./css"
"./css/dummy.css"
"./js"
"./js/subdir"
"./js/subdir/test.js"
"./js/subdir/subdummy.js"
"./js/dummy.js"
"./html"
"./html/403.html"
"./html/404.html"]
(sut/get-resource-paths-recursive "" "templates/themes/bootstrap4-test" ["."])))
)
"./html/404.html"
"./js"
"./js/dummy.js"
"./js/subdir"
"./js/subdir/subdummy.js"
"./js/subdir/test.js"]
(sort (map :path
(sut/get-resources-recursive
"" "templates/themes/bootstrap4-test" ["."]))))))
(deftest test-delete-resource-recursive
(deftest test-get-distinct-markup-dirs
(is (=
["test_pages"
"test_pages/home"
"test_posts"
"test_posts/home"]
(sort (map :path
(sut/get-distinct-markup-dirs
"not-existing-get-from-cp"
"test_posts" "test_pages"
""))))))
(deftest test-distinct-resources-by-path
(is (= [{:path "pages/test"}
{:path "pages/test1"}
{:path "pages/test2"}]
(sut/distinct-resources-by-path [{:path "pages/test"}
{:path "pages/test1"}
{:path "pages/test2"}
{:path "pages/test1"}]))))
(deftest test-create-dirs-from-markup-folders!
(is (do
(sut/delete-resource-recursive! (str target "2"))
(sut/create-dirs-from-markup-folders!
"not-existing-get-from-cp" "test_posts" "test_pages"
(str target "2") "")
(and (verify-dir-exists
(str (str target "2") "/test_pages"))
(verify-dir-exists
(str (str target "2") "/test_posts"))
(verify-dir-exists
(str (str target "2") "/test_pages/home"))))))
(deftest test-delete-resource-recursive!
(is
(do
(.mkdir (io/file (str "target/tmp" target)))
(sut/delete-resource-recursive! (str "target/tmp" target))
(not (verify-dir-exists (str "target/tmp" target))))))
(.mkdir (io/file target))
(sut/delete-resource-recursive! target)
(not (verify-dir-exists target)))))
(deftest test-filter-for-ignore-patterns
(is (=
@ -132,7 +151,7 @@
(sut/filter-for-ignore-patterns #".*\.ignore" ["file.js" "file.ignore"]))))
(deftest test-copy-resources-from-theme! (is (do
(sut/delete-resource-recursive! (str "target/tmp" target))
(sut/delete-resource-recursive! target)
(sut/copy-resources-from-theme! "./" theme target "")
(and (verify-dir-exists
(str target "/js"))
@ -145,5 +164,4 @@
(verify-file-exists
(str target "/css/dummy.css"))
(verify-file-exists
(str target "/404.html"))
))))
(str target "/404.html"))))))

View file

@ -20,22 +20,19 @@
(is (= "/root/" (sut/normalized-page-root-uri "root")))
(is (= "/root/" (sut/normalized-page-root-uri "/root")))
(is (= "/root/" (sut/normalized-page-root-uri "root/")))
(is (= "/root/" (sut/normalized-page-root-uri "/root/")))
))
(is (= "/root/" (sut/normalized-page-root-uri "/root/")))))
(deftest test-uri-level
(testing
(is (= 2 (sut/uri-level "/pages/nav1/")))
(is (= 2 (sut/uri-level "/pages/nav1.html")))
))
(is (= 2 (sut/uri-level "/pages/nav1.html")))))
(def pages-clean-1 [(page "/pages/nav1/" 0)
(page "/pages/nav1/nav11/" 1)
(page "/pages/nav1/nav13/" 3)
(page "/pages/nav1/nav11/nav112/" 2)
(page "/pages/nav1/nav12/" 2)
(page "/pages/nav1/nav11/xnav111/" 1)
])
(page "/pages/nav1/nav11/xnav111/" 1)])
(def expected-clean-1 [(enhanced-page
"/pages/nav1/" 0
@ -44,16 +41,14 @@
[(page "/pages/nav1/nav11/xnav111/" 1)
(page "/pages/nav1/nav11/nav112/" 2)])
(page "/pages/nav1/nav12/" 2)
(page "/pages/nav1/nav13/" 3)]
)])
(page "/pages/nav1/nav13/" 3)])])
(def pages-dirty [(page "/pages/nav1.html" 0)
(page "/pages/nav1/nav11.html" 1)
(page "/pages/nav1/nav13.html" 3)
(page "/pages/nav1/nav11/nav112.html" 2)
(page "/pages/nav1/nav12.html" 2)
(page "/pages/nav1/nav11/xnav111.html" 1)
])
(page "/pages/nav1/nav11/xnav111.html" 1)])
(def expected-dirty [(enhanced-page
"/pages/nav1.html" 0
@ -62,8 +57,7 @@
[(page "/pages/nav1/nav11/xnav111.html" 1)
(page "/pages/nav1/nav11/nav112.html" 2)])
(page "/pages/nav1/nav12.html" 2)
(page "/pages/nav1/nav13.html" 3)]
)])
(page "/pages/nav1/nav13.html" 3)])])
(def pages-clean-2 [(page "/pages/1/" 0)
(page "/pages/2/" 1)
@ -93,12 +87,9 @@
(is (= expected-clean-2
(sut/build-hierarchic-map "pages" pages-clean-2)))
(is (= expected-clean-3
(sut/build-hierarchic-map "" pages-clean-3)))
)
)
(sut/build-hierarchic-map "" pages-clean-3)))))
(deftest test-filter-pages-for-uri
(testing
(is (= 6 (count (sut/filter-pages-for-uri "/pages/nav1/" pages-clean-1))))
(is (= 6 (count (sut/filter-pages-for-uri "/pages/nav1.html" pages-dirty))))
))
(is (= 6 (count (sut/filter-pages-for-uri "/pages/nav1.html" pages-dirty))))))

View file

@ -90,7 +90,6 @@
"but outer headers cannot be less indented "
"than the original header."]))))
(deftest test-generate-toc
(let [htmlString "<div><h2><a name=\"test\"></a>Test</h2></div>"]
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"