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

Merge branch 'master' into development

Browse source 
Conflicts:
	project.clj
	src/cryogen_core/compiler.clj
This commit is contained in:
Michael Jerger 2017-02-08 09:21:08 +01:00
commit 2570dc4997
14 changed files with 500 additions and 317 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
project.clj
View file

@ -1,19 +1,19 @@
(defproject org.domaindrivenarchitecture/cryogen-core "0.1.48-SNAPSHOT" (defproject org.domaindrivenarchitecture/cryogen-core "0.1.53-SNAPSHOT"
: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.8.0"] :dependencies [[org.clojure/clojure "1.8.0"]
[camel-snake-kebab "0.4.0"]
[cheshire "5.7.0"]
[clj-rss "0.2.3"] [clj-rss "0.2.3"]
[me.raynes/fs "1.4.6"]
[crouton "0.1.2"]
[cheshire "5.6.3"]
[clj-text-decoration "0.0.3"] [clj-text-decoration "0.0.3"]
[io.aviso/pretty "0.1.33"] [enlive "1.1.6"]
[hiccup "1.0.5"]
[selmer "1.10.3"]
[pandect "0.6.1"]
[hawk "0.2.11"] [hawk "0.2.11"]
[clj-tagsoup "0.3.0" :exclusions [org.clojure/clojure]]] [hiccup "1.0.5"]
[io.aviso/pretty "0.1.33"]
[me.raynes/fs "1.4.6"]
[pandect "0.6.1"]
[selmer "1.10.6"]]
:deploy-repositories [["snapshots" :clojars] :deploy-repositories [["snapshots" :clojars]
["releases" :clojars]]) ["releases" :clojars]])

318
src/cryogen_core/compiler.clj
View file

