meissa/cryogen-core
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge pull request #1 from cryogen-project/master

Browse source 
Update cryogen-core to latest version
This commit is contained in:
Torsten Uhlmann 2016-12-14 21:00:26 +01:00 committed by GitHub
commit ca2513f954
14 changed files with 628 additions and 201 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
project.clj
View file

@ -1,16 +1,17 @@
(defproject cryogen-core "0.1.24" (defproject cryogen-core "0.1.43"
:description "Cryogen's compiler" :description "Cryogen's compiler"
:url "https://github.com/cryogen-project/cryogen-core" :url "https://github.com/cryogen-project/cryogen-core"
:license {:name "Eclipse Public License" :license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"} :url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.7.0"] :dependencies [[org.clojure/clojure "1.8.0"]
[clj-rss "0.1.9"] [clj-rss "0.2.3"]
[me.raynes/fs "1.4.6"] [me.raynes/fs "1.4.6"]
[crouton "0.1.2"] [crouton "0.1.2"]
[cheshire "5.5.0"] [cheshire "5.6.3"]
[clj-text-decoration "0.0.3"] [clj-text-decoration "0.0.3"]
[io.aviso/pretty "0.1.18"] [io.aviso/pretty "0.1.33"]
[hiccup "1.0.5"] [hiccup "1.0.5"]
[selmer "0.8.5"] [selmer "1.10.1"]
[pandect "0.5.2"] [pandect "0.6.1"]
[hawk "0.2.11"]
[clj-tagsoup "0.3.0" :exclusions [org.clojure/clojure]]]) [clj-tagsoup "0.3.0" :exclusions [org.clojure/clojure]]])

0
resources/.gitkeep Normal file
View file

274
src/cryogen_core/compiler.clj
View file

