add Blog/Page/Post/Tag uri customisation

add :tag-root-uri :page-root-uri :post-root-uri parsing

replace {entity}-root with {entity}-root-uri parameters to set uri

fix root-path call

fix root-path function params order
(worked erlier because of keyword<->map transposition)

fix keyword :{entity}-root-uri to :{entity}-root transformation

misprint: congig -> config

add function to compose file path

add create-file function

add function to compose a path

handle empty blog-path using path function

fix filename for preview
This commit is contained in:
Sergiy BONDARYEV 2015-11-08 14:33:07 +01:00
parent 5b13b3b761
commit eea999e1d7
4 changed files with 109 additions and 92 deletions

View file

@ -11,21 +11,20 @@
[cryogen-core.sass :as sass] [cryogen-core.sass :as sass]
[cryogen-core.markup :as m] [cryogen-core.markup :as m]
[cryogen-core.io :refer [cryogen-core.io :refer
[get-resource find-assets create-folder wipe-public-folder copy-resources [get-resource find-assets create-folder create-file wipe-public-folder
copy-resources-from-theme]] copy-resources copy-resources-from-theme path]]
[cryogen-core.sitemap :as sitemap] [cryogen-core.sitemap :as sitemap]
[cryogen-core.rss :as rss]) [cryogen-core.rss :as rss])
(:import java.util.Locale)) (:import java.util.Locale))
(cache-off!) (cache-off!)
(def public "resources/public") (defn root-uri
"Creates the uri for posts, tags and pages. Returns root-path by default"
(defn root-path [k config]
"Creates the root path for posts, tags and pages" (if-let [uri (k config)]
[config k] uri
(if-let [root (k config)] (config (-> k (name) (s/replace #"-uri$" "") (keyword)))))
(str "/" root "/") "/"))
(defn re-pattern-from-ext (defn re-pattern-from-ext
"Creates a properly quoted regex pattern for the given file extension" "Creates a properly quoted regex pattern for the given file extension"
@ -35,12 +34,12 @@
(defn find-posts (defn find-posts
"Returns a list of markdown files representing posts under the post root in templates/md" "Returns a list of markdown files representing posts under the post root in templates/md"
[{:keys [post-root ignored-files]} mu] [{:keys [post-root ignored-files]} mu]
(find-assets (str "templates/" (m/dir mu) post-root) (m/ext mu) ignored-files)) (find-assets (path "templates" (m/dir mu) post-root) (m/ext mu) ignored-files))
(defn find-pages (defn find-pages
"Returns a list of markdown files representing pages under the page root in templates/md" "Returns a list of markdown files representing pages under the page root in templates/md"
[{:keys [page-root ignored-files]} mu] [{:keys [page-root ignored-files]} mu]
(find-assets (str "templates/" (m/dir mu) page-root) (m/ext mu) ignored-files)) (find-assets (path "templates" (m/dir mu) page-root) (m/ext mu) ignored-files))
(defn parse-post-date (defn parse-post-date
"Parses the post date from the post's file name and returns the corresponding java date object" "Parses the post date from the post's file name and returns the corresponding java date object"
@ -50,13 +49,13 @@
(defn post-uri (defn post-uri
"Creates a post uri from the post file name" "Creates a post uri from the post file name"
[file-name {:keys [blog-prefix post-root]} mu] [file-name {:keys [blog-prefix post-root-uri]} mu]
(str blog-prefix post-root (s/replace file-name (re-pattern-from-ext (m/ext mu)) ".html"))) (path "/" blog-prefix post-root-uri (s/replace file-name (re-pattern-from-ext (m/ext mu)) ".html")))
(defn page-uri (defn page-uri
"Creates a page uri from the page file name" "Creates a page uri from the page file name"
[page-name {:keys [blog-prefix page-root]} mu] [page-name {:keys [blog-prefix page-root-uri]} mu]
(str blog-prefix page-root (s/replace page-name (re-pattern-from-ext (m/ext mu)) ".html"))) (path "/" blog-prefix page-root-uri (s/replace page-name (re-pattern-from-ext (m/ext mu)) ".html")))
(defn read-page-meta (defn read-page-meta
"Returns the clojure map from the top of a markdown page/post" "Returns the clojure map from the top of a markdown page/post"
@ -168,9 +167,9 @@
(defn tag-info (defn tag-info
"Returns a map containing the name and uri of the specified tag" "Returns a map containing the name and uri of the specified tag"
[{:keys [blog-prefix tag-root]} tag] [{:keys [blog-prefix tag-root-uri]} tag]
{:name (name tag) {:name (name tag)
:uri (str blog-prefix tag-root (name tag) ".html")}) :uri (path "/" blog-prefix tag-root-uri (str (name tag) ".html"))})
(defn add-prev-next (defn add-prev-next
"Adds a :prev and :next key to the page/post data containing the title and uri of the prev/next "Adds a :prev and :next key to the page/post data containing the title and uri of the prev/next
@ -191,62 +190,62 @@
(defn compile-pages (defn compile-pages
"Compiles all the pages into html and spits them out into the public folder" "Compiles all the pages into html and spits them out into the public folder"
[{:keys [blog-prefix page-root] :as params} pages] [{:keys [blog-prefix page-root-uri] :as params} pages]
(when-not (empty? pages) (when-not (empty? pages)
(println (blue "compiling pages")) (println (blue "compiling pages"))
(create-folder (str blog-prefix page-root)) (create-folder (path "/" blog-prefix page-root-uri))
(doseq [{:keys [uri] :as page} pages] (doseq [{:keys [uri] :as page} pages]
(println "\t-->" (cyan uri)) (println "\t-->" (cyan uri))
(spit (str public uri) (create-file uri
(render-file (str "/html/" (:layout page)) (render-file (str "/html/" (:layout page))
(merge params (merge params
{:active-page "pages" {:active-page "pages"
:servlet-context "../" :servlet-context (path "/" blog-prefix "/")
:page page :page page
:uri uri})))))) :uri uri}))))))
(defn compile-posts (defn compile-posts
"Compiles all the posts into html and spits them out into the public folder" "Compiles all the posts into html and spits them out into the public folder"
[{:keys [blog-prefix post-root disqus-shortname] :as params} posts] [{:keys [blog-prefix post-root-uri disqus-shortname] :as params} posts]
(when-not (empty? posts) (when-not (empty? posts)
(println (blue "compiling posts")) (println (blue "compiling posts"))
(create-folder (str blog-prefix post-root)) (create-folder (path "/" blog-prefix post-root-uri))
(doseq [post posts] (doseq [post posts]
(println "\t-->" (cyan (:uri post))) (println "\t-->" (cyan (:uri post)))
(spit (str public (:uri post)) (create-file (:uri post)
(render-file (str "/html/" (:layout post)) (render-file (str "/html/" (:layout post))
(merge params (merge params
{:active-page "posts" {:active-page "posts"
:servlet-context "../" :servlet-context (path "/" blog-prefix "/")
:post post :post post
:disqus-shortname disqus-shortname :disqus-shortname disqus-shortname
:uri (:uri post)})))))) :uri (:uri post)}))))))
(defn compile-tags (defn compile-tags
"Compiles all the tag pages into html and spits them out into the public folder" "Compiles all the tag pages into html and spits them out into the public folder"
[{:keys [blog-prefix tag-root] :as params} posts-by-tag] [{:keys [blog-prefix tag-root-uri] :as params} posts-by-tag]
(when-not (empty? posts-by-tag) (when-not (empty? posts-by-tag)
(println (blue "compiling tags")) (println (blue "compiling tags"))
(create-folder (str blog-prefix tag-root)) (create-folder (path "/" blog-prefix tag-root-uri))
(doseq [[tag posts] posts-by-tag] (doseq [[tag posts] posts-by-tag]
(let [{:keys [name uri]} (tag-info params tag)] (let [{:keys [name uri]} (tag-info params tag)]
(println "\t-->" (cyan uri)) (println "\t-->" (cyan uri))
(spit (str public uri) (create-file uri
(render-file "/html/tag.html" (render-file "/html/tag.html"
(merge params (merge params
{:active-page "tags" {:active-page "tags"
:servlet-context "../" :servlet-context (path "/" blog-prefix "/")
:name name :name name
:posts posts :posts posts
:uri uri}))))))) :uri uri})))))))
(defn compile-tags-page [{:keys [blog-prefix] :as params}] (defn compile-tags-page [{:keys [blog-prefix] :as params}]
(println (blue "compiling tags page")) (println (blue "compiling tags page"))
(spit (str public blog-prefix "/tags.html") (create-file (path "/" blog-prefix "tags.html")
(render-file "/html/tags.html" (render-file "/html/tags.html"
(merge params (merge params
{:active-page "tags" {:active-page "tags"
:uri (str blog-prefix "/tags.html")})))) :uri (path "/" blog-prefix "tags.html")}))))
(defn content-until-more-marker (defn content-until-more-marker
[^String content] [^String content]
@ -278,8 +277,8 @@
[previews blog-prefix] [previews blog-prefix]
(mapv (fn [[prev target next]] (mapv (fn [[prev target next]]
(merge target (merge target
{:prev (if prev (str blog-prefix "/p/" (:index prev) ".html") nil) {:prev (if prev (path "/" blog-prefix "p" (str (:index prev) ".html")) nil)
:next (if next (str blog-prefix "/p/" (:index next) ".html") nil)})) :next (if next (path "/" blog-prefix "p" (str (:index next) ".html")) nil)}))
(partition 3 1 (flatten [nil previews nil])))) (partition 3 1 (flatten [nil previews nil]))))
(defn compile-preview-pages (defn compile-preview-pages
@ -288,14 +287,14 @@
(when-not (empty? posts) (when-not (empty? posts)
(let [previews (-> (create-previews posts-per-page blocks-per-preview posts) (let [previews (-> (create-previews posts-per-page blocks-per-preview posts)
(create-preview-links blog-prefix)) (create-preview-links blog-prefix))
previews (if (> (count previews) 1) (assoc-in previews [1 :prev] (str blog-prefix "/index.html")) previews)] previews (if (> (count previews) 1) (assoc-in previews [1 :prev] (path "/" blog-prefix "index.html")) previews)]
(create-folder (str blog-prefix "/p/")) (create-folder (path "/" blog-prefix "p"))
(doseq [{:keys [index posts prev next]} previews] (doseq [{:keys [index posts prev next]} previews]
(spit (if (= 1 index) (str public blog-prefix "/index.html") (str public blog-prefix "/p/" index ".html")) (create-file (if (= 1 index) (path "/" blog-prefix "index.html") (path "/" blog-prefix "p" (str index ".html")))
(render-file "/html/previews.html" (render-file "/html/previews.html"
(merge params (merge params
{:active-page "preview" {:active-page "preview"
:servlet-context (if (= 1 index) "" "../") :servlet-context (path "/" blog-prefix "/")
:posts posts :posts posts
:prev-uri prev :prev-uri prev
:next-uri next}))))))) :next-uri next})))))))
@ -304,26 +303,26 @@
"Compiles the index page into html and spits it out into the public folder" "Compiles the index page into html and spits it out into the public folder"
[{:keys [blog-prefix disqus?] :as params}] [{:keys [blog-prefix disqus?] :as params}]
(println (blue "compiling index")) (println (blue "compiling index"))
(spit (str public blog-prefix "/index.html") (create-file (path "/" blog-prefix "index.html")
(render-file "/html/home.html" (render-file "/html/home.html"
(merge params (merge params
{:active-page "home" {:active-page "home"
:home true :home true
:disqus? disqus? :disqus? disqus?
:post (get-in params [:latest-posts 0]) :post (get-in params [:latest-posts 0])
:uri (str blog-prefix "/index.html")})))) :uri (path "/" blog-prefix "index.html")}))))
(defn compile-archives (defn compile-archives
"Compiles the archives page into html and spits it out into the public folder" "Compiles the archives page into html and spits it out into the public folder"
[{:keys [blog-prefix] :as params} posts] [{:keys [blog-prefix] :as params} posts]
(println (blue "compiling archives")) (println (blue "compiling archives"))
(spit (str public blog-prefix "/archives.html") (create-file (path "/" blog-prefix "archives.html")
(render-file "/html/archives.html" (render-file "/html/archives.html"
(merge params (merge params
{:active-page "archives" {:active-page "archives"
:archives true :archives true
:groups (group-for-archive posts) :groups (group-for-archive posts)
:uri (str blog-prefix "/archives.html")})))) :uri (path "/" blog-prefix "/archives.html")}))))
(defn tag-posts (defn tag-posts
"Converts the tags in each post into links" "Converts the tags in each post into links"
@ -332,11 +331,11 @@
(defn copy-resources-from-markup-folders (defn copy-resources-from-markup-folders
"Copy resources from markup folders" "Copy resources from markup folders"
[config] [{:keys [post-root page-root] :as config}]
(copy-resources (copy-resources
(merge config (merge config
{:resources (for [mu (m/markups) {:resources (for [mu (m/markups)
t ["posts" "pages"]] (str (m/dir mu) "/" t)) t (distinct [post-root page-root])] (str (m/dir mu) "/" t))
:ignored-files (map #(re-pattern-from-ext (m/ext %)) (m/markups))}))) :ignored-files (map #(re-pattern-from-ext (m/ext %)) (m/markups))})))
(defn read-config (defn read-config
@ -348,6 +347,9 @@
slurp slurp
read-string read-string
(update-in [:blog-prefix] (fnil str "")) (update-in [:blog-prefix] (fnil str ""))
(update-in [:page-root] (fnil str ""))
(update-in [:post-root] (fnil str ""))
(update-in [:tag-root] (fnil str ""))
(update-in [:rss-name] (fnil str "rss.xml")) (update-in [:rss-name] (fnil str "rss.xml"))
(update-in [:rss-filters] (fnil seq [])) (update-in [:rss-filters] (fnil seq []))
(update-in [:sass-src] (fnil str "css")) (update-in [:sass-src] (fnil str "css"))
@ -357,9 +359,9 @@
(update-in [:ignored-files] (fnil seq [#"^\.#.*" #".*\.swp$"])))] (update-in [:ignored-files] (fnil seq [#"^\.#.*" #".*\.swp$"])))]
(merge (merge
config config
{:page-root (root-path :page-root config) {:page-root-uri (root-uri :page-root-uri config)
:post-root (root-path :post-root config) :post-root-uri (root-uri :post-root-uri config)
:tag-root (root-path :tag-root config)})) :tag-root-uri (root-uri :tag-root-uri config)}))
(catch Exception _ (catch Exception _
(throw (IllegalArgumentException. "Failed to parse config.edn"))))) (throw (IllegalArgumentException. "Failed to parse config.edn")))))
@ -380,10 +382,10 @@
:latest-posts (->> posts (take recent-posts) vec) :latest-posts (->> posts (take recent-posts) vec)
:navbar-pages navbar-pages :navbar-pages navbar-pages
:sidebar-pages sidebar-pages :sidebar-pages sidebar-pages
:archives-uri (str blog-prefix "/archives.html") :archives-uri (path "/" blog-prefix "archives.html")
:index-uri (str blog-prefix "/index.html") :index-uri (path "/" blog-prefix "index.html")
:tags-uri (str blog-prefix "/tags.html") :tags-uri (path "/" blog-prefix "tags.html")
:rss-uri (str blog-prefix "/" rss-name) :rss-uri (path "/" blog-prefix rss-name)
:site-url (if (.endsWith site-url "/") (.substring site-url 0 (dec (count site-url))) site-url) :site-url (if (.endsWith site-url "/") (.substring site-url 0 (dec (count site-url))) site-url)
:theme-path (str "file:resources/templates/themes/" (:theme config))})] :theme-path (str "file:resources/templates/themes/" (:theme config))})]
@ -403,15 +405,15 @@
(compile-index params)) (compile-index params))
(compile-archives params posts) (compile-archives params posts)
(println (blue "generating site map")) (println (blue "generating site map"))
(spit (str public blog-prefix "/sitemap.xml") (sitemap/generate site-url ignored-files)) (create-file (path "/" blog-prefix "sitemap.xml") (sitemap/generate site-url ignored-files))
(println (blue "generating main rss")) (println (blue "generating main rss"))
(spit (str public blog-prefix "/" rss-name) (rss/make-channel config posts)) (create-file (path "/" blog-prefix rss-name) (rss/make-channel config posts))
(println (blue "generating filtered rss")) (println (blue "generating filtered rss"))
(rss/make-filtered-channels public config posts-by-tag) (rss/make-filtered-channels config posts-by-tag)
(println (blue "compiling sass")) (println (blue "compiling sass"))
(sass/compile-sass->css! (sass/compile-sass->css!
{:src-sass sass-src {:src-sass sass-src
:dest-sass (str "../public" blog-prefix "/" sass-dest) :dest-sass (path ".." "public" blog-prefix sass-dest)
:ignored-files ignored-files :ignored-files ignored-files
:base-dir "resources/templates/"}))) :base-dir "resources/templates/"})))

View file

@ -1,9 +1,18 @@
(ns cryogen-core.io (ns cryogen-core.io
(:require [clojure.java.io :as io] (:require [clojure.java.io :as io]
[clojure.string :as s]
[me.raynes.fs :as fs])) [me.raynes.fs :as fs]))
(def public "resources/public") (def public "resources/public")
(defn path
"Creates path from given parts, ignore empty elements"
[& path-parts]
(->> path-parts
(remove s/blank?)
(s/join "/")
(#(s/replace % #"/+" "/"))))
(defn re-filter [bool-fn re & other-res] (defn re-filter [bool-fn re & other-res]
(let [res (conj other-res re)] (let [res (conj other-res re)]
(reify java.io.FilenameFilter (reify java.io.FilenameFilter
@ -40,6 +49,9 @@
(when-not (.exists loc) (when-not (.exists loc)
(.mkdirs loc)))) (.mkdirs loc))))
(defn create-file [file data]
(spit (str public file) data))
(defn wipe-public-folder [keep-files] (defn wipe-public-folder [keep-files]
(let [filenamefilter (reify java.io.FilenameFilter (accept [this _ filename] (not (some #{filename} keep-files))))] (let [filenamefilter (reify java.io.FilenameFilter (accept [this _ filename] (not (some #{filename} keep-files))))]
(doseq [path (.listFiles (io/file public) filenamefilter)] (doseq [path (.listFiles (io/file public) filenamefilter)]
@ -58,7 +70,7 @@
(defn copy-resources [{:keys [blog-prefix resources ignored-files]}] (defn copy-resources [{:keys [blog-prefix resources ignored-files]}]
(doseq [resource resources] (doseq [resource resources]
(let [src (str "resources/templates/" resource) (let [src (str "resources/templates/" resource)
target (str public blog-prefix "/" (fs/base-name resource))] target (path public blog-prefix (fs/base-name resource))]
(cond (cond
(not (.exists (io/file src))) (not (.exists (io/file src)))
(throw (IllegalArgumentException. (str "resource " src " not found"))) (throw (IllegalArgumentException. (str "resource " src " not found")))

View file

@ -1,4 +1,5 @@
(ns cryogen-core.markup (ns cryogen-core.markup
(:require [clojure.string :as s])
(:import java.util.Collections)) (:import java.util.Collections))
(defonce markup-registry (atom [])) (defonce markup-registry (atom []))
@ -16,7 +17,8 @@
ex. <img src='/img/cryogen.png'/> becomes <img src='/blog/img/cryogen.png'/>" ex. <img src='/img/cryogen.png'/> becomes <img src='/blog/img/cryogen.png'/>"
[blog-prefix text] [blog-prefix text]
(clojure.string/replace text #"href=.?/|src=.?/" #(str (subs % 0 (dec (count %))) blog-prefix "/"))) (if-not (s/blank? blog-prefix)
(clojure.string/replace text #"href=.?/|src=.?/" #(str (subs % 0 (dec (count %))) "/" blog-prefix "/"))))
(defn markups (defn markups
"Return a vector of Markup implementations. This is the primary entry point "Return a vector of Markup implementations. This is the primary entry point

View file

@ -1,6 +1,7 @@
(ns cryogen-core.rss (ns cryogen-core.rss
(:require [clj-rss.core :as rss] (:require [clj-rss.core :as rss]
[text-decoration.core :refer :all]) [text-decoration.core :refer :all]
[cryogen-core.io :refer [create-file path]])
(:import java.util.Date)) (:import java.util.Date))
@ -27,8 +28,8 @@
:lastBuildDate (Date.)}) :lastBuildDate (Date.)})
(posts-to-items (:site-url config) posts))) (posts-to-items (:site-url config) posts)))
(defn make-filtered-channels [public {:keys [rss-filters blog-prefix] :as config} posts-by-tag] (defn make-filtered-channels [{:keys [rss-filters blog-prefix] :as config} posts-by-tag]
(doseq [filter rss-filters] (doseq [filter rss-filters]
(let [uri (str public blog-prefix "/" (name filter) ".xml")] (let [uri (path "/" blog-prefix (str (name filter) ".xml"))]
(println "\t-->" (cyan uri)) (println "\t-->" (cyan uri))
(spit uri (make-channel config (get posts-by-tag filter)))))) (create-file uri (make-channel config (get posts-by-tag filter))))))