@ -1,21 +1,20 @@
(ns cryogen-core.compiler (ns cryogen-core.compiler
(:require [selmer.parser :refer [cache-off! render-file]] (:require [clojure.java.io :as io]
[selmer.util :refer [set-custom-resource-path!]] [clojure.pprint :refer [pprint]]
[io.aviso.exception :refer [write-exception]]
[clojure.java.io :refer [copy file reader writer]]
[clojure.string :as s] [clojure.string :as s]
[io.aviso.exception :refer [write-exception]]
[net.cgrand.enlive-html :as enlive]
[selmer.parser :refer [cache-off! render-file]]
[selmer.util :refer [set-custom-resource-path!]]
[text-decoration.core :refer :all] [text-decoration.core :refer :all]
[pl.danieljanus.tagsoup :as tagsoup] [cryogen-core.io :as cryogen-io]
[hiccup.core :as hiccup] [cryogen-core.klipse :as klipse]
[cryogen-core.toc :refer [generate-toc]]
[cryogen-core.sass :as sass]
[cryogen-core.markup :as m] [cryogen-core.markup :as m]
[cryogen-core.io :refer
[get-resource find-assets create-folder create-file-recursive create-file wipe-public-folder
copy-resources copy-resources-from-theme path]]
[cryogen-core.sitemap :as sitemap]
[cryogen-core.rss :as rss] [cryogen-core.rss :as rss]
[clojure.inspector :as inspector]) [cryogen-core.sass :as sass]
[cryogen-core.sitemap :as sitemap]
[clojure.inspector :as inspector]
[cryogen-core.toc :as toc])
(:import java.util.Locale)) (:import java.util.Locale))
(cache-off!) (cache-off!)
@ -38,14 +37,16 @@
looking under the implemented protocol's subdirectory, but fallsback to look looking under the implemented protocol's subdirectory, but fallsback to look
at the templates directory." at the templates directory."
[root mu ignored-files] [root mu ignored-files]
(let [assets (find-assets (path "templates" (m/dir mu) root) (let [assets (cryogen-io/find-assets
(m/ext mu) (cryogen-io/path "templates" (m/dir mu) root)
ignored-files)] (m/ext mu)
ignored-files)]
(if (seq assets) (if (seq assets)
assets assets
(find-assets (path "templates" root) (cryogen-io/find-assets
(m/ext mu) (cryogen-io/path "templates" root)
ignored-files)))) (m/ext mu)
ignored-files))))
(defn find-posts (defn find-posts
"Returns a list of markdown files representing posts under the post root." "Returns a list of markdown files representing posts under the post root."
@ -68,9 +69,9 @@
([file-name params] ([file-name params]
(page-uri file-name nil params)) (page-uri file-name nil params))
([file-name uri-type {:keys [blog-prefix clean-urls?] :as params}] ([file-name uri-type {:keys [blog-prefix clean-urls?] :as params}]
(let [page-uri (params uri-type) (let [page-uri (get params uri-type)
uri-end (if clean-urls? (s/replace file-name #"(index)?\.html" "/") file-name)] uri-end (if clean-urls? (s/replace file-name #"(index)?\.html" "/") file-name)]
(path "/" blog-prefix page-uri uri-end)))) (cryogen-io/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"
@ -84,13 +85,13 @@
"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."
[^java.io.File page config markup] [^java.io.File page config markup]
(with-open [rdr (java.io.PushbackReader. (reader page))] (with-open [rdr (java.io.PushbackReader. (io/reader page))]
(let [re-root (re-pattern (str "^.*?(" (:page-root config) "|" (:post-root config) ")/")) (let [re-root (re-pattern (str "^.*?(" (:page-root config) "|" (:post-root config) ")/"))
page-fwd (s/replace (str page) "\\" "/") ;; make it work on Windows page-fwd (s/replace (str page) "\\" "/") ;; make it work on Windows
page-name (s/replace page-fwd re-root "") page-name (s/replace page-fwd 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)]
{:file-name file-name {:file-name file-name
:page-meta page-meta :page-meta page-meta
:content content}))) :content content})))
@ -103,7 +104,7 @@
{:file-name file-name {:file-name file-name
:content content :content content
:toc (if-let [toc (:toc page-meta)] :toc (if-let [toc (:toc page-meta)]
(generate-toc content :list-type toc))})) (toc/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."
@ -112,7 +113,8 @@
(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 :page-root-uri config) {:uri (page-uri file-name :page-root-uri config)
:page-index (:page-index page-meta)}))) :page-index (:page-index page-meta)
:klipse (klipse/merge-configs (:klipse config) (:klipse page-meta))})))
(defn parse-post (defn parse-post
"Return a map with the given post's information." "Return a map with the given post's information."
@ -120,28 +122,29 @@
(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 (if (:date page-meta) (let [date (if (:date page-meta)
(.parse (java.text.SimpleDateFormat. (:post-date-format config)) (:date page-meta)) (.parse (java.text.SimpleDateFormat. (:post-date-format config)) (:date page-meta))
(parse-post-date file-name (:post-date-format config))) (parse-post-date file-name (:post-date-format config)))
archive-fmt (java.text.SimpleDateFormat. (get config :archive-group-format "yyyy MMMM") (Locale/getDefault)) archive-fmt (java.text.SimpleDateFormat. (:archive-group-format config "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 (page-uri file-name :post-root-uri config) :uri (page-uri file-name :post-root-uri config)
:tags (set (:tags page-meta))})))) :tags (set (:tags page-meta))
:klipse (klipse/merge-configs (:klipse config) (:klipse page-meta))}))))
(defn read-posts (defn read-posts
"Returns a sequence of maps representing the data from markdown files of posts. "Returns a sequence of maps representing the data from markdown files of posts.
Sorts the sequence by post date." Sorts the sequence by post date."
[config] [config]
(->> (mapcat (->> (m/markups)
(mapcat
(fn [mu] (fn [mu]
(->> (->>
(find-posts config mu) (find-posts config mu)
(pmap #(parse-post % config mu)) (pmap #(parse-post % config mu))
(remove #(= (:draft? %) true)))) (remove #(= (:draft? %) true)))))
(m/markups))
(sort-by :date) (sort-by :date)
reverse reverse
(drop-while #(and (:hide-future-posts? config) (.after (:date %) (java.util.Date.)))))) (drop-while #(and (:hide-future-posts? config) (.after (:date %) (java.util.Date.))))))
@ -150,12 +153,12 @@
"Returns a sequence of maps representing the data from markdown files of pages. "Returns a sequence of maps representing the data from markdown files of pages.
Sorts the sequence by post date." Sorts the sequence by post date."
[config] [config]
(->> (mapcat (->> (m/markups)
(mapcat
(fn [mu] (fn [mu]
(->> (->>
(find-pages config mu) (find-pages config mu)
(map #(parse-page % config mu)))) (map #(parse-page % config mu)))))
(m/markups))
(sort-by :page-index))) (sort-by :page-index)))
(defn tag-post (defn tag-post
@ -163,7 +166,8 @@
[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 :enclosure]))) (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
"Maps all the tags with a list of posts that contain each tag" "Maps all the tags with a list of posts that contain each tag"
@ -201,13 +205,13 @@
:uri (page-uri (str (name tag) ".html") :tag-root-uri config)}) :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 metadata of the prev/next
post/page if it exists" post/page if it exists"
[pages] [pages]
(map (fn [[prev target next]] (map (fn [[prev target next]]
(assoc target (assoc target
:prev (if prev (select-keys prev [:title :uri]) nil) :prev (if prev (dissoc prev :content) nil)
:next (if next (select-keys next [:title :uri]) nil))) :next (if next (dissoc next :content) nil)))
(partition 3 1 (flatten [nil pages nil])))) (partition 3 1 (flatten [nil pages nil]))))
(defn group-pages (defn group-pages
@ -252,26 +256,30 @@
"When `clean-urls?` is set, appends `/index.html` before spit; otherwise just spits." "When `clean-urls?` is set, appends `/index.html` before spit; otherwise just spits."
[file-uri {:keys [clean-urls?]} data] [file-uri {:keys [clean-urls?]} data]
(if clean-urls? (if clean-urls?
(create-file-recursive (path file-uri "index.html") data) (cryogen-io/create-file-recursive (cryogen-io/path file-uri "index.html") data)
(create-file file-uri data))) (cryogen-io/create-file file-uri data)))
(defn- print-debug-info [data]
(println "DEBUG:")
(pprint 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-uri debug?] :as params} pages] [{:keys [blog-prefix page-root-uri debug?] :as params} pages]
(when-not (empty? pages) (when-not (empty? pages)
(println (blue "compiling pages")) (println (blue "compiling pages"))
(create-folder (path "/" blog-prefix page-root-uri)) (cryogen-io/create-folder (cryogen-io/path "/" blog-prefix page-root-uri))
(doseq [{:keys [uri] :as page} pages] (doseq [{:keys [uri] :as page} pages]
(println "\t-->" (cyan uri)) (println "-->" (cyan uri))
(when debug? (when debug?
(println "\t-->" (cyan page))) (print-debug-info page))
(write-html uri (write-html uri
params params
(render-file (str "/html/" (:layout page)) (render-file (str "/html/" (:layout page))
(merge params (merge params
{:active-page "pages" {:active-page "pages"
:home false :home false
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/path "/" blog-prefix "/")
:page page :page page
:uri uri})))))) :uri uri}))))))
@ -280,74 +288,75 @@
[{:keys [blog-prefix post-root-uri disqus-shortname debug?] :as params} posts] [{:keys [blog-prefix post-root-uri disqus-shortname debug?] :as params} posts]
(when-not (empty? posts) (when-not (empty? posts)
(println (blue "compiling posts")) (println (blue "compiling posts"))
(create-folder (path "/" blog-prefix post-root-uri)) (cryogen-io/create-folder (cryogen-io/path "/" blog-prefix post-root-uri))
(doseq [post posts] (doseq [{:keys [uri] :as post} posts]
(println "\t-->" (cyan (:uri post))) (println "-->" (cyan uri))
(println "\t-->" (cyan debug?))
(when debug? (when debug?
(println "\t-->" (cyan post))) (print-debug-info post))
(write-html (:uri post) (write-html uri
params params
(render-file (str "/html/" (:layout post)) (render-file (str "/html/" (:layout post))
(merge params (merge params
{:active-page "posts" {:active-page "posts"
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/path "/" blog-prefix "/")
:post post :post post
:disqus-shortname disqus-shortname :disqus-shortname disqus-shortname
:uri (:uri post)})))))) :uri uri}))))))
(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-uri] :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 (path "/" blog-prefix tag-root-uri)) (cryogen-io/create-folder (cryogen-io/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 "-->" (cyan uri))
(write-html uri (write-html uri
params params
(render-file "/html/tag.html" (render-file "/html/tag.html"
(merge params (merge params
{:active-page "tags" {:active-page "tags"
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/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}]
"Compiles a page with links to each tag page. Spits the page into the public folder"
(println (blue "compiling tags page")) (println (blue "compiling tags page"))
(let [uri (page-uri "tags.html" params)] (let [uri (page-uri "tags.html" params)]
(write-html uri (write-html uri
params params
(render-file "/html/tags.html" (render-file "/html/tags.html"
(merge params (merge params
{:active-page "tags" {:active-page "tags"
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/path "/" blog-prefix "/")
:uri uri}))))) :uri uri})))))
(defn content-until-more-marker (defn content-until-more-marker
[^String content] "Returns the content until the <!--more--> special comment,
(let [index (.indexOf content "<!--more-->")] closing any unclosed tags. Returns nil if there's no such comment."
(if (pos? index) [content]
(let [s (subs content 0 index)] (when-let [index (s/index-of content "<!--more-->")]
(->> ((tagsoup/parse-string s) 2) (->> (subs content 0 index)
(drop 2) enlive/html-snippet
hiccup/html))))) enlive/emit*
(apply str))))
(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 post (update post :content
{:content (or (content-until-more-marker (:content post)) #(or (content-until-more-marker %)
(->> ((tagsoup/parse-string (:content post)) 2) (->> (enlive/html-snippet %)
(drop 2) (take blocks-per-preview)
(take blocks-per-preview) enlive/emit*
hiccup/html))})) (apply str)))))
(defn create-previews (defn create-previews
"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 posts-per-page blocks-per-preview]
(->> posts (->> posts
(map #(create-preview blocks-per-preview %)) (map #(create-preview blocks-per-preview %))
(partition-all posts-per-page) (partition-all posts-per-page)
@ -359,51 +368,53 @@
[previews params] [previews params]
(mapv (fn [[prev target next]] (mapv (fn [[prev target next]]
(merge target (merge target
{:prev (if prev (page-uri (path "p" (str (:index prev) ".html")) params) nil) {:prev (if prev (page-uri (cryogen-io/path "p" (str (:index prev) ".html")) params) nil)
:next (if next (page-uri (path "p" (str (:index next) ".html")) params) nil)})) :next (if next (page-uri (cryogen-io/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
"Compiles a series of pages containing 'previews' from each post" "Compiles a series of pages containing 'previews' from each post"
[{: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 (-> posts
(create-previews posts-per-page blocks-per-preview)
(create-preview-links params)) (create-preview-links params))
previews (if (> (count previews) 1) (assoc-in previews [1 :prev] (page-uri "index.html" params)) previews)] previews (if (> (count previews) 1)
(create-folder (path "/" blog-prefix "p")) (assoc-in previews [1 :prev] (page-uri "index.html" params))
previews)]
(cryogen-io/create-folder (cryogen-io/path "/" blog-prefix "p"))
(doseq [{:keys [index posts prev next]} previews (doseq [{:keys [index posts prev next]} previews
:let [index-page? (= 1 index)]] :let [index-page? (= 1 index)]]
(write-html (if index-page? (page-uri "index.html" params) (page-uri (path "p" (str index ".html")) params)) (write-html
params (if index-page? (page-uri "index.html" params)
(render-file "/html/previews.html" (page-uri (cryogen-io/path "p" (str index ".html")) params))
(merge params params
{:active-page "preview" (render-file "/html/previews.html"
:home (when index-page? true) (merge params
:servlet-context (path "/" blog-prefix "/") {:active-page "preview"
:posts posts :home (when index-page? true)
:prev-uri prev :servlet-context (cryogen-io/path "/" blog-prefix "/")
:next-uri next}))))))) :posts posts
:prev-uri prev
: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 [disqus?] :as params}] [{:keys [disqus? debug? home-page] :as params}]
(println (blue "compiling index")) (println (blue "compiling index"))
(let [uri (page-uri "index.html" params) (let [uri (page-uri "index.html" params)]
debug? (-> params :debug?)
home-page (-> params :home-page)
meta {:active-page "home"
:home true
:disqus? disqus?
:uri uri
:post home-page
:page home-page}]
(when debug? (when debug?
(println "\t-->" (cyan meta))) (print-debug-info meta))
(write-html uri (write-html uri
params params
(render-file (str "/html/" (:layout home-page)) (render-file (str "/html/" (:layout home-page))
(merge params (merge params
meta))))) {:active-page "home"
:home true
:disqus? disqus?
:uri uri
:post home-page
:page home-page})))))
(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"
@ -414,28 +425,28 @@
params params
(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)
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/path "/" blog-prefix "/")
:uri uri}))))) :uri uri})))))
(defn compile-authors (defn compile-authors
"For each author, creates a page with filtered posts." "For each author, creates a page with filtered posts."
[{:keys [blog-prefix author-root-uri author] :as params} posts] [{:keys [blog-prefix author-root-uri author] :as params} posts]
(println (blue "compiling authors")) (println (blue "compiling authors"))
(create-folder (path "/" blog-prefix author-root-uri)) (cryogen-io/create-folder (cryogen-io/path "/" blog-prefix author-root-uri))
;; if the post author is empty defaults to config's :author ;; if the post author is empty defaults to config's :author
(doseq [{:keys [author posts]} (group-for-author posts author)] (doseq [{:keys [author posts]} (group-for-author posts author)]
(let [uri (page-uri (str author ".html") :author-root-uri params)] (let [uri (page-uri (str author ".html") :author-root-uri params)]
(println "\t-->" (cyan uri)) (println "-->" (cyan uri))
(write-html uri (write-html uri
params params
(render-file "/html/author.html" (render-file "/html/author.html"
(merge params (merge params
{:author author {:author author
:groups (group-for-archive posts) :groups (group-for-archive posts)
:servlet-context (path "/" blog-prefix "/") :servlet-context (cryogen-io/path "/" blog-prefix "/")
:uri uri})))))) :uri uri}))))))
(defn tag-posts (defn tag-posts
@ -446,11 +457,11 @@
(defn- template-dir? (defn- template-dir?
"Checks that the dir exists in the templates directory." "Checks that the dir exists in the templates directory."
[dir] [dir]
(.isDirectory (file (str "resources/templates/" dir)))) (.isDirectory (io/file (str "resources/templates/" dir))))
(defn- markup-entries [post-root page-root] (defn- markup-entries [post-root page-root]
(let [entries (for [mu (m/markups) (let [entries (for [mu (m/markups)
t (distinct [post-root page-root])] t (distinct [post-root page-root])]
[(str (m/dir mu) "/" t) t])] [(str (m/dir mu) "/" t) t])]
(apply concat entries))) (apply concat entries)))
@ -459,7 +470,7 @@
[{:keys [post-root page-root] :as config}] [{:keys [post-root page-root] :as config}]
(let [folders (->> (markup-entries post-root page-root) (let [folders (->> (markup-entries post-root page-root)
(filter template-dir?))] (filter template-dir?))]
(copy-resources (cryogen-io/copy-resources
(merge config (merge config
{:resources folders {:resources folders
:ignored-files (map #(re-pattern-from-ext (m/ext %)) (m/markups))})))) :ignored-files (map #(re-pattern-from-ext (m/ext %)) (m/markups))}))))
@ -469,7 +480,7 @@
[] []
(try (try
(let [config (-> "templates/config.edn" (let [config (-> "templates/config.edn"
get-resource cryogen-io/get-resource
slurp slurp
read-string read-string
(update-in [:blog-prefix] (fnil str "")) (update-in [:blog-prefix] (fnil str ""))
@ -492,22 +503,35 @@
(catch Exception _ (catch Exception _
(throw (IllegalArgumentException. "Failed to parse config.edn"))))) (throw (IllegalArgumentException. "Failed to parse config.edn")))))
(defn klipsify
"Add the klipse html under the :klipse key and adds nohighlight
classes to any code blocks that are to be klipsified. Expects
configuration to be under :klipse, if there's none it does nothing."
[{:keys [klipse content] :as post-or-page}]
(-> post-or-page
(update :klipse klipse/emit content)
(update :content klipse/tag-nohighlight (:settings klipse))))
(defn compile-assets (defn compile-assets
"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 [^String site-url blog-prefix rss-name recent-posts sass-src sass-dest (let [{:keys [^String site-url blog-prefix rss-name recent-posts sass-dest keep-files ignored-files previews? author-root-uri theme]
sass-path compass-path keep-files ignored-files previews? clean-urls? :as config} (read-config)
debug? author-root-uri] :as config} (read-config) posts (map klipsify (add-prev-next (read-posts config)))
posts (add-prev-next (read-posts config))
pages (add-prev-next (read-pages config))
home-pages (filter #(boolean (:home? %)) pages)
pages-without-home (filter #(boolean (not (:home? %))) pages)
[navbar-pages sidebar-pages] (group-pages pages-without-home)
navmap-pages (build-nav-map pages-without-home)
posts-by-tag (group-by-tags posts) posts-by-tag (group-by-tags posts)
posts (tag-posts posts config) posts (tag-posts posts config)
latest-posts (->> posts (take recent-posts) vec) latest-posts (->> posts (take recent-posts) vec)
pages (map klipsify (read-pages config))
home-page (->> pages
(filter #(boolean (:home? %)))
(first))
other-pages (->> pages
(remove #{home-page})
(add-prev-next))
[navbar-pages
sidebar-pages] (group-pages other-pages)
navmap-pages (build-nav-map other-pages)
params (merge config params (merge config
{:today (java.util.Date.) {:today (java.util.Date.)
:title (:site-title config) :title (:site-title config)
@ -517,55 +541,51 @@
:navbar-pages navbar-pages :navbar-pages navbar-pages
:navmap-pages navmap-pages :navmap-pages navmap-pages
:sidebar-pages sidebar-pages :sidebar-pages sidebar-pages
:home-page (if (not-empty home-pages) :home-page (if home-page
(first home-pages) home-page
(merge (first latest-posts) (assoc (first latest-posts) :layout "home.html"))
{:layout "home.html"}))
:archives-uri (page-uri "archives.html" config) :archives-uri (page-uri "archives.html" config)
:index-uri (page-uri "index.html" config) :index-uri (page-uri "index.html" config)
:tags-uri (page-uri "tags.html" config) :tags-uri (page-uri "tags.html" config)
:rss-uri (path "/" blog-prefix rss-name) :rss-uri (cryogen-io/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))})]
(when debug? (when debug?
(println (blue "debug: navbar-pages:")) (println (blue "debug: navbar-pages:"))
(println "\t-->" (cyan navbar-pages)) (println "\t-->" (cyan navbar-pages))
(println (blue "debug: navmap-pages:")) (println (blue "debug: navmap-pages:"))
(println "\t-->" (cyan navmap-pages)) (println "\t-->" (cyan navmap-pages))
) )
(set-custom-resource-path! (:theme-path params)) (set-custom-resource-path! (str "file:resources/templates/themes/" theme))
(wipe-public-folder keep-files) (cryogen-io/wipe-public-folder keep-files)
(println (blue "copying theme resources")) (println (blue "copying theme resources"))
(copy-resources-from-theme config) (cryogen-io/copy-resources-from-theme config)
(println (blue "copying resources")) (println (blue "copying resources"))
(copy-resources config) (cryogen-io/copy-resources config)
(copy-resources-from-markup-folders config) (copy-resources-from-markup-folders config)
(compile-pages params pages-without-home) (compile-pages params other-pages)
(compile-posts params posts) (compile-posts params posts)
(compile-tags params posts-by-tag) (compile-tags params posts-by-tag)
(compile-tags-page params) (compile-tags-page params)
(when previews? (if previews?
(compile-preview-pages params posts)) (compile-preview-pages params posts)
(when (or (not-empty home-pages) (not previews?))
(compile-index params)) (compile-index params))
(compile-archives params posts) (compile-archives params posts)
(when author-root-uri (when author-root-uri
(println (blue "generating authors views")) (println (blue "generating authors views"))
(compile-authors params posts)) (compile-authors params posts))
(println (blue "generating site map")) (println (blue "generating site map"))
(create-file (path "/" blog-prefix "sitemap.xml") (sitemap/generate site-url ignored-files)) (->> (sitemap/generate site-url ignored-files)
(cryogen-io/create-file (cryogen-io/path "/" blog-prefix "sitemap.xml")))
(println (blue "generating main rss")) (println (blue "generating main rss"))
(create-file (path "/" blog-prefix rss-name) (rss/make-channel config posts)) (->> (rss/make-channel config posts)
(cryogen-io/create-file (cryogen-io/path "/" blog-prefix rss-name)))
(println (blue "generating filtered rss")) (println (blue "generating filtered rss"))
(rss/make-filtered-channels 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!
{:path-sass sass-path (merge (select-keys config [:sass-path :compass-path :sass-src :ignored-files])
:path-compass compass-path {:sass-dest (cryogen-io/path ".." "public" blog-prefix sass-dest)
:src-sass sass-src :base-dir "resources/templates/"}))))
:dest-sass (path ".." "public" blog-prefix sass-dest)
:ignored-files ignored-files
:base-dir "resources/templates/"})))
(defn compile-assets-timed [] (defn compile-assets-timed []
(time (time

37
src/cryogen_core/github.clj
View file

@ -1,37 +0,0 @@
(ns cryogen-core.github
(:require [cheshire.core :as json])
(:import (org.apache.commons.codec.binary Base64 StringUtils)))
(defn get-gist [gist-uri]
(let [gist-id (last (clojure.string/split gist-uri #"/+")) ;;just need id for git api
gist-resp (try (slurp (str "https://api.github.com/gists/" gist-id))
(catch Exception e {:error (.getMessage e)}))]
(when-not (:error gist-resp)
(if-let [gist (-> (json/parse-string gist-resp)
(get "files")
first ;;todo: optionally get all gist files?
val)]
{:content (get gist "content")
:language (get gist "language")
:name (get gist "filename")
:id gist-id}))))
(defn get-src [git-file]
(let [git-re (re-find #"github.com/(.*)/blob/(.+?)/(.+)" git-file) ;;want second and last now (user/repo,file) for git api
git-res (str "https://api.github.com/repos/" (second git-re) "/contents/" (last git-re))
git-resp (try (slurp git-res)
(catch Exception e {:error (.getMessage e)}))]
(when-not (:error git-resp)
(if-let [git-src (json/parse-string git-resp)]
{:content (String. ^bytes (Base64/decodeBase64 ^String (get git-src "content")) "UTF-8")
:name (get git-src "name")
:uri (get (get git-src "_links") "html")}))))
(defn get-gits-ex []
[(get-gist "https://gist.github.com/viperscape/cec68f0791687f5959f1")
(get-src "https://github.com/viperscape/kuroshio/blob/master/examples/pubsub.clj")])
;(prn (get-gits-ex))

149
src/cryogen_core/klipse.clj Normal file
View file

@ -0,0 +1,149 @@
(ns cryogen-core.klipse
(:require [clojure.string :as str]
[camel-snake-kebab.core :refer [->snake_case_string ->camelCaseString]]
[cheshire.core :as json]
[net.cgrand.enlive-html :as enlive]))
;;;;;;;;;;;
;; utils
(defn map-keys
"Applies f to each key in m"
[f m]
(zipmap (map f (keys m)) (vals m)))
(defn update-existing
"Like clojure.core/update, but returns m untouched if it doesn't contain k"
[m k f & args]
(if (contains? m k) (apply update m k f args) m))
(def map-or-nil? (some-fn map? nil?))
(defn deep-merge
"Like clojure.core/merge, but also merges nested maps under the same key."
[& ms]
(apply merge-with
(fn [v1 v2]
(if (and (map-or-nil? v1) (map-or-nil? v2))
(deep-merge v1 v2)
v2))
ms))
(defn filter-html-elems
"Recursively walks a sequence of enlive-style html elements depth first
and returns a flat sequence of the elements where (pred elem)"
[pred html-elems]
(reduce (fn [acc {:keys [content] :as elem}]
(into (if (pred elem) (conj acc elem) acc)
(filter-html-elems pred content)))
[] html-elems))
(defn code-block-classes
"Takes a string of html and returns a sequence of
all the classes on all code blocks."
[html]
(->> html
enlive/html-snippet
(filter-html-elems (comp #{:code} :tag))
(keep (comp :class :attrs))
(mapcat #(str/split % #" "))))
;;;;;;;;;;;;
;; klipse
(defn eval-classes
"Takes the :settings map and returns all values that are css class selectors."
[settings]
(filter #(str/starts-with? % ".") (vals settings)))
(defn tag-nohighlight
"Takes html as a string and a coll of class-selectors and adds
nohighlight to all code blocks that includes one of them."
[html settings]
(letfn [(tag [h clas]
(enlive/sniptest h
[(keyword (str "code" clas))]
(fn [x]
(update-in x [:attrs :class] #(str % " nohighlight")))))]
(reduce tag html (eval-classes settings))))
(def defaults
{:js-src
{:min "https://storage.googleapis.com/app.klipse.tech/plugin_prod/js/klipse_plugin.min.js"
:non-min "https://storage.googleapis.com/app.klipse.tech/plugin/js/klipse_plugin.js"}
:css-base "https://storage.googleapis.com/app.klipse.tech/css/codemirror.css"})
;; This needs to be updated whenever a new clojure selector is introduced.
;; It should only be necessary for react wrappers and the like, so not very often.
;; When (if?) self hosted cljs becomes compatible with advanced builds
;; this can be removed and we can just always use minified js.
(def clojure-selectors
"A set of selectors that imply clojure evaluation."
#{"selector" "selector_reagent"})
(defn clojure-eval-classes
"Takes settings and returns a set of the html classes that imply clojure eval."
[normalized-settings]
(reduce (fn [classes selector]
(if-let [klass (get normalized-settings selector)]
(conj classes (->> klass rest (apply str))) ;; Strip the leading .
classes))
#{} clojure-selectors))
(defn clojure-eval?
"Takes settings and html and returns whether there is any clojure eval."
[normalized-settings html]
(boolean (some (clojure-eval-classes normalized-settings) (code-block-classes html))))
(defn normalize-settings
"Transform the keys to the correct snake-case or camelCase strings."
[settings]
(-> (map-keys ->snake_case_string settings)
(update-existing "codemirror_options_in" (partial map-keys ->camelCaseString))
(update-existing "codemirror_options_out" (partial map-keys ->camelCaseString))))
(defn merge-configs
"Merges the defaults, global config and post config,
transforms lisp-case keywords into snake_case/camelCase strings
Returns nil if there's no post-config.
A post-config with the value true counts as an empty map."
[global-config post-config]
(when post-config
(let [post-config (if (true? post-config) {} post-config)]
(deep-merge defaults
(update-existing global-config :settings normalize-settings)
(update-existing post-config :settings normalize-settings)))))
(defn infer-clojure-eval
"Infers whether there's clojure eval and returns the config with the
appropriate value assoc'd to :js.
Returns the config untouched if :js is already specified."
[config html]
(if (:js config)
config
(assoc config :js
(if (clojure-eval? (:settings config) html) :non-min :min))))
(defn include-css [href]
(str "<link rel=\"stylesheet\" type=\"text/css\" href=" (pr-str href) ">"))
(defn include-js [src]
(str "<script src=" (pr-str src) "></script>"))
(defn emit
"Takes the :klipse config from config.edn and the :klipse config from the
current post, and returns the html to include on the bottom of the page."
[config html]
(when-let [{:keys [settings js-src js css-base css-theme]}
(infer-clojure-eval config html)]
(assert (#{:min :non-min} js)
(str ":js needs to be one of :min or :non-min but was: " js))
(str (include-css css-base) "\n"
(when css-theme (str (include-css css-theme) "\n"))
"<script>\n"
"window.klipse_settings = " (json/generate-string settings {:pretty true}) ";\n"
"</script>\n"
(include-js (js js-src)))))

5
src/cryogen_core/markup.clj
View file

@ -1,6 +1,5 @@
(ns cryogen-core.markup (ns cryogen-core.markup
(:require [clojure.string :as s]) (:require [clojure.string :as s]))
(:import java.util.Collections))
(defonce markup-registry (atom [])) (defonce markup-registry (atom []))
@ -18,7 +17,7 @@
[blog-prefix text] [blog-prefix text]
(if (s/blank? blog-prefix) (if (s/blank? blog-prefix)
text text
(clojure.string/replace text #"href=.?/|src=.?/" #(str (subs % 0 (dec (count %))) blog-prefix "/")))) (s/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

3
src/cryogen_core/plugins.clj
View file

@ -1,6 +1,5 @@
(ns cryogen-core.plugins (ns cryogen-core.plugins
(:require [cryogen-core.compiler :refer [compile-assets-timed]] (:require [clojure.edn :as edn]
[clojure.edn :as edn]
[clojure.string :as s] [clojure.string :as s]
[text-decoration.core :refer :all])) [text-decoration.core :refer :all]))

6
src/cryogen_core/rss.clj
View file

@ -1,7 +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]]) [cryogen-core.io :as cryogen-io])
(:import java.util.Date)) (:import java.util.Date))
@ -31,6 +31,6 @@
(defn make-filtered-channels [{: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 (path "/" blog-prefix (str (name filter) ".xml"))] (let [uri (cryogen-io/path "/" blog-prefix (str (name filter) ".xml"))]
(println "\t-->" (cyan uri)) (println "\t-->" (cyan uri))
(create-file uri (make-channel config (get posts-by-tag filter)))))) (cryogen-io/create-file uri (make-channel config (get posts-by-tag filter))))))

63
src/cryogen_core/sass.clj
View file

@ -1,8 +1,8 @@
(ns cryogen-core.sass (ns cryogen-core.sass
(:require [clojure.java.shell :as shell] (:require [clojure.java.io :as io]
[clojure.java.io :as io] [clojure.java.shell :as shell]
[text-decoration.core :refer :all] [text-decoration.core :refer :all]
[cryogen-core.io :refer [ignore match-re-filter]])) [cryogen-core.io :as cryogen-io]))
(defmacro sh (defmacro sh
[& args] [& args]
@ -11,64 +11,51 @@
(defn sass-installed? (defn sass-installed?
"Checks for the installation of Sass." "Checks for the installation of Sass."
[path-sass] [sass-path]
(= 0 (:exit (sh path-sass "--version")))) (zero? (:exit (sh sass-path "--version"))))
(defn compass-installed? (defn compass-installed?
"Checks for the installation of Compass." "Checks for the installation of Compass."
[path-compass] [compass-path]
(try (try
(= 0 (:exit (sh path-compass "--version"))) (zero? (:exit (sh compass-path "--version")))
(catch java.io.IOException _ (catch java.io.IOException _
false))) 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 [^java.io.FilenameFilter filename-filter (match-re-filter #"(?i:s[ca]ss$)")] (let [^java.io.FilenameFilter filename-filter (cryogen-io/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 ^java.io.File %))) (filter #(not (.isDirectory ^java.io.File %)))
(filter (ignore ignored-files)) (filter (cryogen-io/ignore ignored-files))
(map #(.getName ^java.io.File %))))) (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 sass-src directory,
output the resulting css in dest-sass. All error handling is output the resulting css in sass-dest. All error handling is
done by sh / launching the sass command." done by sh / launching the sass command."
[{:keys [src-sass [{:keys [sass-src sass-dest sass-path compass-path base-dir]}]
dest-sass
path-sass
path-compass
base-dir]}]
(shell/with-sh-dir base-dir (shell/with-sh-dir base-dir
(if (compass-installed? path-compass) (if (compass-installed? compass-path)
(sh path-sass "--compass" "--update" (str src-sass ":" dest-sass)) (sh sass-path "--compass" "--update" (str sass-src ":" sass-dest))
(sh path-sass "--update" (str src-sass ":" dest-sass))))) (sh sass-path "--update" (str sass-src ":" sass-dest)))))
(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 sass-src, looks for all sass files and compiles them into
dest-sass. Prompts you to install sass if he finds sass files and can't find sass-dest. Prompts you to install sass if he finds sass files and can't find
the command. Shows you any problems it comes across when compiling. " the command. Shows you any problems it comes across when compiling. "
[{:keys [src-sass [{:keys [sass-src sass-dest sass-path ignored-files base-dir] :as opts}]
dest-sass (when (seq (find-sass-files base-dir sass-src ignored-files))
path-sass (if (sass-installed? sass-path)
ignored-files
base-dir] :as opts}]
(when-let [sass-files (seq (find-sass-files base-dir src-sass ignored-files))]
(if (sass-installed? path-sass)
;; I found sass files,
;; If sass is installed
(do (do
(println "\t" (cyan src-sass) "-->" (cyan dest-sass)) (println "\t" (cyan sass-src) "-->" (cyan sass-dest))
(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
(println "Successfully compiled sass files") (println "Successfully compiled sass files")
;; else I show the error
(println (red (:err result)) (println (red (:err result))
(red (:out result)))))) (red (:out result))))))
;; Else I prompt to install Sass
(println "Sass seems not to be installed, but you have scss / sass files in " (println "Sass seems not to be installed, but you have scss / sass files in "
src-sass sass-src
" - You might want to install it here: sass-lang.com")))) " - You might want to install it here: sass-lang.com"))))

4
src/cryogen_core/sitemap.clj
View file

@ -1,6 +1,6 @@
(ns cryogen-core.sitemap (ns cryogen-core.sitemap
(:require [clojure.xml :refer [emit]] (:require [clojure.xml :refer [emit]]
[cryogen-core.io :refer [get-resource find-assets]]) [cryogen-core.io :as cryogen-io])
(:import java.util.Date)) (:import java.util.Date))
;;generate sitemaps using the sitemap spec ;;generate sitemaps using the sitemap spec
@ -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 [^java.io.File f (find-assets "public" ".html" ignored-files)] (for [^java.io.File f (cryogen-io/find-assets "public" ".html" ignored-files)]
{:tag :url {:tag :url
:content :content
[{:tag :loc [{:tag :loc

9
src/cryogen_core/toc.clj
View file

@ -1,6 +1,6 @@
(ns cryogen-core.toc (ns cryogen-core.toc
(:require [clojure.zip :as z] (:require [clojure.zip :as z]
[crouton.html :as html] [net.cgrand.enlive-html :as enlive]
[hiccup.core :as hiccup])) [hiccup.core :as hiccup]))
(def _h [:h1 :h2 :h3 :h4 :h5 :h6]) (def _h [:h1 :h2 :h3 :h4 :h5 :h6])
@ -102,13 +102,10 @@
:ol and true will result in an ordered list being generated for the table of :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 contents, while :ul will result in an unordered list. The default is an
ordered list." ordered list."
[^String html & {:keys [list-type] :or {list-type :ol}}] [html & {:keys [list-type] :or {list-type :ol}}]
(let [list-type (if (true? list-type) :ol list-type)] (let [list-type (if (true? list-type) :ol list-type)]
(-> html (-> html
(.getBytes "UTF-8") (enlive/html-snippet)
(java.io.ByteArrayInputStream.)
(html/parse)
:content
(get-headings) (get-headings)
(build-toc-tree) (build-toc-tree)
(build-toc list-type) (build-toc list-type)

14
src/cryogen_core/watcher.clj
View file

@ -1,20 +1,20 @@
(ns cryogen-core.watcher (ns cryogen-core.watcher
(:require [clojure.java.io :refer [file]] (:require [clojure.java.io :as io]
[cryogen-core.io :refer [ignore]] [clojure.set :as set]
[pandect.algo.md5 :refer [md5]]
[hawk.core :as hawk] [hawk.core :as hawk]
[clojure.set :as set])) [pandect.algo.md5 :as md5]
[cryogen-core.io :as cryogen-io]))
(defn get-assets [path ignored-files] (defn get-assets [path ignored-files]
(->> path (->> path
file io/file
file-seq file-seq
(filter #(not (.isDirectory ^java.io.File %))) (filter #(not (.isDirectory ^java.io.File %)))
(filter (ignore ignored-files)))) (filter (cryogen-io/ignore ignored-files))))
(defn checksums [path ignored-files] (defn checksums [path ignored-files]
(let [files (get-assets path ignored-files)] (let [files (get-assets path ignored-files)]
(zipmap (map md5 files) files))) (zipmap (map md5/md5 files) files)))
(defn find-changes [old-sums new-sums] (defn find-changes [old-sums new-sums]
(let [old-sum-set (-> old-sums keys set) (let [old-sum-set (-> old-sums keys set)

8
test/cryogen_core/compiler_test.clj
View file

@ -1,9 +1,8 @@
(ns cryogen-core.compiler-test (ns cryogen-core.compiler-test
(:require [clojure.test :refer :all] (:require [clojure.test :refer :all]
[me.raynes.fs :as fs]
[cryogen-core.compiler :refer :all] [cryogen-core.compiler :refer :all]
[cryogen-core.io :refer [path]] [cryogen-core.markup :as m])
[cryogen-core.markup :as m]
[me.raynes.fs :as fs])
(:import [java.io File])) (:import [java.io File]))
; Test that the content-until-more-marker return nil or correct html text. ; Test that the content-until-more-marker return nil or correct html text.
@ -22,7 +21,8 @@
and more content. and more content.
</div> </div>
</div>") </div>")
"<div id=\"post\"><div class=\"post-content\"> "<div id=\"post\">
<div class=\"post-content\">
this post has more marker this post has more marker
</div></div>"))) </div></div>")))

75
test/cryogen_core/klipse_test.clj Normal file
View file

@ -0,0 +1,75 @@
(ns cryogen-core.klipse-test
(:require [cryogen-core.klipse :refer :all]
[clojure.test :refer [deftest testing is are]]))
(deftest map-keys-test
(is (= {"a" 1 "b" 2} (map-keys name {:a 1 :b 2}))))
(deftest update-existing-test
(is (= {:a 1 :b 2} (update-existing {:a 1 :b 1} :b inc)))
(is (= {:a 1} (update-existing {:a 1} :b (constantly 2)))))
(deftest deep-merge-test
(is (= {:a {:b 1 :c 2}} (deep-merge {:a {:b 1}} {:a {:c 2}})))
(is (= {:a {:b 1}} (deep-merge {:a {:b 1}} {:a nil})))
(is (= {:a {:b 1 :c 3}} (deep-merge {:a {:b 1 :c 2}} {:a {:c 3}}))))
;; For testing convenience.
(defn elt
"Returns an enlive style html element."
([tag] (elt tag nil))
([tag attrs & content]
{:tag tag, :attrs attrs, :content content}))
(deftest filter-html-elems-test
(is (= [(elt :div {:class "x"} :content [(elt :div {:class "x"} "foo")])
(elt :div {:class "x"} "foo")])
(filter-html-elems (comp #{"x"} :class :attrs)
[(elt :h1 {:class "y"} "things!")
(elt :div {:class "x"} (elt :div {:class "x"} "foo"))])))
(deftest code-block-classes-test
(is (= ["clojure" "ruby"]
(code-block-classes
"<h1>stuff</h1>
<div class=\"not-code\"><pre><code class=\"clojure\">(def x 42)</code></pre></div>
<pre><code class=\"ruby\">123</code><pre>"))))
(deftest clojure-eval-classes-test
(is (= #{"eval-cljs" "eval-reagent"}
(clojure-eval-classes {"selector" ".eval-cljs"
"selector_reagent" ".eval-reagent"
"selector_eval_ruby" ".eval-ruby"}))))
(deftest clojure-eval?-test
(is (clojure-eval? {"selector" ".eval-cljs"}
"<h1>stuff</h1>
<div class=\"not-code\"><pre><code class=\"eval-cljs\">(def x 42)</code></pre></div>
<pre><code class=\"ruby\">123</code><pre>"))
(is (not (clojure-eval? {"selector" ".eval-cljs"
"selector_eval_ruby" ".eval-ruby"}
"<h1>stuff</h1>
<pre><code class=\"eval-ruby\">123</code><pre>"))))
(deftest normalize-settings-test
(is (= {"selector_reagent" ".reagent"
"codemirror_options_in" {"lineNumbers" true}}
(normalize-settings
{:selector-reagent ".reagent"
:codemirror-options-in {:line-numbers true}}))))
(deftest merge-configs-test
(testing "Things are merged correctly"
(is (= (merge defaults
{:settings {"selector" ".clojure-eval"
"codemirror_options_in" {"lineNumbers" true}}})
(merge-configs {:settings {:codemirror-options-in {:line-numbers true}}}
{:settings {:selector ".clojure-eval"}}))))
(testing "If it's all set up in config.edn, in the post it can be just :klipse true"
(is (= (merge defaults {:settings {"selector_js" ".javascript"}})
(merge-configs {:settings {:selector-js ".javascript"}} true))))
(testing "Returns nil if there's nothing in the blog post"
(is (nil? (merge-configs {:settings {:selector ".clojure-eval"}} nil)))))

108
test/cryogen_core/toc_test.clj
View file

@ -1,38 +1,35 @@
(ns cryogen-core.toc-test (ns cryogen-core.toc-test
(:require [clojure.test :refer :all] (:require [clojure.test :refer :all]
[clojure.string :refer [join]] [clojure.string :as s]
[clojure.zip :as z] [net.cgrand.enlive-html :as enlive]
[crouton.html :as html]
[hiccup.core :as hiccup] [hiccup.core :as hiccup]
[cryogen-core.toc :refer :all])) [cryogen-core.toc :refer :all]))
; Reimport private functions ; Reimport private functions
(def get-headings #'cryogen-core.toc/get-headings) (def get-headings #'cryogen-core.toc/get-headings)
(def make-toc-entry #'cryogen-core.toc/make-toc-entry) (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-tree #'cryogen-core.toc/build-toc-tree)
(def build-toc #'cryogen-core.toc/build-toc) (def build-toc #'cryogen-core.toc/build-toc)
(defn parse-to-headings (defn parse-to-headings
[hiccup-seq] [hiccup-seq]
(-> hiccup-seq hiccup/html html/parse-string :content get-headings)) (-> hiccup-seq hiccup/html enlive/html-snippet get-headings))
; Test that the get-headings function properly filters non-headers ; Test that the get-headings function properly filters non-headers
(deftest test-get-headings (deftest test-get-headings
(let [noisy-headers [:div [:h1 "First H1"] (let [noisy-headers [:div [:h1 "First H1"]
[:p "Ignore..."] [:p "Ignore..."]
[:h2 "First H2"]]] [:h2 "First H2"]]]
(is (= (parse-to-headings noisy-headers) (is (= (parse-to-headings noisy-headers)
[{:tag :h1 :attrs nil :content ["First H1"]} [{:tag :h1 :attrs nil :content ["First H1"]}
{:tag :h2 :attrs nil :content ["First H2"]}])))) {:tag :h2 :attrs nil :content ["First H2"]}]))))
; Test that the make-toc-entry ignores invalid input ; Test that the make-toc-entry ignores invalid input
(deftest test-make-toc-entry (deftest test-make-toc-entry
(is (nil? (is (nil?
(make-toc-entry nil "Text"))) (make-toc-entry nil "Text")))
(is (nil? (is (nil?
(make-toc-entry "anchor" nil))) (make-toc-entry "anchor" nil)))
(is (= [:li [:a {:href "#anchor"} "Text"]] (is (= [:li [:a {:href "#anchor"} "Text"]]
(make-toc-entry "anchor" "Text")))) (make-toc-entry "anchor" "Text"))))
@ -45,65 +42,62 @@
; * h1 ; * h1
(deftest test-build-toc (deftest test-build-toc
(let [simplest-header [:div [:h2 [:a {:name "test"}] "Test"]] (let [simplest-header [:div [:h2 [:a {:name "test"}] "Test"]]
no-headers [:div [:p "This is not a header"]] no-headers [:div [:p "This is not a header"]]
closing-header-larger-than-opening-1 closing-header-larger-than-opening-1
[:div [:h2 [:a {:name "starting_low"}] [:div [:h2 [:a {:name "starting_low"}]
"Starting Low"] "Starting Low"]
[:h1 [:a {:name "finishing_high"}] [:h1 [:a {:name "finishing_high"}]
"Finishing High"]] "Finishing High"]]
closing-header-larger-than-opening-2 closing-header-larger-than-opening-2
[:div [:h2 [:a {:name "starting_low"}] [:div [:h2 [:a {:name "starting_low"}]
"Starting Low"] "Starting Low"]
[:h4 [:a {:name "jumping_in"}] [:h4 [:a {:name "jumping_in"}]
"Jumping Right In"] "Jumping Right In"]
[:h3 [:a {:name "pulling_back"}] [:h3 [:a {:name "pulling_back"}]
"But then pull back"] "But then pull back"]
[:h2 [:a {:name "to_the_top"}] [:h2 [:a {:name "to_the_top"}]
"To the top"]]] "To the top"]]]
(is (= [:ol.content (seq [[:li [:a {:href "#test"} "Test"]]])] (is (= [:ol.content (seq [[:li [:a {:href "#test"} "Test"]]])]
(-> simplest-header parse-to-headings build-toc-tree (-> simplest-header
(parse-to-headings)
(build-toc-tree)
(build-toc :ol)))) (build-toc :ol))))
(is (nil? (is (-> no-headers
(-> no-headers parse-to-headings build-toc-tree (parse-to-headings)
(build-toc :ol)))) (build-toc-tree)
(build-toc :ol)
(nil?)))
(is (= [:ol.content (seq [[:li [:a {:href "#starting_low"} "Starting Low"]] (is (= [:ol.content (seq [[:li [:a {:href "#starting_low"} "Starting Low"]]
[:li [:a {:href "#finishing_high"} "Finishing High"]]])] [:li [:a {:href "#finishing_high"} "Finishing High"]]])]
(-> closing-header-larger-than-opening-1 (-> closing-header-larger-than-opening-1
parse-to-headings (parse-to-headings)
build-toc-tree (build-toc-tree)
(build-toc :ol))) (build-toc :ol)))
"No outer header should be less indented than the first header tag.") "No outer header should be less indented than the first header tag.")
(is (= [:ul.content (is (= [:ul.content
(seq [ (seq [(seq [[:li [:a {:href "#starting_low"} "Starting Low"]]
(seq [ [:ul
[:li [:a {:href "#starting_low"} "Starting Low"]] (seq [[:li [:a {:href "#jumping_in"} "Jumping Right In"]]
[:ul [:li [:a {:href "#pulling_back"} "But then pull back"]]])]])
(seq [ [:li [:a {:href "#to_the_top"} "To the top"]]])]
[: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 (-> closing-header-larger-than-opening-2
parse-to-headings (parse-to-headings)
build-toc-tree (build-toc-tree)
(build-toc :ul))) (build-toc :ul)))
(join "" ["Inner headers can be more indented, " (s/join "" ["Inner headers can be more indented, "
"but outer headers cannot be less indented " "but outer headers cannot be less indented "
"than the original header."])) "than the original header."]))))
))
(deftest test-generate-toc (deftest test-generate-toc
(let [htmlString "<div><h2><a name=\"test\"></a>Test</h2></div>"] (let [htmlString "<div><h2><a name=\"test\"></a>Test</h2></div>"]
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>" (is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"
(generate-toc htmlString))) (generate-toc htmlString)))
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>" (is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"
(generate-toc htmlString :list-type true))) (generate-toc htmlString :list-type true)))
(is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>" (is (= "<ol class=\"content\"><li><a href=\"#test\">Test</a></li></ol>"
(generate-toc htmlString :list-type :ol))) (generate-toc htmlString :list-type :ol)))
(is (= "<ul class=\"content\"><li><a href=\"#test\">Test</a></li></ul>" (is (= "<ul class=\"content\"><li><a href=\"#test\">Test</a></li></ul>"
(generate-toc htmlString :list-type :ul))))) (generate-toc htmlString :list-type :ul)))))