@ -11,51 +11,65 @@
[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-recursive 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))
(cache-off!) (cache-off!)
(def public "resources/public") (defn root-uri
"Creates the uri for posts 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"
[ext] [ext]
(re-pattern (str (s/replace ext "." "\\.") "$"))) (re-pattern (str (s/replace ext "." "\\.") "$")))
(defn find-entries
"Returns a list of files under the templates directory according to the
implemented Markup protocol and specified root directory. It defaults to
looking under the implemented protocol's subdirectory, but fallsback to look
at the templates directory."
[root mu ignored-files]
(let [assets (find-assets (path "templates" (m/dir mu) root)
(m/ext mu)
ignored-files)]
(if (seq assets)
assets
(find-assets (path "templates" root)
(m/ext mu)
ignored-files))))
(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."
[{: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-entries post-root 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."
[{: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-entries page-root 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"
[file-name date-fmt] [^String file-name date-fmt]
(let [fmt (java.text.SimpleDateFormat. date-fmt)] (let [fmt (java.text.SimpleDateFormat. date-fmt)]
(.parse fmt (.substring file-name 0 10)))) (.parse fmt (.substring file-name 0 10))))
(defn post-uri
"Creates a post uri from the post file name"
[file-name {:keys [blog-prefix post-root]} mu]
(str blog-prefix post-root (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 URI from file name. `uri-type` is any of the uri types specified in config, e.g., `:post-root-uri`."
[page-name {:keys [blog-prefix page-root]} mu] ([file-name params]
(str blog-prefix page-root (s/replace page-name (re-pattern-from-ext (m/ext mu)) ".html"))) (page-uri file-name nil params))
([file-name uri-type {:keys [blog-prefix clean-urls?] :as params}]
(let [page-uri (params uri-type)
uri-end (if clean-urls? (s/replace file-name #"(index)?\.html" "/") file-name)]
(path "/" blog-prefix page-uri uri-end))))
(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"
@ -68,9 +82,10 @@
(defn page-content (defn page-content
"Returns a map with the given page's file-name, metadata and content parsed from "Returns a map with the given page's file-name, metadata and content parsed from
the file with the given markup." the file with the given markup."
[page config markup] [^java.io.File page config markup]
(with-open [rdr (java.io.PushbackReader. (reader page))] (with-open [rdr (java.io.PushbackReader. (reader page))]
(let [page-name (.getName page) (let [re-root (re-pattern (str "^.*?(" (:page-root config) "|" (:post-root config) ")/"))
page-name (s/replace (str page) re-root "")
file-name (s/replace page-name (re-pattern-from-ext (m/ext markup)) ".html") file-name (s/replace page-name (re-pattern-from-ext (m/ext markup)) ".html")
page-meta (read-page-meta page-name rdr) page-meta (read-page-meta page-name rdr)
content ((m/render-fn markup) rdr config)] content ((m/render-fn markup) rdr config)]
@ -85,7 +100,8 @@
(update-in page-meta [:layout] #(str (name %) ".html")) (update-in page-meta [:layout] #(str (name %) ".html"))
{:file-name file-name {:file-name file-name
:content content :content content
:toc (if (:toc page-meta) (generate-toc content))})) :toc (if-let [toc (:toc page-meta)]
(generate-toc content :list-type toc))}))
(defn parse-page (defn parse-page
"Parses a page/post and returns a map of the content, uri, date etc." "Parses a page/post and returns a map of the content, uri, date etc."
@ -93,7 +109,7 @@
(let [{:keys [file-name page-meta content]} (page-content page config markup)] (let [{:keys [file-name page-meta content]} (page-content page config markup)]
(merge (merge
(merge-meta-and-content file-name page-meta content) (merge-meta-and-content file-name page-meta content)
{:uri (page-uri file-name config markup) {:uri (page-uri file-name :page-root-uri config)
:page-index (:page-index page-meta)}))) :page-index (:page-index page-meta)})))
(defn parse-post (defn parse-post
@ -102,13 +118,15 @@
(let [{:keys [file-name page-meta content]} (page-content page config markup)] (let [{:keys [file-name page-meta content]} (page-content page config markup)]
(merge (merge
(merge-meta-and-content file-name page-meta content) (merge-meta-and-content file-name page-meta content)
(let [date (parse-post-date file-name (:post-date-format config)) (let [date (if (:date page-meta)
archive-fmt (java.text.SimpleDateFormat. "yyyy MMMM" (java.util.Locale. "en")) (.parse (java.text.SimpleDateFormat. (:post-date-format config)) (:date page-meta))
(parse-post-date file-name (:post-date-format config)))
archive-fmt (java.text.SimpleDateFormat. (get config :archive-group-format "yyyy MMMM") (Locale/getDefault))
formatted-group (.format archive-fmt date)] formatted-group (.format archive-fmt date)]
{:date date {:date date
:formatted-archive-group formatted-group :formatted-archive-group formatted-group
:parsed-archive-group (.parse archive-fmt formatted-group) :parsed-archive-group (.parse archive-fmt formatted-group)
:uri (post-uri file-name config markup) :uri (page-uri file-name :post-root-uri config)
:tags (set (:tags page-meta))})))) :tags (set (:tags page-meta))}))))
(defn read-posts (defn read-posts
@ -119,7 +137,8 @@
(fn [mu] (fn [mu]
(->> (->>
(find-posts config mu) (find-posts config mu)
(map #(parse-post % config mu)))) (pmap #(parse-post % config mu))
(remove #(= (:draft? %) true))))
(m/markups)) (m/markups))
(sort-by :date) (sort-by :date)
reverse)) reverse))
@ -140,7 +159,7 @@
"Adds the uri and title of a post to the list of posts under each of its tags" "Adds the uri and title of a post to the list of posts under each of its tags"
[tags post] [tags post]
(reduce (fn [tags tag] (reduce (fn [tags tag]
(update-in tags [tag] (fnil conj []) (select-keys post [:uri :title :content :date]))) (update-in tags [tag] (fnil conj []) (select-keys post [:uri :title :content :date :enclosure])))
tags (:tags post))) tags (:tags post)))
(defn group-by-tags (defn group-by-tags
@ -161,11 +180,22 @@
(sort-by :parsed-group) (sort-by :parsed-group)
reverse)) reverse))
(defn group-for-author
"Groups the posts by author. If no post author if found defaults `default-author`."
[posts default-author]
(->> posts
(map #(select-keys % [:title :uri :date :formatted-archive-group :parsed-archive-group :author]))
(map #(update % :author (fn [author] (or author default-author))))
(group-by :author)
(map (fn [[author posts]]
{:author author
:posts posts}))))
(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] [config tag]
{:name (name tag) {:name (name tag)
:uri (str blog-prefix tag-root (name tag) ".html")}) :uri (page-uri (str (name tag) ".html") :tag-root-uri config)})
(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
@ -184,66 +214,92 @@
sidebar-pages false} (group-by #(boolean (:navbar? %)) pages)] sidebar-pages false} (group-by #(boolean (:navbar? %)) pages)]
(map (partial sort-by :page-index) [navbar-pages sidebar-pages]))) (map (partial sort-by :page-index) [navbar-pages sidebar-pages])))
(defn write-html
"When `clean-urls?` is set, appends `/index.html` before spit; otherwise just spits."
[file-uri {:keys [clean-urls?]} data]
(if clean-urls?
(create-file-recursive (path file-uri "index.html") data)
(create-file file-uri data)))
(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) (write-html uri
params
(render-file (str "/html/" (:layout page)) (render-file (str "/html/" (:layout page))
(merge params (merge params
{:servlet-context "../" {:active-page "pages"
: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)) (write-html (:uri post)
params
(render-file (str "/html/" (:layout post)) (render-file (str "/html/" (:layout post))
(merge params (merge params
{:servlet-context "../" {:active-page "posts"
: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) (write-html uri
params
(render-file "/html/tag.html" (render-file "/html/tag.html"
(merge params (merge params
{:servlet-context "../" {:active-page "tags"
: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") (let [uri (page-uri "tags.html" params)]
(write-html uri
params
(render-file "/html/tags.html" (render-file "/html/tags.html"
(merge params (merge params
{:uri (str blog-prefix "/tags.html")})))) {:active-page "tags"
:servlet-context (path "/" blog-prefix "/")
:uri uri})))))
(defn content-until-more-marker
[^String content]
(let [index (.indexOf content "<!--more-->")]
(if (pos? index)
(let [s (subs content 0 index)]
(->> ((tagsoup/parse-string s) 2)
(drop 2)
hiccup/html)))))
(defn create-preview (defn create-preview
"Creates a single post preview" "Creates a single post preview"
[blocks-per-preview post] [blocks-per-preview post]
(merge (select-keys post [:title :author :date :uri]) (merge post
{:content (or (re-find #".+?(?=<!--more-->)" (:content post)) {:content (or (content-until-more-marker (:content post))
(->> ((tagsoup/parse-string (:content post)) 2) (->> ((tagsoup/parse-string (:content post)) 2)
(drop 2) (drop 2)
(take blocks-per-preview) (take blocks-per-preview)
@ -253,18 +309,18 @@
"Returns a sequence of vectors, each containing a set of post previews" "Returns a sequence of vectors, each containing a set of post previews"
[posts-per-page blocks-per-preview posts] [posts-per-page blocks-per-preview posts]
(->> posts (->> posts
(reduce (fn [v post] (conj v (create-preview blocks-per-preview post))) []) (map #(create-preview blocks-per-preview %))
(partition-all posts-per-page) (partition-all posts-per-page)
(map-indexed (fn [i v] {:index (inc i) :posts v})))) (map-indexed (fn [i v] {:index (inc i) :posts v}))))
(defn create-preview-links (defn create-preview-links
"Turn each vector of previews into a map with :prev and :next keys that contain the uri of the "Turn each vector of previews into a map with :prev and :next keys that contain the uri of the
prev/next preview page" prev/next preview page"
[previews blog-prefix] [previews params]
(mapv (fn [[prev target next]] (mapv (fn [[prev target next]]
(merge target (merge target
{:prev (if prev (str blog-prefix "/p/" (:index prev)) nil) {:prev (if prev (page-uri (path "p" (str (:index prev) ".html")) params) nil)
:next (if next (str blog-prefix "/p/" (:index next)) nil)})) :next (if next (page-uri (path "p" (str (:index next) ".html")) params) nil)}))
(partition 3 1 (flatten [nil previews nil])))) (partition 3 1 (flatten [nil previews nil]))))
(defn compile-preview-pages (defn compile-preview-pages
@ -272,54 +328,95 @@
[{:keys [blog-prefix posts-per-page blocks-per-preview] :as params} posts] [{:keys [blog-prefix posts-per-page blocks-per-preview] :as params} posts]
(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 params))
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] (page-uri "index.html" params)) 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)) :let [index-page? (= 1 index)]]
(write-html (if index-page? (page-uri "index.html" params) (page-uri (path "p" (str index ".html")) params))
params
(render-file "/html/previews.html" (render-file "/html/previews.html"
(merge params (merge params
{:servlet-context (if (= 1 index) "" "../") {:active-page "preview"
:home (when index-page? true)
:servlet-context (path "/" blog-prefix "/")
:posts posts :posts posts
:prev-uri prev :prev-uri prev
:next-uri next}))))))) :next-uri next})))))))
(defn compile-index (defn compile-index
"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 [disqus?] :as params}]
(println (blue "compiling index")) (println (blue "compiling index"))
(spit (str public blog-prefix "/index.html") (let [uri (page-uri "index.html" params)]
(write-html uri
params
(render-file "/html/home.html" (render-file "/html/home.html"
(merge params (merge params
{:home true {:active-page "home"
: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 uri})))))
(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") (let [uri (page-uri "archives.html" params)]
(write-html uri
params
(render-file "/html/archives.html" (render-file "/html/archives.html"
(merge params (merge params
{:archives true {:active-page "archives"
:archives true
:groups (group-for-archive posts) :groups (group-for-archive posts)
:uri (str blog-prefix "/archives.html")})))) :servlet-context (path "/" blog-prefix "/")
:uri uri})))))
(defn compile-authors
"For each author, creates a page with filtered posts."
[{:keys [blog-prefix author-root-uri author] :as params} posts]
(println (blue "compiling authors"))
(create-folder (path "/" blog-prefix author-root-uri))
;; if the post author is empty defaults to config's :author
(doseq [{:keys [author posts]} (group-for-author posts author)]
(let [uri (page-uri (str author ".html") :author-root-uri params)]
(println "\t-->" (cyan uri))
(write-html uri
params
(render-file "/html/author.html"
(merge params
{:author author
:groups (group-for-archive posts)
:servlet-context (path "/" blog-prefix "/")
:uri uri}))))))
(defn tag-posts (defn tag-posts
"Converts the tags in each post into links" "Converts the tags in each post into links"
[posts config] [posts config]
(map #(update-in % [:tags] (partial map (partial tag-info config))) posts)) (map #(update-in % [:tags] (partial map (partial tag-info config))) posts))
(defn- template-dir?
"Checks that the dir exists in the templates directory."
[dir]
(.isDirectory (file (str "resources/templates/" dir))))
(defn- markup-entries [post-root page-root]
(let [entries (for [mu (m/markups)
t (distinct [post-root page-root])]
[(str (m/dir mu) "/" t) t])]
(apply concat entries)))
(defn copy-resources-from-markup-folders (defn copy-resources-from-markup-folders
"Copy resources from markup folders" "Copy resources from markup folders. This does not copy the markup entries."
[config] [{:keys [post-root page-root] :as config}]
(let [folders (->> (markup-entries post-root page-root)
(filter template-dir?))]
(copy-resources (copy-resources
(merge config (merge config
{:resources (for [mu (m/markups) {:resources folders
t ["posts" "pages"]] (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
"Reads the config file" "Reads the config file"
@ -330,6 +427,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-uri] (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"))
@ -339,9 +439,8 @@
(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)}))
(catch Exception _ (catch Exception _
(throw (IllegalArgumentException. "Failed to parse config.edn"))))) (throw (IllegalArgumentException. "Failed to parse config.edn")))))
@ -349,22 +448,24 @@
"Generates all the html and copies over resources specified in the config" "Generates all the html and copies over resources specified in the config"
[] []
(println (green "compiling assets...")) (println (green "compiling assets..."))
(let [{:keys [site-url blog-prefix rss-name recent-posts sass-src sass-dest keep-files ignored-files previews?] :as config} (read-config) (let [{:keys [^String site-url blog-prefix rss-name recent-posts sass-src sass-dest keep-files ignored-files previews? author-root-uri] :as config} (read-config)
posts (add-prev-next (read-posts config)) posts (add-prev-next (read-posts config))
pages (add-prev-next (read-pages config)) pages (add-prev-next (read-pages config))
[navbar-pages sidebar-pages] (group-pages pages) [navbar-pages sidebar-pages] (group-pages pages)
posts-by-tag (group-by-tags posts) posts-by-tag (group-by-tags posts)
posts (tag-posts posts config) posts (tag-posts posts config)
params (merge config params (merge config
{:title (:site-title config) {:today (java.util.Date.)
:title (:site-title config)
:active-page "home"
:tags (map (partial tag-info config) (keys posts-by-tag)) :tags (map (partial tag-info config) (keys posts-by-tag))
: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 (page-uri "archives.html" config)
:index-uri (str blog-prefix "/index.html") :index-uri (page-uri "index.html" config)
:tags-uri (str blog-prefix "/tags.html") :tags-uri (page-uri "tags.html" config)
: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))})]
@ -383,16 +484,19 @@
(compile-preview-pages params posts) (compile-preview-pages params posts)
(compile-index params)) (compile-index params))
(compile-archives params posts) (compile-archives params posts)
(when author-root-uri
(println (blue "generating authors views"))
(compile-authors 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/"})))

2
src/cryogen_core/github.clj
View file

@ -25,7 +25,7 @@
(catch Exception e {:error (.getMessage e)}))] (catch Exception e {:error (.getMessage e)}))]
(when-not (:error git-resp) (when-not (:error git-resp)
(if-let [git-src (json/parse-string git-resp)] (if-let [git-src (json/parse-string git-resp)]
{:content (String. (Base64/decodeBase64 (get git-src "content")) "UTF-8") {:content (String. ^bytes (Base64/decodeBase64 ^String (get git-src "content")) "UTF-8")
:name (get git-src "name") :name (get git-src "name")
:uri (get (get git-src "_links") "html")})))) :uri (get (get git-src "_links") "html")}))))

30
src/cryogen_core/io.clj
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
@ -17,7 +26,7 @@
(-> resource io/resource io/file)) (-> resource io/resource io/file))
(defn ignore [ignored-files] (defn ignore [ignored-files]
(fn [file] (fn [^java.io.File file]
(let [name (.getName file) (let [name (.getName file)
matches (map #(re-find % name) ignored-files)] matches (map #(re-find % name) ignored-files)]
(not (some seq matches))))) (not (some seq matches)))))
@ -27,19 +36,26 @@
extension (ext) ignoring any files that match the given (ignored-files). extension (ext) ignoring any files that match the given (ignored-files).
First make sure that the root directory exists, if yes: process as normal; First make sure that the root directory exists, if yes: process as normal;
if no, return empty vector." if no, return empty vector."
[f ext ignored-files] [f ^String ext ignored-files]
(if-let [root (get-resource f)] (if-let [root (get-resource f)]
(->> (get-resource f) (->> (get-resource f)
file-seq file-seq
(filter (ignore ignored-files)) (filter (ignore ignored-files))
(filter (fn [file] (-> file .getName (.endsWith ext))))) (filter (fn [^java.io.File file] (-> file .getName (.endsWith ext)))))
[])) []))
(defn create-folder [folder] (defn create-folder [folder]
(let [loc (io/file (str public folder))] (let [loc (io/file (path public folder))]
(when-not (.exists loc) (when-not (.exists loc)
(.mkdirs loc)))) (.mkdirs loc))))
(defn create-file [file data]
(spit (path public file) data))
(defn create-file-recursive [file data]
(create-folder (.getParent (io/file file)))
(create-file 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)]
@ -47,9 +63,9 @@
(defn copy-dir [src target ignored-files] (defn copy-dir [src target ignored-files]
(fs/mkdirs target) (fs/mkdirs target)
(let [filename-filter (apply reject-re-filter ignored-files) (let [^java.io.FilenameFilter filename-filter (apply reject-re-filter ignored-files)
files (.listFiles (io/file src) filename-filter)] files (.listFiles (io/file src) filename-filter)]
(doseq [f files] (doseq [^java.io.File f files]
(let [out (io/file target (.getName f))] (let [out (io/file target (.getName f))]
(if (.isDirectory f) (if (.isDirectory f)
(copy-dir f out ignored-files) (copy-dir f out ignored-files)
@ -58,7 +74,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")))

16
src/cryogen_core/markup.clj
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 []))
@ -13,10 +14,11 @@
(defn rewrite-hrefs (defn rewrite-hrefs
"Injects the blog prefix in front of any local links "Injects the blog prefix in front of any local links
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 (s/blank? blog-prefix)
text
(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
@ -24,3 +26,13 @@
Markups." Markups."
[] []
@markup-registry) @markup-registry)
(defn register-markup
"Add a Markup implementation to the registry."
[mu]
(swap! markup-registry conj mu))
(defn clear-registry
"Reset the Markup registry."
[]
(reset! markup-registry []))

8
src/cryogen_core/plugins.clj
View file

@ -4,7 +4,7 @@
[clojure.string :as s] [clojure.string :as s]
[text-decoration.core :refer :all])) [text-decoration.core :refer :all]))
(defn load-plugin [url] (defn load-plugin [^java.net.URL url]
(let [{:keys [description init]} (edn/read-string (slurp url))] (let [{:keys [description init]} (edn/read-string (slurp url))]
(println (green (str "loading module: " description))) (println (green (str "loading module: " description)))
(-> init str (s/split #"/") first symbol require) (-> init str (s/split #"/") first symbol require)
@ -12,7 +12,5 @@
(defn load-plugins [] (defn load-plugins []
(let [plugins (.getResources (ClassLoader/getSystemClassLoader) "plugin.edn")] (let [plugins (.getResources (ClassLoader/getSystemClassLoader) "plugin.edn")]
(loop [] (doseq [plugin (enumeration-seq plugins)]
(load-plugin (.. plugins nextElement openStream)) (load-plugin (. ^java.net.URL plugin openStream)))))
(when (.hasMoreElements plugins)
(recur)))))

21
src/cryogen_core/rss.clj
View file

@ -1,18 +1,21 @@
(ns cryogen-core.rss (ns cryogen-core.rss
(:require [clj-rss.core :as rss] (:require [clj-rss.core :as rss]
[clojure.xml :refer [emit]] [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))
(defn posts-to-items [site-url posts] (defn posts-to-items [^String site-url posts]
(map (map
(fn [{:keys [uri title content date]}] (fn [{:keys [uri title content date enclosure author description]}]
(let [link (str (if (.endsWith site-url "/") (apply str (butlast site-url)) site-url) uri)] (let [link (str (if (.endsWith site-url "/") (apply str (butlast site-url)) site-url) uri)
enclosure (if (nil? enclosure) "" enclosure)]
{:guid link {:guid link
:link link :link link
:title title :title title
:description content :description (or description content)
:author author
:enclosure enclosure
:pubDate date})) :pubDate date}))
posts)) posts))
@ -26,8 +29,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))))))

20
src/cryogen_core/sass.clj
View file

@ -17,17 +17,20 @@
(defn compass-installed? (defn compass-installed?
"Checks for the installation of Compass." "Checks for the installation of Compass."
[] []
(= 0 (:exit (sh "compass" "--version")))) (try
(= 0 (:exit (sh "compass" "--version")))
(catch java.io.IOException _
false)))
(defn find-sass-files (defn find-sass-files
"Given a Diretory, gets files, Filtered to those having scss or sass "Given a Diretory, gets files, Filtered to those having scss or sass
extention. Ignores files matching any ignored regexps." extention. Ignores files matching any ignored regexps."
[base-dir dir ignored-files] [base-dir dir ignored-files]
(let [filename-filter (match-re-filter #"(?i:s[ca]ss$)")] (let [^java.io.FilenameFilter filename-filter (match-re-filter #"(?i:s[ca]ss$)")]
(->> (.listFiles (io/file base-dir dir) filename-filter) (->> (.listFiles (io/file base-dir dir) filename-filter)
(filter #(not (.isDirectory %))) (filter #(not (.isDirectory ^java.io.File %)))
(filter (ignore ignored-files)) (filter (ignore ignored-files))
(map #(.getName %))))) (map #(.getName ^java.io.File %)))))
(defn compile-sass-file! (defn compile-sass-file!
"Given a sass file which might be in src-sass directory, "Given a sass file which might be in src-sass directory,
@ -37,10 +40,9 @@
dest-sass dest-sass
base-dir]}] base-dir]}]
(shell/with-sh-dir base-dir (shell/with-sh-dir base-dir
(sh "sass" (if (compass-installed?)
"--update" (sh "sass" "--compass" "--update" (str src-sass ":" dest-sass))
(when (compass-installed?) "--compass") (sh "sass" "--update" (str src-sass ":" dest-sass)))))
(str src-sass ":" dest-sass))))
(defn compile-sass->css! (defn compile-sass->css!
"Given a directory src-sass, looks for all sass files and compiles them into "Given a directory src-sass, looks for all sass files and compiles them into
@ -55,7 +57,7 @@ the command. Shows you any problems it comes across when compiling. "
;; I found sass files, ;; I found sass files,
;; If sass is installed ;; If sass is installed
(do (do
(println "Compiling Sass Files:" src-sass dest-sass) (println "\t" (cyan src-sass) "-->" (cyan dest-sass))
(let [result (compile-sass-file! opts)] (let [result (compile-sass-file! opts)]
(if (zero? (:exit result)) (if (zero? (:exit result))
;; no problems in sass compilation ;; no problems in sass compilation

4
src/cryogen_core/sitemap.clj
View file

@ -10,7 +10,7 @@
(let [fmt (java.text.SimpleDateFormat. "yyyy-MM-dd")] (let [fmt (java.text.SimpleDateFormat. "yyyy-MM-dd")]
(.format fmt date))) (.format fmt date)))
(defn loc [f] (defn loc [^java.io.File f]
(-> f (.getAbsolutePath) (.split "resources/public/") second)) (-> f (.getAbsolutePath) (.split "resources/public/") second))
(defn generate [site-url ignored-files] (defn generate [site-url ignored-files]
@ -19,7 +19,7 @@
{:tag :urlset {:tag :urlset
:attrs {:xmlns "http://www.sitemaps.org/schemas/sitemap/0.9"} :attrs {:xmlns "http://www.sitemaps.org/schemas/sitemap/0.9"}
:content :content
(for [f (find-assets "public" ".html" ignored-files)] (for [^java.io.File f (find-assets "public" ".html" ignored-files)]
{:tag :url {:tag :url
:content :content
[{:tag :loc [{:tag :loc

109
src/cryogen_core/toc.clj
View file

@ -1,9 +1,11 @@
(ns cryogen-core.toc (ns cryogen-core.toc
(:require [crouton.html :as html] (:require [clojure.zip :as z]
[crouton.html :as html]
[hiccup.core :as hiccup])) [hiccup.core :as hiccup]))
(def _h [:h1 :h2 :h3 :h4 :h5 :h6]) (def _h [:h1 :h2 :h3 :h4 :h5 :h6])
(defn- compare_index [i1 i2] (- (.indexOf _h i2) (.indexOf _h i1)))
(defn- compare-index [i1 i2] (- (.indexOf ^clojure.lang.APersistentVector _h i2) (.indexOf ^clojure.lang.APersistentVector _h i1)))
(defn- get-headings (defn- get-headings
"Turn a body of html content into a vector of elements whose tags are "Turn a body of html content into a vector of elements whose tags are
@ -18,35 +20,96 @@
headings))) headings)))
[] content)) [] content))
(defn make-links (defn- zip-toc-tree-to-insertion-point
"Create a table of contents from the given headings. This function will look "Given a toc-tree zipper and a header level, navigate
for either: the zipper to the appropriate parent of the level for that header
(1) headings with a child anchor with a non-nil name attribute, e.g. to be inserted and return the zipper."
<h1><a name=\"reference\">Reference Title</a></h1> [toctree h-tag]
or (if-let [current-tag (-> toctree first :value :tag)]
(2) headings with an id attribute, e.g. <h1 id=\"reference\">Reference Title</h1> (let [direction (compare-index h-tag current-tag)]
In both cases above, the anchor reference becomes \"#reference\" and the (cond (zero? direction) (z/up toctree) ; Tag belongs at current level
anchor text is \"Reference Title\"." (neg? direction) toctree ; Tag belongs below this level
(pos? direction) (recur (z/up toctree) h-tag))) ; Keep looking up
; This level is the root list, return it
toctree))
(defn- insert-toc-tree-entry
"Inserts a toc-tree (zipper) entry for the given entry at the appropriate place.
Obeys the invariant that the toc-tree (zipper) is always moved to the inserted loc."
[tree entry]
(let [{htag :tag} entry
tree (zip-toc-tree-to-insertion-point tree htag)]
(-> tree (z/append-child {:children [] :value entry}) z/down z/rightmost)))
(defn- build-toc-tree
"Given a sequence of header nodes, build a toc tree using zippers
and return it."
[headings] [headings]
(loop [items headings acc nil _last nil] (loop [zp (z/zipper
map?
:children
(fn [node children] (assoc node :children (apply vector children)))
{:value :root :children []})
items headings]
(if-let [{tag :tag {id :id} :attrs [{{name :name} :attrs} title :as htext] :content} (first items)] (if-let [{tag :tag {id :id} :attrs [{{name :name} :attrs} title :as htext] :content} (first items)]
(let [anchor (or id name)] (let [anchor (or id name)]
(if (nil? anchor) (if (nil? anchor)
(recur (rest items) acc nil) (recur zp (rest items))
(let [entry [:li [:a {:href (str "#" anchor)} (or title (first htext))]] (recur (insert-toc-tree-entry zp
jump (compare_index _last tag)] {:tag tag
(cond (> jump 0) (recur (rest items) (str acc "<ol>" (hiccup/html entry)) tag) :anchor anchor
(= jump 0) (recur (rest items) (str acc (hiccup/html entry)) tag) :text (or
(< jump 0) (recur (rest items) (str acc (apply str (repeat (* -1 jump) "</ol>")) (if (string? title) title (-> title :content first))
(hiccup/html entry)) tag))))) (first htext))})
(str acc "</ol>")))) (rest items))))
(z/root zp))))
(defn generate-toc [html]
(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
in an <li> tag."
[anchor text]
(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."
[toc-tree list-open & {:keys [outer-list?] :or {outer-list? true}}]
(let [{:keys [children], {:keys [anchor text]} :value} toc-tree
li (make-toc-entry anchor text)
first-list-open (if outer-list?
(keyword (str (name list-open) ".content"))
list-open)]
; Create hiccup sequence of :ol/:ul tag and sequence of :li tags
(if (seq children)
(let [sublist [first-list-open (map build-toc children
(repeat list-open)
(repeat :outer-list?)
(repeat false))]]
(if-let [li li] ; The root element has nothing so ignore it
(seq [li sublist]) ; Use seq to lazily concat the li with the sublists
sublist))
li))) ; Or just return the naked :li tag
(defn generate-toc
"Reads an HTML string and parses it for headers, then returns a list of links
to them.
Optionally, a map of :list-type can be provided with value :ul, :ol, or true.
:ol and true will result in an ordered list being generated for the table of
contents, while :ul will result in an unordered list. The default is an
ordered list."
[^String html & {:keys [list-type] :or {list-type :ol}}]
(let [list-type (if (true? list-type) :ol list-type)]
(-> html (-> html
(.getBytes "UTF-8") (.getBytes "UTF-8")
(java.io.ByteArrayInputStream.) (java.io.ByteArrayInputStream.)
(html/parse) (html/parse)
:content :content
(get-headings) (get-headings)
(make-links) (build-toc-tree)
(clojure.string/replace-first #"ol" "ol class=\"contents\""))) (build-toc list-type)
(hiccup/html))))

23
src/cryogen_core/watcher.clj
View file

@ -1,14 +1,15 @@
(ns cryogen-core.watcher (ns cryogen-core.watcher
(:require [clojure.java.io :refer [file]] (:require [clojure.java.io :refer [file]]
[cryogen-core.io :refer [ignore]] [cryogen-core.io :refer [ignore]]
[pandect.core :refer [md5]] [pandect.algo.md5 :refer [md5]]
[hawk.core :as hawk]
[clojure.set :as set])) [clojure.set :as set]))
(defn get-assets [path ignored-files] (defn get-assets [path ignored-files]
(->> path (->> path
file file
file-seq file-seq
(filter #(not (.isDirectory %))) (filter #(not (.isDirectory ^java.io.File %)))
(filter (ignore ignored-files)))) (filter (ignore ignored-files))))
(defn checksums [path ignored-files] (defn checksums [path ignored-files]
@ -21,15 +22,15 @@
(when-some [changes (set/difference new-sum-set old-sum-set)] (when-some [changes (set/difference new-sum-set old-sum-set)]
(vals (select-keys new-sums changes))))) (vals (select-keys new-sums changes)))))
(defn watch-assets [root ignored-files action] (defn watch-assets [sums root ignored-files action]
(loop [sums (checksums root ignored-files)]
(Thread/sleep 300)
(let [new-sums (checksums root ignored-files)] (let [new-sums (checksums root ignored-files)]
(when (find-changes sums new-sums) (when (find-changes @sums new-sums)
(action)) (action)
(recur new-sums)))) (reset! sums new-sums))))
(defn start-watcher! [root ignored-files action] (defn start-watcher! [root ignored-files action]
(doto (Thread. #(watch-assets root ignored-files action)) (let [sums (atom (checksums root ignored-files))
(.setDaemon true) handler (fn [ctx e]
(.start))) (watch-assets sums root ignored-files action))]
(hawk/watch! [{:paths [root]
:handler handler}])))

118
test/cryogen_core/compiler_test.clj Normal file
View file

@ -0,0 +1,118 @@
(ns cryogen-core.compiler-test
(:require [clojure.test :refer :all]
[cryogen-core.compiler :refer :all]
[cryogen-core.io :refer [path]]
[cryogen-core.markup :as m]
[me.raynes.fs :as fs])
(:import [java.io File]))
; Test that the content-until-more-marker return nil or correct html text.
(deftest test-content-until-more-marker
; text without more marker, return nil
(is (nil? (content-until-more-marker "<div id=\"post\">
<div class=\"post-content\">
this post does not have more marker
</div>
</div>")))
; text with more marker, return text before more marker with closing tags.
(is (= (content-until-more-marker "<div id='post'>
<div class='post-content'>
this post has more marker
<!--more-->
and more content.
</div>
</div>")
"<div id=\"post\"><div class=\"post-content\">
this post has more marker
</div></div>")))
(defn- markdown []
(reify m/Markup
(dir [this] "md")
(ext [this] ".md")))
(defn- asciidoc []
(reify m/Markup
(dir [this] "asc")
(ext [this] ".asc")))
(defn- create-entry [dir file]
(fs/mkdirs (File. dir))
(fs/create (File. (str dir File/separator file))))
(defn- reset-resources []
(fs/delete-dir "resources")
(create-entry "resources" ".gitkeep"))
(defn- check-for-pages [mu]
(find-pages {:page-root "pages"} mu))
(defn- check-for-posts [mu]
(find-posts {:post-root "posts"} mu))
(deftest test-find-entries
(reset-resources)
(let [mu (markdown)]
(testing "Finds no files"
(is (empty? (check-for-posts mu))
(is (empty? (check-for-pages mu))))
(let [dir->file
[[check-for-posts "resources/templates/md/posts" "post.md"]
[check-for-posts "resources/templates/posts" "post.md"]
[check-for-pages "resources/templates/md/pages" "page.md"]
[check-for-pages "resources/templates/pages" "page.md"]]]
(doseq [[check-fn dir file] dir->file]
(testing (str "Finds files in " dir)
(create-entry dir file)
(let [entries (check-fn mu)]
(is (= 1 (count entries)))
(is (= (.getAbsolutePath (File. (str dir File/separator file)))
(.getAbsolutePath (first entries)))))
(reset-resources)))))))
(defmacro with-markup [mu & body]
`(do
(m/register-markup ~mu)
(try
~@body
(finally
(m/clear-registry)))))
(defn- copy-and-check-markup-folders
"Create entries in the markup folders. If `with-dir?` is set to true, include
the Markup implementation's `dir` in the path. Check that the folders exist
in the output folder."
[[pages-root posts-root :as dirs] mu with-dir?]
(doseq [dir dirs]
(let [path (if with-dir?
(str (m/dir mu) "/" dir)
dir)]
(create-entry (str "resources/templates/" path)
(str "entry" (m/ext mu)))))
(with-markup mu
(copy-resources-from-markup-folders
{:post-root posts-root
:page-root pages-root
:blog-prefix "/blog"}))
(doseq [dir dirs]
(is (.isDirectory (File. (str "resources/public/blog/" dir))))))
(deftest test-copy-resources-from-markup-folders
(reset-resources)
(testing "No pages or posts nothing to copy"
(copy-resources-from-markup-folders
{:post-root "pages"
:page-root "posts"
:blog-prefix "/blog"})
(is (not (.isDirectory (File. (str "resources/public/blog/pages")))))
(is (not (.isDirectory (File. (str "resources/public/blog/posts"))))))
(reset-resources)
(doseq [mu [(markdown) (asciidoc)]]
(testing (str "Test copy from markup folders (" (m/dir mu) ")")
(let [dirs ["pages" "posts"]]
(copy-and-check-markup-folders dirs mu true)
(reset-resources)
(copy-and-check-markup-folders dirs mu false))))
(reset-resources))

109
test/cryogen_core/toc_test.clj Normal file
View file

@ -0,0 +1,109 @@
(ns cryogen-core.toc-test
(:require [clojure.test :refer :all]
[clojure.string :refer [join]]
[clojure.zip :as z]
[crouton.html :as html]
[hiccup.core :as hiccup]
[cryogen-core.toc :refer :all]))
; Reimport private functions
(def get-headings #'cryogen-core.toc/get-headings)
(def make-toc-entry #'cryogen-core.toc/make-toc-entry)
(def zip-toc-tree-to-insertion-point #'cryogen-core.toc/zip-toc-tree-to-insertion-point)
(def insert-toc-tree-entry #'cryogen-core.toc/insert-toc-tree-entry)
(def build-toc-tree #'cryogen-core.toc/build-toc-tree)
(def build-toc #'cryogen-core.toc/build-toc)
(defn parse-to-headings
[hiccup-seq]
(-> hiccup-seq hiccup/html html/parse-string :content get-headings))
; Test that the get-headings function properly filters non-headers
(deftest test-get-headings
(let [noisy-headers [:div [:h1 "First H1"]
[:p "Ignore..."]
[:h2 "First H2"]]]
(is (= (parse-to-headings noisy-headers)
[{:tag :h1 :attrs nil :content ["First H1"]}
{:tag :h2 :attrs nil :content ["First H2"]}]))))
; Test that the make-toc-entry ignores invalid input
(deftest test-make-toc-entry
(is (nil?
(make-toc-entry nil "Text")))
(is (nil?
(make-toc-entry "anchor" nil)))
(is (= [:li [:a {:href "#anchor"} "Text"]]
(make-toc-entry "anchor" "Text"))))
; Test that the built table of contents always treats later
; headers as being at the same level as earlier headers, even
; if the later headers are strictly greater in value.
; E.G.
; * h2
; * h3
; * h1
(deftest test-build-toc
(let [simplest-header [:div [:h2 [:a {:name "test"}] "Test"]]
no-headers [:div [:p "This is not a header"]]
closing-header-larger-than-opening-1
[:div [:h2 [:a {:name "starting_low"}]
"Starting Low"]
[:h1 [:a {:name "finishing_high"}]
"Finishing High"]]
closing-header-larger-than-opening-2
[:div [:h2 [:a {:name "starting_low"}]
"Starting Low"]
[:h4 [:a {:name "jumping_in"}]
"Jumping Right In"]
[:h3 [:a {:name "pulling_back"}]
"But then pull back"]
[:h2 [:a {:name "to_the_top"}]
"To the top"]]]
(is (= [:ol.content (seq [[:li [:a {:href "#test"} "Test"]]])]
(-> simplest-header parse-to-headings build-toc-tree
(build-toc :ol))))
(is (nil?
(-> no-headers parse-to-headings build-toc-tree
(build-toc :ol))))
(is (= [:ol.content (seq [[:li [:a {:href "#starting_low"} "Starting Low"]]
[:li [:a {:href "#finishing_high"} "Finishing High"]]])]
(-> closing-header-larger-than-opening-1
parse-to-headings
build-toc-tree
(build-toc :ol)))
"No outer header should be less indented than the first header tag.")
(is (= [:ul.content
(seq [
(seq [
[:li [:a {:href "#starting_low"} "Starting Low"]]
[:ul
(seq [
[:li [:a {:href "#jumping_in"} "Jumping Right In"]]
[:li [:a {:href "#pulling_back"} "But then pull back"]]
])
] ])
[:li [:a {:href "#to_the_top"} "To the top"]]
])]
(-> closing-header-larger-than-opening-2
parse-to-headings
build-toc-tree
(build-toc :ul)))
(join "" ["Inner headers can be more indented, "
"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>"
(generate-toc htmlString)))
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"
(generate-toc htmlString :list-type true)))
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"
(generate-toc htmlString :list-type :ol)))
(is (= "<ul class=\"content\"><li><a href=\"#test\">Test</a></li></ul>"
(generate-toc htmlString :list-type :ul)))))