cryogen-core/src/cryogen_core/compiler.clj

412 lines
17 KiB
Clojure
Raw Normal View History

2014-12-05 15:56:40 +00:00
(ns cryogen-core.compiler
2014-12-04 16:38:48 +00:00
(:require [selmer.parser :refer [cache-off! render-file]]
2015-06-14 10:23:58 +00:00
[selmer.util :refer [set-custom-resource-path!]]
2014-12-04 16:38:48 +00:00
[io.aviso.exception :refer [write-exception]]
[clojure.java.io :refer [copy file reader writer]]
[clojure.string :as s]
[text-decoration.core :refer :all]
[pl.danieljanus.tagsoup :as tagsoup]
[hiccup.core :as hiccup]
2014-12-05 15:56:40 +00:00
[cryogen-core.toc :refer [generate-toc]]
[cryogen-core.sass :as sass]
[cryogen-core.markup :as m]
[cryogen-core.io :refer
[get-resource find-assets create-folder wipe-public-folder copy-resources
copy-resources-from-theme]]
[cryogen-core.sitemap :as sitemap]
[cryogen-core.rss :as rss]))
2014-12-04 16:38:48 +00:00
(cache-off!)
(def public "resources/public")
(defn root-path
"Creates the root path for posts, tags and pages"
[config k]
2014-12-04 16:38:48 +00:00
(if-let [root (k config)]
(str "/" root "/") "/"))
(defn re-pattern-from-ext
"Creates a properly quoted regex pattern for the given file extension"
[ext]
(re-pattern (str (s/replace ext "." "\\.") "$")))
(defn find-posts
"Returns a list of markdown files representing posts under the post root in templates/md"
[{:keys [post-root ignored-files]} mu]
(find-assets (str "templates/" (m/dir mu) post-root) (m/ext mu) ignored-files))
2014-12-04 16:38:48 +00:00
(defn find-pages
"Returns a list of markdown files representing pages under the page root in templates/md"
[{:keys [page-root ignored-files]} mu]
(find-assets (str "templates/" (m/dir mu) page-root) (m/ext mu) ignored-files))
2014-12-04 16:38:48 +00:00
(defn parse-post-date
"Parses the post date from the post's file name and returns the corresponding java date object"
[file-name date-fmt]
2014-12-04 16:38:48 +00:00
(let [fmt (java.text.SimpleDateFormat. date-fmt)]
(.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")))
2014-12-04 16:38:48 +00:00
(defn page-uri
"Creates a page uri from the page file name"
[page-name {:keys [blog-prefix page-root]} mu]
(str blog-prefix page-root (s/replace page-name (re-pattern-from-ext (m/ext mu)) ".html")))
2014-12-04 16:38:48 +00:00
(defn read-page-meta
"Returns the clojure map from the top of a markdown page/post"
[page rdr]
2014-12-04 16:38:48 +00:00
(try
(read rdr)
(catch Exception _
(throw (IllegalArgumentException. (str "Malformed metadata on page: " page))))))
(defn page-content
"Returns a map with the given page's file-name, metadata and content parsed from
the file with the given markup."
[page config markup]
2014-12-04 16:38:48 +00:00
(with-open [rdr (java.io.PushbackReader. (reader page))]
(let [page-name (.getName page)
file-name (s/replace page-name (re-pattern-from-ext (m/ext markup)) ".html")
2014-12-04 16:38:48 +00:00
page-meta (read-page-meta page-name rdr)
content ((m/render-fn markup) rdr config)]
{:file-name file-name
:page-meta page-meta
:content content})))
(defn merge-meta-and-content
"Merges the page metadata and content maps, adding :toc if necessary."
[file-name page-meta content]
(merge
(update-in page-meta [:layout] #(str (name %) ".html"))
{:file-name file-name
:content content
:toc (if (:toc page-meta) (generate-toc content))}))
(defn parse-page
"Parses a page/post and returns a map of the content, uri, date etc."
[page config markup]
(let [{:keys [file-name page-meta content]} (page-content page config markup)]
(merge
(merge-meta-and-content file-name page-meta content)
{:uri (page-uri file-name config markup)
:page-index (:page-index page-meta)})))
(defn parse-post
"Return a map with the given post's information."
[page config markup]
(let [{:keys [file-name page-meta content]} (page-content page config markup)]
(merge
(merge-meta-and-content file-name page-meta content)
(let [date (if (:date page-meta)
(.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. "yyyy MMMM" (java.util.Locale. "en"))
formatted-group (.format archive-fmt date)]
{:date date
:formatted-archive-group formatted-group
:parsed-archive-group (.parse archive-fmt formatted-group)
:uri (post-uri file-name config markup)
:tags (set (:tags page-meta))}))))
2014-12-04 16:38:48 +00:00
(defn read-posts
"Returns a sequence of maps representing the data from markdown files of posts.
Sorts the sequence by post date."
[config]
(->> (mapcat
(fn [mu]
(->>
(find-posts config mu)
(map #(parse-post % config mu))))
(m/markups))
2014-12-04 16:38:48 +00:00
(sort-by :date)
reverse))
(defn read-pages
"Returns a sequence of maps representing the data from markdown files of pages.
Sorts the sequence by post date."
[config]
(->> (mapcat
(fn [mu]
(->>
(find-pages config mu)
(map #(parse-page % config mu))))
(m/markups))
2014-12-04 16:38:48 +00:00
(sort-by :page-index)))
(defn tag-post
"Adds the uri and title of a post to the list of posts under each of its tags"
[tags post]
2014-12-04 16:38:48 +00:00
(reduce (fn [tags tag]
(update-in tags [tag] (fnil conj []) (select-keys post [:uri :title :content :date])))
2014-12-04 16:38:48 +00:00
tags (:tags post)))
(defn group-by-tags
"Maps all the tags with a list of posts that contain each tag"
[posts]
2014-12-04 16:38:48 +00:00
(reduce tag-post {} posts))
(defn group-for-archive
"Groups the posts by month and year for archive sorting"
[posts]
2014-12-04 16:38:48 +00:00
(->> posts
(map #(select-keys % [:title :uri :date :formatted-archive-group :parsed-archive-group]))
(group-by :formatted-archive-group)
(map (fn [[group posts]]
{:group group
:parsed-group (:parsed-archive-group (get posts 0))
:posts (map #(select-keys % [:title :uri :date]) posts)}))
(sort-by :parsed-group)
reverse))
(defn tag-info
"Returns a map containing the name and uri of the specified tag"
[{:keys [blog-prefix tag-root]} tag]
2014-12-04 16:38:48 +00:00
{:name (name tag)
:uri (str blog-prefix tag-root (name tag) ".html")})
(defn add-prev-next
"Adds a :prev and :next key to the page/post data containing the title and uri of the prev/next
post/page if it exists"
[pages]
2014-12-04 16:38:48 +00:00
(map (fn [[prev target next]]
(assoc target
:prev (if prev (select-keys prev [:title :uri]) nil)
:next (if next (select-keys next [:title :uri]) nil)))
2014-12-04 16:38:48 +00:00
(partition 3 1 (flatten [nil pages nil]))))
(defn group-pages
"Separates the pages into links for the navbar and links for the sidebar"
[pages]
2014-12-04 16:38:48 +00:00
(let [{navbar-pages true
sidebar-pages false} (group-by #(boolean (:navbar? %)) pages)]
(map (partial sort-by :page-index) [navbar-pages sidebar-pages])))
(defn compile-pages
"Compiles all the pages into html and spits them out into the public folder"
[{:keys [blog-prefix page-root] :as params} pages]
2014-12-04 16:38:48 +00:00
(when-not (empty? pages)
(println (blue "compiling pages"))
(create-folder (str blog-prefix page-root))
(doseq [{:keys [uri] :as page} pages]
(println "\t-->" (cyan uri))
(spit (str public uri)
2015-07-06 02:02:42 +00:00
(render-file (str "/html/" (:layout page))
(merge params
2014-12-04 16:38:48 +00:00
{:servlet-context "../"
:page page
:uri uri}))))))
2014-12-04 16:38:48 +00:00
(defn compile-posts
"Compiles all the posts into html and spits them out into the public folder"
[{:keys [blog-prefix post-root disqus-shortname] :as params} posts]
2014-12-04 16:38:48 +00:00
(when-not (empty? posts)
(println (blue "compiling posts"))
(create-folder (str blog-prefix post-root))
(doseq [post posts]
(println "\t-->" (cyan (:uri post)))
(spit (str public (:uri post))
(render-file (str "/html/" (:layout post))
(merge params
2014-12-04 16:38:48 +00:00
{:servlet-context "../"
:post post
:disqus-shortname disqus-shortname
:uri (:uri post)}))))))
2014-12-04 16:38:48 +00:00
(defn compile-tags
"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]
2014-12-04 16:38:48 +00:00
(when-not (empty? posts-by-tag)
(println (blue "compiling tags"))
(create-folder (str blog-prefix tag-root))
(doseq [[tag posts] posts-by-tag]
(let [{:keys [name uri]} (tag-info params tag)]
2014-12-04 16:38:48 +00:00
(println "\t-->" (cyan uri))
(spit (str public uri)
(render-file "/html/tag.html"
(merge params
{:servlet-context "../"
:name name
:posts posts
:uri uri})))))))
2014-12-04 16:38:48 +00:00
(defn compile-tags-page [{:keys [blog-prefix] :as params}]
(println (blue "compiling tags page"))
(spit (str public blog-prefix "/tags.html")
(render-file "/html/tags.html"
(merge params
{:uri (str blog-prefix "/tags.html")}))))
(defn create-preview
"Creates a single post preview"
[blocks-per-preview post]
(merge (select-keys post [:title :author :date :uri])
{:content (or (re-find #".+?(?=<!--more-->)" (:content post))
(->> ((tagsoup/parse-string (:content post)) 2)
(drop 2)
(take blocks-per-preview)
hiccup/html))}))
(defn create-previews
"Returns a sequence of vectors, each containing a set of post previews"
[posts-per-page blocks-per-preview posts]
(->> posts
(reduce (fn [v post] (conj v (create-preview blocks-per-preview post))) [])
(partition-all posts-per-page)
(map-indexed (fn [i v] {:index (inc i) :posts v}))))
(defn create-preview-links
"Turn each vector of previews into a map with :prev and :next keys that contain the uri of the
prev/next preview page"
[previews blog-prefix]
(mapv (fn [[prev target next]]
(merge target
{:prev (if prev (str blog-prefix "/p/" (:index prev)) nil)
:next (if next (str blog-prefix "/p/" (:index next)) nil)}))
(partition 3 1 (flatten [nil previews nil]))))
(defn compile-preview-pages
"Compiles a series of pages containing 'previews' from each post"
[{:keys [blog-prefix posts-per-page blocks-per-preview] :as params} posts]
(when-not (empty? posts)
(let [previews (-> (create-previews posts-per-page blocks-per-preview posts)
(create-preview-links blog-prefix))
previews (if (> (count previews) 1) (assoc-in previews [1 :prev] (str blog-prefix "/index.html")) previews)]
(create-folder (str blog-prefix "/p/"))
(doseq [{:keys [index posts prev next]} previews]
(spit (if (= 1 index) (str public blog-prefix "/index.html") (str public blog-prefix "/p/" index))
(render-file "/html/previews.html"
(merge params
{:servlet-context (if (= 1 index) "" "../")
:posts posts
:prev-uri prev
:next-uri next})))))))
(defn compile-index
"Compiles the index page into html and spits it out into the public folder"
[{:keys [blog-prefix disqus?] :as params}]
2014-12-04 16:38:48 +00:00
(println (blue "compiling index"))
(spit (str public blog-prefix "/index.html")
(render-file "/html/home.html"
(merge params
2014-12-31 21:55:29 +00:00
{:home true
:disqus? disqus?
:post (get-in params [:latest-posts 0])
:uri (str blog-prefix "/index.html")}))))
2014-12-04 16:38:48 +00:00
(defn compile-archives
"Compiles the archives page into html and spits it out into the public folder"
[{:keys [blog-prefix] :as params} posts]
2014-12-04 16:38:48 +00:00
(println (blue "compiling archives"))
(spit (str public blog-prefix "/archives.html")
(render-file "/html/archives.html"
(merge params
2014-12-04 16:38:48 +00:00
{:archives true
:groups (group-for-archive posts)
:uri (str blog-prefix "/archives.html")}))))
2014-12-04 16:38:48 +00:00
(defn tag-posts
"Converts the tags in each post into links"
[posts config]
2014-12-04 16:38:48 +00:00
(map #(update-in % [:tags] (partial map (partial tag-info config))) posts))
(defn copy-resources-from-markup-folders
"Copy resources from markup folders"
[config]
(copy-resources
(merge config
{:resources (for [mu (m/markups)
t ["posts" "pages"]] (str (m/dir mu) "/" t))
:ignored-files (map #(re-pattern-from-ext (m/ext %)) (m/markups))})))
(defn read-config
"Reads the config file"
[]
(try
(let [config (-> "templates/config.edn"
get-resource
slurp
read-string
(update-in [:blog-prefix] (fnil str ""))
(update-in [:rss-name] (fnil str "rss.xml"))
(update-in [:rss-filters] (fnil seq []))
(update-in [:sass-src] (fnil str "css"))
(update-in [:sass-dest] (fnil str "css"))
(update-in [:post-date-format] (fnil str "yyyy-MM-dd"))
(update-in [:keep-files] (fnil seq []))
(update-in [:ignored-files] (fnil seq [#"^\.#.*" #".*\.swp$"])))]
(merge
config
{:page-root (root-path :page-root config)
:post-root (root-path :post-root config)
:tag-root (root-path :tag-root config)}))
(catch Exception _
(throw (IllegalArgumentException. "Failed to parse config.edn")))))
2014-12-04 16:38:48 +00:00
(defn compile-assets
"Generates all the html and copies over resources specified in the config"
[]
2014-12-04 16:38:48 +00:00
(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)
2014-12-04 16:38:48 +00:00
posts (add-prev-next (read-posts config))
pages (add-prev-next (read-pages config))
[navbar-pages sidebar-pages] (group-pages pages)
posts-by-tag (group-by-tags posts)
posts (tag-posts posts config)
params (merge config
{:title (:site-title config)
:tags (map (partial tag-info config) (keys posts-by-tag))
:latest-posts (->> posts (take recent-posts) vec)
:navbar-pages navbar-pages
:sidebar-pages sidebar-pages
:archives-uri (str blog-prefix "/archives.html")
:index-uri (str blog-prefix "/index.html")
:tags-uri (str blog-prefix "/tags.html")
:rss-uri (str blog-prefix "/" rss-name)
2015-06-14 10:23:58 +00:00
: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))})]
2014-12-04 16:38:48 +00:00
(set-custom-resource-path! (:theme-path params))
2014-12-04 16:38:48 +00:00
(wipe-public-folder keep-files)
2015-06-14 10:23:58 +00:00
(println (blue "copying theme resources"))
(copy-resources-from-theme config)
2014-12-04 16:38:48 +00:00
(println (blue "copying resources"))
(copy-resources config)
(copy-resources-from-markup-folders config)
(compile-pages params pages)
(compile-posts params posts)
(compile-tags params posts-by-tag)
(compile-tags-page params)
(if previews?
(compile-preview-pages params posts)
(compile-index params))
(compile-archives params posts)
2014-12-04 16:38:48 +00:00
(println (blue "generating site map"))
(spit (str public blog-prefix "/sitemap.xml") (sitemap/generate site-url ignored-files))
(println (blue "generating main rss"))
2014-12-04 16:38:48 +00:00
(spit (str public blog-prefix "/" rss-name) (rss/make-channel config posts))
(println (blue "generating filtered rss"))
(rss/make-filtered-channels public config posts-by-tag)
2014-12-04 16:38:48 +00:00
(println (blue "compiling sass"))
2014-12-25 16:24:25 +00:00
(sass/compile-sass->css!
{:src-sass sass-src
:dest-sass (str "../public" blog-prefix "/" sass-dest)
:ignored-files ignored-files
:base-dir "resources/templates/"})))
2014-12-04 16:38:48 +00:00
(defn compile-assets-timed []
(time
(try
(compile-assets)
(catch Exception e
(if (or (instance? IllegalArgumentException e)
(instance? clojure.lang.ExceptionInfo e))
2014-12-04 16:38:48 +00:00
(println (red "Error:") (yellow (.getMessage e)))
(write-exception e))))))