Added option for post preview pages rather than a single index page. Issue #28

This commit is contained in:
Carmen La 2015-07-08 16:34:39 -04:00
parent 7153e9d522
commit d6941823fd
3 changed files with 124 additions and 72 deletions

View file

@ -1,4 +1,4 @@
(defproject cryogen-core "0.1.23" (defproject cryogen-core "0.1.24"
: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"
@ -12,4 +12,5 @@
[io.aviso/pretty "0.1.18"] [io.aviso/pretty "0.1.18"]
[hiccup "1.0.5"] [hiccup "1.0.5"]
[selmer "0.8.2"] [selmer "0.8.2"]
[pandect "0.5.2"]]) [pandect "0.5.2"]
[clj-tagsoup "0.3.0" :exclusions [org.clojure/clojure]]])

View file

@ -1,18 +1,20 @@
(ns cryogen-core.compiler (ns cryogen-core.compiler
(:require [selmer.parser :refer [cache-off! render-file]] (:require [selmer.parser :refer [cache-off! render-file]]
[selmer.util :refer [set-custom-resource-path!]] [selmer.util :refer [set-custom-resource-path!]]
[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]
[io.aviso.exception :refer [write-exception]] [io.aviso.exception :refer [write-exception]]
[clojure.java.io :refer [copy file reader writer]] [clojure.java.io :refer [copy file reader writer]]
[clojure.string :as s] [clojure.string :as s]
[text-decoration.core :refer :all] [text-decoration.core :refer :all]
[pl.danieljanus.tagsoup :as tagsoup]
[hiccup.core :as hiccup]
[cryogen-core.toc :refer [generate-toc]] [cryogen-core.toc :refer [generate-toc]]
[cryogen-core.sass :as sass] [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 wipe-public-folder copy-resources
copy-resources-from-theme]]
[cryogen-core.sitemap :as sitemap]
[cryogen-core.rss :as rss]))
(cache-off!) (cache-off!)
@ -237,6 +239,51 @@
(merge params (merge params
{:uri (str blog-prefix "/tags.html")})))) {: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)
(assoc-in [1 :prev] (str blog-prefix "/index.html")))]
(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 (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 [blog-prefix disqus?] :as params}]
@ -302,7 +349,7 @@
"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] :as config} (read-config) (let [{:keys [site-url blog-prefix rss-name recent-posts sass-src sass-dest keep-files ignored-files previews?] :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)
@ -316,6 +363,7 @@
:sidebar-pages sidebar-pages :sidebar-pages sidebar-pages
:archives-uri (str blog-prefix "/archives.html") :archives-uri (str blog-prefix "/archives.html")
:index-uri (str blog-prefix "/index.html") :index-uri (str blog-prefix "/index.html")
:tags-uri (str blog-prefix "/tags.html")
:rss-uri (str blog-prefix "/" rss-name) :rss-uri (str 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))})]
@ -331,7 +379,9 @@
(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)
(compile-index params) (if previews?
(compile-preview-pages params posts)
(compile-index params))
(compile-archives params posts) (compile-archives params posts)
(println (blue "generating site map")) (println (blue "generating site map"))
(spit (str public blog-prefix "/sitemap.xml") (sitemap/generate site-url ignored-files)) (spit (str public blog-prefix "/sitemap.xml") (sitemap/generate site-url ignored-files))

View file

@ -31,7 +31,8 @@
(loop [items headings acc nil _last nil] (loop [items headings acc nil _last nil]
(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) (recur (rest items) acc nil) (if (nil? anchor)
(recur (rest items) acc nil)
(let [entry [:li [:a {:href (str "#" anchor)} (or title (first htext))]] (let [entry [:li [:a {:href (str "#" anchor)} (or title (first htext))]]
jump (compare_index _last tag)] jump (compare_index _last tag)]
(cond (> jump 0) (recur (rest items) (str acc "<ol>" (hiccup/html entry)) tag) (cond (> jump 0) (recur (rest items) (str acc "<ol>" (hiccup/html entry)) tag)