mathblog 0.5 → 0.6
raw patch · 42 files changed
+2155/−1474 lines, 42 filesdep +HTTPdep +JuicyPixelsdep +containersdep ~ConfigFiledep ~HStringTemplatedep ~HUnitbinary-added
Dependencies added: HTTP, JuicyPixels, containers, data-default, deepseq, either, fsnotify, http-server, mtl, network, system-filepath, temporary, url
Dependency ranges changed: ConfigFile, HStringTemplate, HUnit, SHA, bytestring, directory, old-locale, pandoc, pandoc-types, process, test-framework, test-framework-hunit, unix
Files
- CHANGELOG.md +38/−0
- README.md +11/−418
- doc/Makefile +9/−0
- doc/macros.tex +14/−0
- doc/mathblog-manual.pdf binary
- doc/mathblog-manual.tex +474/−0
- doc/scripts/changed-post.sh +19/−0
- doc/scripts/init.sh +9/−0
- doc/scripts/listen-mode.sh +36/−0
- doc/title_page.tex +6/−0
- doc/toc.tex +2/−0
- mathblog.cabal +86/−46
- skel/assets/stylesheets/stylesheet.css +3/−2
- skel/blog.cfg +3/−0
- skel/eq-templates/eq-basic.txt +0/−6
- skel/posts/first-post.txt +3/−1
- skel/templates/listTemplate.html +10/−0
- skel/templates/pageTemplate.html +31/−0
- skel/templates/postTemplate.html +22/−3
- src/MB/Config.hs +17/−12
- src/MB/Files.hs +0/−56
- src/MB/Gen/Index.hs +23/−0
- src/MB/Gen/Post.hs +118/−0
- src/MB/Gen/PostList.hs +31/−0
- src/MB/Gen/RSS.hs +41/−0
- src/MB/Gladtex.hs +0/−92
- src/MB/Gnuplot.hs +0/−110
- src/MB/Initialize.hs +38/−0
- src/MB/Mathjax.hs +0/−58
- src/MB/Processing.hs +26/−21
- src/MB/Processors/Base.hs +22/−0
- src/MB/Processors/Mathjax.hs +17/−0
- src/MB/Processors/Tikz.hs +139/−0
- src/MB/Server.hs +181/−0
- src/MB/Startup.hs +125/−43
- src/MB/TeXMacros.hs +25/−0
- src/MB/Templates.hs +38/−5
- src/MB/Tikz.hs +0/−102
- src/MB/Types.hs +161/−19
- src/MB/Util.hs +98/−125
- src/Main.hs +240/−345
- tests/src/MB/StartupTests.hs +39/−10
+ CHANGELOG.md view
@@ -0,0 +1,38 @@+0.6+---++ * Added support for building with GHC 7.10+ * doc: update manual-generating scripts to assume "mb" is installed a+ cabal sandbox+ * Propagate Pandoc loading errors to top level via EitherT+ * Fix read-then-close (lazy IO) (thanks Thomas M. DuBuisson+ (thomas.dubuisson@gmail.com))+ * Un-bitrot (wrt system-filepath and old-locale/pandoc) (thanks Thomas+ M. DuBuisson (thomas.dubuisson@gmail.com))+ * Update to use Pandoc 1.12, JuicyPixels 3.1+ * Render images at double DPI, then shrink in the HTML (read: support+ retina displays!)+ * Stop using greadlink in manual scripts+ * Move Mathjax configuration from Haskell code to page template (fixes #11)+ * Add browser reloading support to blog regeneration+ * Add built-in HTTP server in listen mode+ * manual: actually run "mb" to generate "mb" output in the manual+ * Discontinue support for Gnuplot+ * Start to use fsnotify+ * Added manual+ * mathjax: include cancel extension+ * bugfix: use correct indexing when generating next/prev post links+ * Remove support for gladtex+ * bugfix: only consider .html files when checking for modified templates+ * Feature: parse date from blog post header and include in RSS feed+ * Feature: add support for page-wide TeX macro blocks (#tex-macros) for+ both Mathjax and TikZ+ * Add more packages to TikZ preamble, enable AMS extensions in mathjax+ * Mathjax: turn on AMS equation numbering, also print tikz source on+ tikz failure+ * tikz: add calc tikzlibrary+ * Rename -h/--html-dir to -o/--output-dir, add -h/--help and -v/--version+ * CHANGE: rename MB_BASE_DIR to MB_DATA_DIR, --baseDir to --data-dir;+ also remove default output directory behavior+ * Fixed typos in the documentation (thanks Peter Simons+ (peter.1.simons@nokia.com))
README.md view
@@ -1,4 +1,3 @@- mathblog ======== @@ -7,16 +6,20 @@ - Extended Markdown input syntax as supported by the Pandoc library - - inline and block-level TeX math rendered by MathJax or LaTeX+ - Inline and block-level TeX math rendered by MathJax or LaTeX - - Function graphing with Gnuplot or the TikZ / pgfplots LaTeX- packages+ - Function graphing with TikZ / pgfplots LaTeX packages - Integration of Javascript-based web services such as Disqus - Template-based document rendering with support for layout and style customization +Getting Started+===============++See the manual PDF in doc/.+ Project vision ============== @@ -67,422 +70,12 @@ - Math typesetting packages: - - GladTex and LaTeX for math typesetting if you choose `gladtex`- for the value of the 'mathBackend' configuration setting.- GladTex 1.3 is required for best results. GladTex renders LaTeX- snippets to images. This is the recommended backend for math- typesetting. See <https://sourceforge.net/projects/gladtex/>- - MathJax if you choose `mathjax` for the value of the- 'mathBackend' configuration setting. mathblog uses the MathJax+ `mathBackend` configuration setting. mathblog uses the MathJax CDN for MathJax resources. - Function graph plotting packages: - - The TikZ and pgfplots LaTeX packages if you choose `gnuplot` for- the value of the 'eqBackend' configuration setting. This is the- recommended backend for function graph plotting.-- - GNUplot if you choose `gnuplot` for the value of the 'eqBackend'- configuration setting.--Creating a blog-===============--To begin, set the following environment variable:-- `MB_BASE_DIR`--This is the location of your blog files on the filesystem. It must be-an absolute path. If you would rather use a command-line parameter,-specify `-d` or `--baseDir` when running `mb`. The command line-directory parameter will always override the environment variable if-it is set.--Once you've set the environment variable, just run `mb -i`. It will-take care of setting up a new blog data directory for you, complete-with some default pages and a default first blog post:--~~~-$ export MB_BASE_DIR=`pwd`/myBlog-$ mb -i-Blog directory: .../myBlog-Config file: .../myBlog/blog.cfg-Setting up data directory using skeleton: /.../skel-Configuration file changed; regenerating all content.-Templates changed; regenerating accordingly.-Posts changed:- first-post.txt-Post index changed; regenerating next/previous links.-Rendering first-post-Done.-~~~--Configuring the Blog-====================--The default blog configuration file is called `blog.cfg`. This file-contains information about you which may be included in the generated-pages. The configuration file `blog.cfg` must have the following-fields set:-- - `baseUrl`-- The base URL of your blog; this URL will be used to generate some- links in the blog's pages where absolute URLs matter. Otherwise,- relative URLs will be used, with an assumption that your blog is- hosted at the root of a domain.-- - `title`-- The title of your blog, such as "My math blog".-- - `authorName`-- Your name (for the RSS feed metadata and the page footer).-- - `authorEmail`-- Your e-mail address (for the RSS feed metadata only).-- - `mathBackend`-- The backend used to render TeX math expressions. Can be either- `gladtex` or `mathjax`. If `gladtex`, you will need the latest- version of the `gladtex` program for best results. No special- configuration is necessary for MathJax, as mathblog's default- templates use CDN resources for MathJax.-- - `eqBackend`-- The backend used to render function graphs. Can be either `tikz`- or `gnuplot`. See the Function Graph Embedding section below for- details.--Note that if you pick a math or function graphing backend which isn't-supported by your system, `mb` will emit errors when processing your-posts.--All of the above fields can be accessed in templates using the syntax-described in "Customizing your blog" below.--Serving the Blog-================--By default, `mb` will use `$(MB_BASE_DIR)/html` as its output-directory, but if you want the generated files to be installed-somewhere else, use the `-h` option.--To serve your blog files you can either make the output directory a-document root for your web server or virtual host, or you can symlink-the output directory to the location of choice. The mathblog-directory itself is not intended to be in your web server's document-tree because it contains many files that shouldn't be served to users.--Start up a web server pointing at the output directory and take a-look.--Now you might want to edit or create a new post, or even remove one.-Just edit the appropriate file in `posts/` accordingly and re-run-`mb`. Here's an example of adding a new post:--~~~-$ mb-mb: using base directory ".../myBlog"-Posts changed:- first-post.txt-Rendering 1 post(s)...-Rendering first-post-Done.-~~~--When to run `mb`-================--`mb` looks at the modification times of your post files in `posts/`,-the config file, template files, and the post index (see below) when-determining when to regenerate content. It also looks for new posts-that haven't been rendered in the past. The rule of thumb is: re-run-mb whenever you make any changes to:-- - templates in `templates/`- - post files in `posts/`- - the post index, `posts/posts-index`- - `blog.cfg`--Modifying a post will cause that post to be re-rendered, but-modifiying the configuration file will cause ALL posts to be-re-rendered (since the configuration file contains values that will-affect all hyperlinks contained inside each post). `mb` will always-rebuild the portions of each page affected by template changes even if-post source files are unchanged.--Post format-===========--Posts are formatted in Markdown and support the extended Markdown-syntax as implemented by Pandoc. The only important convention to-note is that the post title goes on the first line of the file-following a percent sign, as follows:--~~~-%My First Post--First paragraph starts here.-~~~--Running `mb` in "listen" mode-=============================--Ordinarily, you'll just run `mb` once in a while to update your-content. But if you're in the middle of authoring a new post and you-want to see what it looks like as you edit it rather than run `mb` by-hand periodically, you can run `mb` in "listen" mode; this means that-mb will run forever, peroidically scanning the filesystem for changes-to your blog posts and other data files and regenerate them and copy-them to the output directory when it detects a change. Running-mathblog in listen mode is simple:--~~~-$ mb -l-Waiting for changes in .../blog ...-Blog directory: .../blog-Config file: .../blog/blog.cfg-Post index changed; regenerating next/previous links.-Done.--Blog directory: /.../blog-Config file: .../blog/blog.cfg-Configuration file changed; regenerating all content.-Rendering 1 post(s)...-Rendering first-post-Done.--Blog directory: /Users/cygnus/blog3-Config file: .../blog/blog.cfg-Posts changed:- first-post.txt-Rendering 1 post(s)...-Rendering first-post-Done.-~~~--Above I ran `mb` in listen mode and then modified the post index, then-the blog config file, then one of the posts. In each case `mb`-detected the change and ran its typical regeneration routine.--Customizing your blog-=====================--It's likely that you'll want to customize the look and feel of your-blog. To this end, mathblog generates the pages of your blog by-assembling various pieces of the page to create the final result. The-biggest piece of a generated page is the blog post itself, but the-surrounding elements are read from various files that are created by-mathblog when it creates your blog data directory. These files are-stored in the `templates/` subdirectory of your blog data directory-and are as follows:-- - `templates/rssTemplate.xml`-- This is the template used to generate your RSS feed.-- - `templates/pageTemplate.html`-- This file makes up the overall structure of every page on the- blog.-- - `templates/postTemplate.html`-- This file makes up the structure of the post portion of the page,- for pages which show posts (i.e., not the post index).--The templates mentioned above are StringTemplate templates and are-processed with the HStringTemplate library. The following template-placeholders are supported in each template:-- - `$title$`, `$baseUrl$`, `$authorName$`, `$authorEmail$`-- These placeholders all correspond directly to fields on the- `blog.cfg` configuration file.-- - `$extraPageHead$`-- Content to be placed in the `<HEAD>` tag of the page, such as- javascript tags, stylesheets, etc. You'll need to ensure that- this is somewhere in your `<HEAD>` tag if you want to use mathblog- features which may need to load extra resources.--These placeholders are supported in the post template:-- - `$jsInfo$`-- A brief javascript used to provide information about the page to- other javascripts (see "Other features" below for usage).-- - `$nextPrevLinks$`-- HTML displaying the "next" and "previous" links for older/newer- posts.-- - `$post$`-- The body of the post itself.--These placeholders are supported in the page template:-- - `$content$`-- The content of the page to be rendered.--Blog Assets-===========--The default blog directory created by `mb` also includes an `assets`-directory. Whenever `mb` detects changes in your blog post or asset-files (or if you run `mb -f`), everything in `assets/` will be copied-recursively into the output directory. This way, if you have custom-stylesheets or other files which need to be available, they can be-kept in your data directory and published with the rest of the-generated content.--Function Graph Embedding-========================--mathblog supports inline scripts for rendering function graphs. Right-now, mathblog supports Gnuplot and the TikZ / pgfplots LaTeX packages.-Set the 'eqBackend' configuration option (see above) to choose a-backend.--Gnuplot----------To specify a Gnuplot function graph in a blog post, we overload the-Pandoc code block syntax. Here's an example of a Gnuplot graph:-- ~~~ {#eq-basic}- f(x) = x- plot [-5.0:5.0] [-5.0:5.0] f(x) lt rgb "blue"- ~~~--This defines a single function and plots it in blue over the specified-intervals. The most important part is the "#eq-basic" bit: this-specifies the equation preamble to use when generating the output-image. This string refers to this preamble file in your blog-directory:-- `eq-preambles/eq-basic.txt`--This file contains the commands responsible for determining the output-image size and axis configuration. The contents of the code block-that you write get appended to the contents of the preamble file you-specify to result in the full gnuplot script, whose output gets-embedded in the page. We use these templates to make it easier to-create many graphs that have the same general structure (e.g., axis-configuration, image size) without having to repeat the full gnuplot-script each time.--You can create other gnuplot premables to suit your needs; just-reference them in the code block in the same way. For example, you-might create eq-preambles/eq-fancy.txt, in which case the code block-syntax to use it is:-- ~~~ {#eq-fancy}- <your script here>- ~~~--TikZ / pgfplots------------------To specify a TikZ / pgfplots function graph in a blog post, we-overload the Pandoc code block syntax. Here's an example of a TikZ-figure:-- ~~~ {#tikz}- \begin{axis}[- minor tick num=3,- axis y line=center,- axis x line=middle,- ]-- \addplot[smooth,mark=none,blue] plot coordinates {- (-1,-1)- (2.95,2.95)- };- ~~~--This is a LaTeX fragment which will automatically be embedded in a-`tikzpicture` environment and rendered to an image within the blog-post. For more information on the powerful TikZ / pgfplots packages,-please see <https://sourceforge.net/projects/pgfplots/>--Styling Function Graphs with CSS-----------------------------------Note that the Pandoc syntax also allows us to assign CSS class names-to the code block, and mathblog passes these through to the generated-image. So if you wanted to wrap your text around the generated image,-you could create a CSS class like this:-- .eq-right {- float: right;- }--and then assign it to your equation graph like this:-- ~~~ {#eq-basic .eq-right}- ...- ~~~--For more information on the code block syntax, please see:-- <http://johnmacfarlane.net/pandoc/README.html#delimited-code-blocks>--Other features-==============--Since mathblog doesn't provide many moving parts, it's up to you to-outsource various web site features, such as comments. I've-successfully integrated mathblog with the Disqus comments service. To-do this, some javascript needs to be embedded in the blog pages.-Disqus works best when you supply it with a page identifier so it can-guarantee that comments are post-specific rather than URL-specific.-The way mathblog makes this possible is by exposing a JavaScript-variable to other scripts in your page:-- Blog.pageName = "foobar-baz";--This variable name can be used by scripts you embed, such as with-Disqus comment forms:-- var disqus_identifier = Blog.pageName;--Controlling Post Order-======================--Whenever you add a new post, mb automatically updates the "post-index", a file called `posts-index` in the post source directory.-This file lists the filenames of all posts from newest to oldest. By-default, new posts get added to the beginning of the list, as you-would expect. Any new posts added to the list are sorted by-modification time so that the newest post on disk appears earlier in-the index. This feature exists to make it possible for older posts to-be updated without changing their ordering in the overall sequence of-posts.--At any time, you can edit the index to reorder the posts as you see-fit. `mb` will preserve ordering of posts already in the index when-you run it in the future.--`mb` will also take care of removing posts from the index if they've-been removed from the post source directory.--Afterword-=========--I personally use this software package but I'll be pleased if others-find it useful. In addition, I'm open to accepting contributions on-the project if they're consistent with what I've outlined above.-Happy blogging!--Jonathan Daugherty (<drcygnus@gmail.com>)+ - The TikZ and pgfplots LaTeX packages if you set `tikz = yes` in+ your config. This is the recommended backend for function graph+ plotting.
+ doc/Makefile view
@@ -0,0 +1,9 @@++mathblog-manual.pdf: *.tex ch?/*.tex+ # Run it twice so the TOC gets generated properly+ pdflatex -halt-on-error -shell-escape mathblog-manual.tex+ pdflatex -halt-on-error -shell-escape mathblog-manual.tex++clean:+ rm -f *~ *.dvi *.pdf *.log *.aux *.toc *.out+ rm -f ch?/*.aux ch?/*~
+ doc/macros.tex view
@@ -0,0 +1,14 @@+% Custom macros.++\newcommand{\mathblogversion}{0.6}++\newcommand{\fw}[1]{\texttt{#1}}+\newcommand{\mathblog}{\fw{mathblog}}++\newcommand{\blogexample}[1]{+ \colorbox{blue!10}{+ \begin{minipage}{0.96\textwidth}+ \VerbatimInput[frame=none,samepage=true]{|"./scripts/#1.sh"}+ \end{minipage}+ }+}
+ doc/mathblog-manual.pdf view
binary file changed (absent → 138833 bytes)
+ doc/mathblog-manual.tex view
@@ -0,0 +1,474 @@+\documentclass[11pt, letterpaper, oneside, titlepage]{book}+% Use Palatino fonts.+\renewcommand{\rmdefault}{ppl}+\renewcommand{\ttdefault}{pcr}++% For smarter references.+\usepackage{varioref}++% For embedding the output of "mb" usage demo scripts.+\usepackage{fancyvrb}++\usepackage[usenames,dvipsnames]{xcolor}++% For hyperlinks.+\usepackage{hyperref}+\hypersetup{colorlinks,citecolor=blue,%+ filecolor=red,linkcolor=blue,%+ urlcolor=blue}++\usepackage{tikz}+\usetikzlibrary{intersections,backgrounds,fit,calc,positioning}+\usepackage{pgfplots}++% Customize document dimensions.+\addtolength{\hoffset}{-0.5in}+\addtolength{\textwidth}{1.0in}+\setlength{\topmargin}{0in}+\setlength{\parskip}{0.1in}+\setlength{\parindent}{0in}++\begin{document}++\include{macros}+\include{title_page}+\include{toc}++\chapter{Introduction}++\mathblog\ is a program targeted at people who want to write+statically-generated, mathematically-themed weblogs. It supports:++\begin{itemize}+\item{Extended Markdown input syntax as supported by the Pandoc+ library}+\item{Inline and block-level \TeX\ math rendered by MathJax}+\item{Function graphing and drawing with the TikZ \LaTeX\ package}+\item{Support for integration of Javascript-based web services such as+ Disqus}+\item{Template-based document rendering with support for layout and+ style customization}+\item{A built-in web server with automatic page reloading for easy+ blog post authoring}+\end{itemize}++\section{Project Vision}++I wrote \mathblog\ with a very specific set of requirements in mind,+motivated by the following principles:++\begin{itemize}+\item{A blog should be easy to create, host, and update.}+\item{A blog should be easy to maintain.}+\item{I should be able to edit posts in my editor of choice and write+ them in an intelligent textual markup language.}+\item{It should be easy to embed high-quality mathematical symbols and+ equations in the blog posts.}+\end{itemize}++As a result, \mathblog\ has the following features:++\begin{itemize}+\item{The software is composed of a single executable which will+ automatically take care of creating your blog and regenerating pages+ when your blog post markup changes.}+\item{All content is stored in plain text files and is generated+ statically. No database or web framework is used and no resident+ processes are required to serve your content.}+\item{\mathblog's generated output files can be hosted by any web+ server.}+\item{\mathblog\ provides a built-in web server for easy blog post+ authoring.}+\item{Blog posts are written in the Markdown format with extensions,+ as supported by the Pandoc document converter.}+\item{Math is embedded with \verb|$...$| (or \verb|\(...\)|) for inline math+ and \verb|$$...$$| (or \verb|\[...\]|) for block-level math.}+\end{itemize}++These features have some nice advantages; your blog content is+cacheable and can be subjected to revision control. Posts are easy to+edit and editing doesn't require a web browser. The static file+representation model means you can compose a blog post on your laptop+and get it just right using a local installation of \mathblog, then+push it up to your server to post it to your public blog.++I personally use this software package but I'll be pleased if others+find it useful. In addition, I'm open to accepting contributions on+the project if they're consistent with the goals I've outlined above.++Happy blogging!++\chapter{Using \mathblog}++The main program provided by the \mathblog\ package is the program+\fw{mb}. This program takes care of initializing new blog data+directories, detecting changes in your files, regenerating the right+HTML output files into your output directory, and even serving them+via HTTP while you work.++\fw{mb} needs to know about two directories: the \textit{data+ directory} where your post input files and templates will be kept,+and the \textit{output directory} where the HTML version of your blog+will be generated. \fw{mb} has two ways of knowing about both of+these directories: you can set environment variables or you can pass+command-line flags to \fw{mb}:++\begin{itemize}+\item{Data directory: set \fw{MB\_DATA\_DIR} in the environment or pass+ the \fw{-d} option to \fw{mb}.}+\item{Output directory: set \fw{MB\_OUTPUT\_DIR} in the environment or+ pass the \fw{-o} option to \fw{mb}.}+\end{itemize}++Any command line parameters given to \fw{mb} will always take+precedence over any environment variables.++\section{Step 1: Create}++Once you've chosen your data and output directories, run \fw{mb -i}.+It will take care of setting up a new blog data directory for you,+complete with some default pages and a default first blog post:++\blogexample{init}++The directory structure of the new blog data directory is as follows:++\begin{itemize}+\item{\fw{blog.cfg} - The blog configuration file.}+\item{\fw{posts/} - Blog post files (``\fw{*.txt}'').}+\item{\fw{posts/posts-index} - A special text file called the+ \textit{posts index}. This file contains a list of posts in the+ order in which they should be listed on the blog. It gets updated+ by \mathblog\ when new posts are created, but you can edit the file+ to change the ordering if you need to. For more information, see+ Section \ref{sec:postsindex}.}+\item{\fw{templates/} - Templates used to generate the blog post+ pages, post listing page, and RSS feed. These templates are+ StringTemplate templates.}+\item{\fw{assets/} - The directory where you can put arbitrary files+ to be copied to the HTML output directory. \mathblog\ will copy+ \fw{assets/foo} to \fw{\$MB\_OUTPUT\_DIR/foo}.}+\end{itemize}++\section{Step 2: Configure}+\label{sec:configuration}++\mathblog\ creates a default ``INI-style'' blog configuration file in+your data directory called \fw{blog.cfg}. It contains information+which may be included in the generated pages. The configuration file+must have the following fields set:++\begin{itemize}+\item{\fw{baseUrl} - The base URL of your blog; this URL will be used+ to generate some links in the blog's pages where absolute URLs+ matter. URL generation assumes that your blog is hosted at the root+ of a domain. The base URL corresponds to the output directory.}+\item{\fw{title} - The title of your blog, such as "My math blog".}+\item{\fw{authorName} - Your name (for the RSS feed metadata and the+ page footer).}+\item{\fw{authorEmail} - Your e-mail address (for the RSS feed+ metadata only).}+\item{\fw{mathBackend} - The backend used to render \TeX\ math+ expressions. Right now the only possible value is \fw{mathjax}. No+ special configuration is necessary for MathJax, as \mathblog's+ default templates use CDN resources for MathJax.}+\item{\fw{tikz} - Whether to permit the use of the Tikz+ \LaTeX\ package to create diagrams and function plots. Set to+ \fw{yes}, \fw{on}, or \fw{1} to enable. Disabled by default.}+\end{itemize}++All of the above fields can be accessed in templates using the syntax+described in Section \ref{sec:customizing} below.++\section{Step 3: Edit}++Now you might want to edit or create a new post or remove one. Start+by editing the appropriate file in \fw{posts/} and then run \fw{mb}.+To create a new blog post, just create a new file ending in+``\fw{.txt}'' in the \fw{posts/} subdirectory. Here's an example of+running \fw{mb} after modifying an existing post:++\blogexample{changed-post}++Ordinarily, you might run \fw{mb} once in a while to update your+output directory. But if you're in the middle of authoring a new post+and you want to see what it looks like as you edit it rather than run+\fw{mb} by hand repeatedly, you can run \fw{mb} in ``listen'' mode; in+listen mode, \fw{mb} will start a lightweight web server and serve+your blog locally while you edit it. If you open a web browser to one+of your blog posts, it will automatically reload whenever you make a+change to one of your blog files!++Here's a listen mode example:++\blogexample{listen-mode}++Above I ran \fw{mb} in listen mode and then modified the posts index,+then the blog config file, then one of the posts. In each case+\fw{mb} detected the change and ran its usual regeneration routine.++You can set the hostname and port that \mathblog\ uses to serve the+blog; see the \fw{mb -h} output.++\subsection{Blog Post Format}++Posts are formatted in Markdown and support the extended Markdown+syntax as implemented by Pandoc. The only important convention to+note is that the post title, author, and date values go on the first+three lines of the file as follows:++\begin{verbatim}+% My First Post+% Author Name+% August 4, 1976++First paragraph starts here.+\end{verbatim}++Dates in the blog post header formatted as ``\fw{<MONTH> <DAY>,+ <YEAR>}'' will be parsed and used to generate the RSS feed+publication date.++\section{When Should I Run \fw{mb}?}++\fw{mb} looks at the modification times of the post files in+\fw{posts/}, the config file, template files, asset files, and the+posts index (see Section \ref{sec:postsindex}) when determining when+to regenerate content. It also looks for new posts that haven't been+rendered in the past. The rule of thumb is: re-run \fw{mb} whenever+you make any changes to anything in your blog data directory.++Modifications a post file will cause that post to be re-rendered, but+modifications the configuration file or templates will cause ALL posts+to be re-rendered since those changes impact how all pages are+generated.++\section{Customization}+\label{sec:customizing}++It's likely that you'll want to customize the look and feel of your+blog. To this end, \mathblog\ generates the pages of your blog by+assembling various pieces of the page to create the final result. The+biggest piece of a generated page is the blog post itself, but the+surrounding elements are read from various files that are created by+\mathblog\ when it creates your blog data directory. These files are+stored in the \fw{templates/} subdirectory of your blog data directory+and are as follows:++\begin{itemize}+\item{\fw{templates/rssTemplate.xml} - This is the template used to+ generate your RSS feed.}+\item{\fw{templates/pageTemplate.html} - This file makes up the+ overall structure of every page on the blog.}+\item{\fw{templates/postTemplate.html} - This file makes up the+ structure of the post portion of the page, for pages which show+ posts (i.e., not the posts index).}+\item{\fw{templates/listTemplate.html} - This file is the template+ used to generate the "all posts" page. Once generated, the+ all-posts listing is then embedded in the page template.}+\end{itemize}++The templates mentioned above are ``StringTemplate'' templates and are+processed with the \fw{HStringTemplate} package. The following+template placeholders are supported in each template:++\begin{itemize}+\item{\fw{\$title\$}, \fw{\$baseUrl\$}, \fw{\$authorName\$},+ \fw{\$authorEmail\$} - These placeholders all correspond directly to+ fields on the `blog.cfg` configuration file.}+\item{\fw{\$extraPageHead\$} - Content to be placed in the \fw{<HEAD>}+ tag of the page, such as javascript tags, stylesheets, etc. You'll+ need to ensure that this is somewhere in your \fw{<HEAD>} tag if you+ want to use \mathblog\ features which may need to load extra+ resources.}+\end{itemize}++These placeholders are provided in the list template:++\begin{itemize}+\item{\fw{\$posts\$} - The list of all posts in the blog, starting with+ the most recent. Each has the same structure as a post in the post+ template (i.e. post.title, post.date, post.url).}+\end{itemize}++These placeholders are supported in the post template:++\begin{itemize}+\item{\fw{\$next\_post\_url\$}, \fw{\$prev\_post\_url\$} - URLs to the+ next (newer) and previous (older) posts relative to the current+ post. One or both may be null.}+\item{\fw{\$post\_html\$} - The rendered body of the post itself.}+\item{\fw{\$post.basename\$} - The base name of the post for use in+ Javascript (see Section \ref{sec:disqus} for an example).}+\item{\fw{\$post.title\$} - The title of the post as found in the Pandoc+ header.}+\item{\fw{\$post.date\$} - The publication date string of the post as+ found in the Pandoc header.}+\item{\fw{\$post\_authors\$} - The list of post author names as found in+ the Pandoc header. This can be rendered as follows:+\begin{verbatim}+Posted by $post_authors; separator=", "$+\end{verbatim}+}+% tex-macros below just happens to hyphenate properly to prevent a long line,+% but keep an eye out: if the surrounding text changes enough, tex-macros may+% become (wrongly) texmacros due to the hyphenation hint.+\item{\fw{\$post.tex\_macros\$} - The combined \TeX\ macros string as+ found in all of the \fw{\#tex\-macros} code blocks in the post. See+ the section on \TeX\ macros for how to use this properly.}+\end{itemize}++These placeholders are supported in the page template:++\begin{itemize}+\item{\fw{\$content\$} - The content of the page to be rendered.}+\end{itemize}++\section{Blog Assets}++The default blog directory created by \fw{mb} also includes an+\fw{assets/} subdirectory. Whenever \fw{mb} detects changes in your+blog post or asset files (or if you run ``\fw{mb -f}''), everything in+\fw{assets/} will be copied recursively into the output directory.+This way, if you have custom stylesheets or other files which need to+be available, they can be kept in your data directory and published+with the rest of the generated content.++\section{\TeX\ Macros}++You can define post-wide \TeX\ macros and then reference them in both+Mathjax expressions and TikZ pictures. To do this, define \TeX macros+inside a ``\fw{tex-macros}'' block as follows:++\begin{verbatim}+~~~ {#tex-macros}+\newcommand{\stuff}{...}+~~~+\end{verbatim}++The block will be removed from the document during preprocessing, but the+macros must be re-embedded in the final output HTML for Mathjax by updating+your post template to include this \textit{before} the post body:++\begin{verbatim}+<div style="display: none;">+\\(+$tex_macros$+\\)+</div>+\end{verbatim}++The \TeX\ macros will automatically be included in generated+\TeX\ source when TikZ processing is performed. This way, you can+write macros and use them everywhere in the document without having to+redefine them inside picture environments.++\section{TikZ Embedding}++\mathblog\ supports inline scripts for rendering function graphs and+diagrams. Right now, only the TikZ \LaTeX\ package is supported. Set+the appropriate configuration option (see Section+\ref{sec:configuration}) to enable it.++To specify a TikZ diagram in a blog post, we overload the Pandoc code+block syntax. Here's an example of a TikZ figure:++\begin{verbatim}+~~~ {#tikz}+\begin{axis}[+ minor tick num=3,+ axis y line=center,+ axis x line=middle,+ ]++\addplot[smooth,mark=none,blue] plot coordinates {+ (-1,-1)+ (2.95,2.95)+};+\end{axis}+~~~+\end{verbatim}++This is a \LaTeX\ fragment which will automatically be embedded in a+\fw{tikzpicture} environment and rendered to an image within the blog+post. The fragment above will produce this picture:++\begin{tikzpicture}+\begin{axis}[+ minor tick num=3,+ axis y line=center,+ axis x line=middle,+ ]++\addplot[smooth,mark=none,blue] plot coordinates {+ (-1,-1)+ (2.95,2.95)+};+\end{axis}+\end{tikzpicture}++\subsection{Styling TikZ Graphics CSS}++Note that the Pandoc syntax also allows us to assign CSS class names+to the code block, and \mathblog\ passes these through to the generated+image. So if you wanted to wrap your text around the generated image,+you could create a CSS class like this:++\begin{verbatim}+.eq-right {+ float: right;+}+\end{verbatim}++and then assign it to your equation graph like this:++\begin{verbatim}+~~~ {#eq-basic .eq-right}+...+~~~+\end{verbatim}++For more information on the code block syntax, please see:++\href{http://johnmacfarlane.net/pandoc/README.html\#fenced-code-blocks}{http://johnmacfarlane.net/pandoc/README.html\#fenced-code-blocks+}++\section{Disqus Integration}+\label{sec:disqus}++Since \mathblog\ doesn't provide many moving parts, it's up to you to+outsource various web site features, such as comments. I've+successfully integrated \mathblog\ with the Disqus comments service. To+do this, some javascript needs to be embedded in the blog pages.+Disqus works best when you supply it with a page identifier so it can+guarantee that comments are post-specific rather than URL-specific.+The way \mathblog\ makes this possible is by exposing a page basename+string so you can configure Disqus properly:++\begin{verbatim}+var disqus_identifier = "$post.basename$";+\end{verbatim}++\section{Controlling Post Order}+\label{sec:postsindex}++Whenever \fw{mb} detects that you have added a new post, it updates the ``posts+index'':++\begin{verbatim}+$MB_DATA_DIR/posts-index+\end{verbatim}++This file lists the filenames of all posts from newest to oldest. By default,+new posts get added to the beginning of the list, as you would expect. Any new+posts added to the list are sorted by modification time so that the newest post+on disk appears earlier in the index. This feature exists to make it possible+for older posts to be updated without changing their ordering in the overall+sequence of posts.++You can edit the index at any time to reorder the posts as you see fit.+\fw{mb} will preserve ordering of posts already in the index when it runs.+\fw{mb} will also take care of removing posts from the index if they've been+removed from the post source directory.++\end{document}
+ doc/scripts/changed-post.sh view
@@ -0,0 +1,19 @@+#!/usr/bin/env bash++function readlink {+ python -c 'import os,sys;print os.path.realpath(sys.argv[1])' "$1"+}++BASE=$(mktemp -d /tmp/mb.XXXXXX)+CBASE=$(readlink $BASE)++# Example for what happens when a post file changes.+MB="../.cabal-sandbox/bin/mb -d $CBASE/blog -o $CBASE/html"++$MB -i >/dev/null+touch -t 999901010000 $CBASE/blog/posts/first-post.txt++echo '$ mb'+$MB | sed "s|$CBASE|...|g"++rm -rf $BASE
+ doc/scripts/init.sh view
@@ -0,0 +1,9 @@+#!/usr/bin/env bash+b=$(mktemp -d /tmp/mb.XXXXXX)++# Data directory initialization example.++echo '$ mb -d .../blog -o .../html -i'+../.cabal-sandbox/bin/mb -d $b/blog -o $b/html -i | sed "s|$b|...|g"++rm -rf $b
+ doc/scripts/listen-mode.sh view
@@ -0,0 +1,36 @@+#!/usr/bin/env bash++function readlink {+ python -c 'import os,sys;print os.path.realpath(sys.argv[1])' "$1"+}++BASE=$(mktemp -d /tmp/mb.XXXXXX)+CBASE=$(readlink $BASE)++# Listen mode example: changes: post index, then the blog config file,+# then one of the posts.+MB="../.cabal-sandbox/bin/mb -d $CBASE/blog -o $CBASE/html"++SEDPAT="s|$CBASE|...|g"++$MB -i >/dev/null++(+ echo '$ mb -l'+ $MB -l &++ sleep 2++ touch $CBASE/blog/posts/posts-index+ sleep 2++ touch $CBASE/blog/blog.cfg+ sleep 2++ touch $CBASE/blog/posts/first-post.txt+ sleep 2++ kill %1+) | sed $SEDPAT++rm -rf $BASE
+ doc/title_page.tex view
@@ -0,0 +1,6 @@+\title{\mathblog\ User's Manual}+\author{+ For \mathblog\ version \mathblogversion\\+ Jonathan Daugherty (\href{mailto:cygnus@foobox.com}{cygnus@foobox.com})+}+\maketitle
+ doc/toc.tex view
@@ -0,0 +1,2 @@+\tableofcontents+\newpage
mathblog.cabal view
@@ -1,7 +1,7 @@ Name: mathblog-Version: 0.5+Version: 0.6 Synopsis: A program for creating and managing a static- weblog with LaTeX math and function graphs+ weblog with LaTeX math and diagrams Description: This package provides a program for creating and managing a statically-generated, VCS-friendly, mathematically-inclined weblog. If you're@@ -10,90 +10,130 @@ embedded function plotting, and the UNIX editor of your choice, then this is the blogging platform for you! For detailed information and a- full feature list, please see the README.+ full feature list, please see the manual PDF in the+ 'doc' directory. Author: Jonathan Daugherty <cygnus@foobox.com>+Homepage: http://jtdaugherty.github.io/mathblog/ Maintainer: Jonathan Daugherty <cygnus@foobox.com> Build-Type: Simple-Cabal-version: >= 1.6+Cabal-version: >= 1.8 License: BSD3 License-file: LICENSE Category: Web Data-Files: README.md+ CHANGELOG.md skel/assets/stylesheets/stylesheet.css skel/templates/postTemplate.html skel/templates/pageTemplate.html skel/templates/rssTemplate.xml- skel/eq-templates/eq-basic.txt+ skel/templates/listTemplate.html skel/posts/first-post.txt skel/blog.cfg+ doc/mathblog-manual.pdf+ doc/Makefile+ doc/title_page.tex+ doc/mathblog-manual.tex+ doc/toc.tex+ doc/macros.tex+ doc/scripts/init.sh+ doc/scripts/changed-post.sh+ doc/scripts/listen-mode.sh Source-Repository head type: git location: git://github.com/jtdaugherty/mathblog.git Executable mb+ GHC-Options: -Wall+ Hs-source-dirs: src+ Main-is: Main.hs Build-depends: base >= 3 && < 5,- directory >= 1.0 && < 1.1.0.2,+ deepseq >= 1.2,+ directory >= 1.0, filepath >= 1.1,- pandoc >= 1.8,- pandoc-types >= 1.8,- unix >= 2.3 && < 2.5,+ pandoc >= 1.12,+ pandoc-types >= 1.12,+ unix >= 2.3, process >= 1.0, time >= 1.1, old-locale >= 1.0,- SHA >= 1.4 && < 1.6,- bytestring >= 0.9 && < 1.0,- HStringTemplate >= 0.6 && < 0.7,- ConfigFile >= 1.1 && < 1.2+ SHA >= 1.4,+ HStringTemplate >= 0.6,+ ConfigFile >= 1.1,+ containers >= 0.3,+ fsnotify >= 0.0.6,+ mtl >= 2.0,+ either >= 3.4,+ http-server >= 1.0.2,+ network,+ temporary >= 1.1.2,+ bytestring,+ url,+ HTTP,+ data-default,+ JuicyPixels >= 3.1 + GHC-Options: -Wall+ Other-modules: Paths_mathblog+ MB.Initialize MB.Config MB.Templates- MB.Files MB.Types MB.Util- MB.Processing MB.Startup- MB.Gladtex- MB.Gnuplot- MB.Mathjax- MB.Tikz+ MB.TeXMacros+ MB.Server - GHC-Options: -Wall+ MB.Gen.Post+ MB.Gen.PostList+ MB.Gen.RSS+ MB.Gen.Index - Hs-Source-Dirs: src- Main-is: Main.hs+ MB.Processing+ MB.Processors.Base+ MB.Processors.Mathjax+ MB.Processors.Tikz Executable mb-tests- Build-depends:- base >= 3 && < 5,- directory >= 1.0 && < 1.2,- filepath >= 1.1,- pandoc >= 1.8,- pandoc-types >= 1.8,- unix >= 2.3 && < 2.5,- process >= 1.0 && < 1.1,- time >= 1.1,- old-locale >= 1.0 && < 1.1,- SHA >= 1.4 && < 1.6,- bytestring >= 0.9 && < 1.0,- HStringTemplate >= 0.6 && < 0.7,- ConfigFile >= 1.1 && < 1.2,- HUnit >= 1.2.2 && < 1.2.5,- test-framework >= 0.3.3 && < 0.6,- test-framework-hunit >= 0.2.6 && < 0.3-- GHC-Options: -Wall- Cpp-Options: -DTESTING-- Hs-Source-Dirs: tests/src,- src-+ Hs-Source-Dirs: tests/src, src Main-is: Main.hs+ CPP-Options: -DTESTING+ GHC-Options: -Wall Other-Modules: InitTests MB.StartupTests++ Build-depends:+ base >= 3 && < 5,+ directory >= 1.0,+ filepath >= 1.1,+ pandoc >= 1.12,+ pandoc-types >= 1.12,+ unix >= 2.3,+ process >= 1.0,+ time >= 1.1,+ old-locale >= 1.0,+ SHA >= 1.4,+ HStringTemplate >= 0.6,+ ConfigFile >= 1.1,+ containers >= 0.3,+ fsnotify >= 0.0.6,+ mtl >= 2.0,+ either >= 3.4,+ http-server >= 1.0.2,+ system-filepath,+ network,+ temporary >= 1.1.2,+ bytestring,+ url,+ HTTP,+ data-default,+ test-framework,+ test-framework-hunit,+ HUnit,+ JuicyPixels >= 3.1
skel/assets/stylesheets/stylesheet.css view
@@ -65,19 +65,20 @@ margin-top: 1em; } .prev-link {+ float: right; color: blue; text-decoration: none; } .prev-link-subdued { color: #aaa;+ float: right; } .next-link {- float: right; color: blue;+ text-decoration: none; } .next-link-subdued { color: #aaa;- float: right; } #footer { border-top: 1px solid #ddd;
skel/blog.cfg view
@@ -2,3 +2,6 @@ title = A blog authorName = Your name here authorEmail = your@email.here+mathBackend = mathjax+tikz = yes+gnuplot = no
− skel/eq-templates/eq-basic.txt
@@ -1,6 +0,0 @@-set term png size 400,300-set samples 500-set zeroaxis-set noborder-set xtics axis nomirror-set ytics axis nomirror
skel/posts/first-post.txt view
@@ -1,4 +1,6 @@-%A first post $p = 0$+% A first post $p = 0$+% Your name here+% January 1, 1970 You've successfully set up your shiny new math blog!
+ skel/templates/listTemplate.html view
@@ -0,0 +1,10 @@+<div id="all-posts">+$posts:{post|+ <div class="listing-entry">+ <span class="post-title">+ <a href="$post.url$">$post.title$</a>+ </span>+ <span class="post-created">Posted $post.date$</span>+ </div>+}$+</div>
skel/templates/pageTemplate.html view
@@ -6,6 +6,37 @@ <link rel="stylesheet" type="text/css" href="http://yui.yahooapis.com/3.2.0/build/cssfonts/fonts-min.css"> <link rel="stylesheet" type="text/css" href="/stylesheets/stylesheet.css"/> <link rel="alternate" type="application/rss+xml" href="$baseUrl$/feed.xml"/>+ <script type="text/x-mathjax-config">+MathJax.Hub.Config(+ {"HTML-CSS": { preferredFont: "TeX", availableFonts: ["STIX","TeX"] },+ tex2jax: {+ element: null,+ preview: "none",+ skipTags: ["script","noscript","style","textarea","pre","code"],+ inlineMath: [+ ['\$', '\$'],+ ["\\\\(", "\\\\)"],+ ],+ displayMath: [+ ['\$\$', '\$\$'],+ ["\\\\[", "\\\\]"],+ ],+ processEscapes: true,+ ignoreClass: "tex2jax_ignore|dno"+ },+ TeX: {+ extensions: ["AMSmath.js","AMSsymbols.js","cancel.js"],+ equationNumbers: { autoNumber: "AMS" },+ noUndefined: { attributes: {+ mathcolor: "red",+ mathbackground: "#FFEEEE",+ mathsize: "90%" }+ }+ },+ messageStyle: "none"+});+</script>+ <script type="text/javascript" src="http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS_HTML"></script> $extraPageHead$ </head> <body>
skel/templates/postTemplate.html view
@@ -1,5 +1,24 @@-$jsInfo$-$nextPrevLinks$+<div id="prev-next-links">+ $if(prev_post_url)$+ <a class="prev-link" href="$prev_post_url$">older »</a>+ $else$+ <a class="prev-link-subdued">older »</a>+ $endif$+ $if(next_post_url)$+ <a class="next-link" href="$next_post_url$">« newer</a>+ $else$+ <a class="next-link-subdued">« newer</a>+ $endif$+</div>++<div style="display: none;">+\\(+$post.tex_macros$+\\)+</div>+ <div id="post">-$post$+ <h1>$post.title$</h1>+ <span class="post-created">Posted $post.date$ by $post_authors; separator=", "$</span>+$post_html$ </div>
src/MB/Config.hs view
@@ -1,14 +1,16 @@ module MB.Config ( readConfig+ , affirmative ) where +import Control.Applicative+import Control.Monad.Trans.Either+import Control.Monad.Trans+import Data.Char (toLower) import Data.ConfigFile.Parser ( parse_file )-import System.Exit- ( exitFailure- ) import Data.Maybe ( fromJust , isNothing@@ -21,23 +23,26 @@ section :: String section = "DEFAULT" -readConfig :: FilePath -> [String] -> IO [(String, String)]+readConfig :: FilePath -> [String] -> EitherT String IO [(String, String)] readConfig path requiredArgs = do- result <- parse_file path+ result <- liftIO $ parse_file path case result of- Left e ->- do- putStrLn $ "Error parsing config file " ++ path ++ ": " ++ show e- exitFailure+ Left e -> left $ "Error parsing config file " ++ path ++ ": " ++ show e Right cfg -> do let pairs = fromJust $ lookup section cfg forM_ requiredArgs $ \k -> when (isNothing $ lookup k pairs) $- do- putStrLn $ "Missing required value for '" ++ k ++ "' in " ++ path- exitFailure+ left $ "Missing required value for '" ++ k ++ "' in " ++ path return pairs++affirmative :: String -> Bool+affirmative s = aff $ toLower <$> s+ where+ aff "yes" = True+ aff "on" = True+ aff "1" = True+ aff _ = False
− src/MB/Files.hs
@@ -1,56 +0,0 @@-module MB.Files where--import System.FilePath- ( (</>)- , takeBaseName- )-import MB.Types- ( Blog(..)- , Post(..)- )--indexHtml :: Blog -> FilePath-indexHtml c = htmlDir c </> "index.html"--imageFilename :: Blog -> String -> FilePath-imageFilename c fn = imageDir c </> fn--rssXml :: Blog -> FilePath-rssXml c = htmlDir c </> "feed.xml"--eqPreambleFile :: Blog -> String -> FilePath-eqPreambleFile config n = eqPreamblesDir config </> n--rssTemplatePath :: Blog -> FilePath-rssTemplatePath c = templateDir c </> "rssTemplate.xml"--listHtml :: Blog -> FilePath-listHtml c = postHtmlDir c </> "index.html"--postIndex :: Blog -> FilePath-postIndex c = postSourceDir c </> "posts-index"--listTmpHtml :: Blog -> FilePath-listTmpHtml c = htmlTempDir c </> "list.html"--firstPost :: Blog -> FilePath-firstPost c = postSourceDir c </> "first-post.txt"--pageTemplatePath :: Blog -> FilePath-pageTemplatePath c = templateDir c </> "pageTemplate.html"--postTemplatePath :: Blog -> FilePath-postTemplatePath c = templateDir c </> "postTemplate.html"--postUrl :: Post -> String-postUrl p = "/posts/" ++ postBaseName p ++ ".html"--postBaseName :: Post -> String-postBaseName = takeBaseName . postFilename--postIntermediateHtml :: Blog -> Post -> FilePath-postIntermediateHtml config post =- postIntermediateDir config </> postBaseName post ++ ".html"--postFinalHtml :: Blog -> Post -> FilePath-postFinalHtml config p = postHtmlDir config </> postBaseName p ++ ".html"
+ src/MB/Gen/Index.hs view
@@ -0,0 +1,23 @@+module MB.Gen.Index+ ( buildIndexPage+ )+where++import Control.Monad+import Control.Monad.Trans+import System.Directory++import MB.Types++buildIndexPage :: BlogM ()+buildIndexPage = do+ blog <- theBlog++ when (null $ blogPosts blog) $+ error "No blog posts; please create a first post in posts/."++ let src = ofsPostFinalHtml (outputFS blog) post+ index = ofsIndexHtml $ outputFS $ blog+ post = head $ blogPosts blog++ liftIO $ copyFile src index
+ src/MB/Gen/Post.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE ScopedTypeVariables #-}+module MB.Gen.Post+ ( generatePosts+ , postTemplateAttrs+ )+where++import Data.Default+import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Data.Maybe+import qualified Data.Map as M+import Text.StringTemplate+ ( setManyAttrib )++import qualified Text.Pandoc as Pandoc+import MB.Processing+import MB.Types+import MB.Templates++import MB.Gen.Base++renderPostTemplate :: Blog -> Post -> (Maybe Post, Maybe Post) -> Template -> String -> String+renderPostTemplate blog post nextPrev postTemplate postHtml =+ let pAttrs = postTemplateAttrs blog post+ tmplWithPostAttrs =+ setManyAttrib [("post_authors", postAuthors post)] $+ setManyAttrib [("post", pAttrs)] $+ setManyAttrib [ ("next_post_url", postUrl <$> (fst nextPrev))+ , ("prev_post_url", postUrl <$> (snd nextPrev))+ ]+ postTemplate++ attrs = [ ("post_html", postHtml)+ ]+ in fillTemplate blog tmplWithPostAttrs attrs++postTemplateAttrs :: Blog -> Post -> M.Map String String+postTemplateAttrs blog post =+ let datestr = postDate post <|> Just (postModificationString post)+ in M.fromList [ ("title", getPostTitle blog post BlogPost)+ , ("date", fromJust datestr)+ , ("url", postUrl post)+ , ("basename", postBaseName post)+ , ("tex_macros", postTeXMacros post)+ ]++generatePosts :: BlogM ()+generatePosts = do+ blog <- theBlog++ let toRender = zip (blogPosts blog) [0..]++ forM_ toRender $ \(post, pos) ->+ renderSingle post pos++renderSingle :: Post -> Int -> BlogM ()+renderSingle post pos = do+ blog <- theBlog+ conf <- theConfig++ let st = inputFSState blog+ renderCauses p =+ catMaybes $ [ if postModificationTime p > ifsBaselineMTime st+ then Just PostModified+ else Nothing+ , if ifsPostIndexMTime st > ifsBaselineMTime st+ then Just PostIndex+ else Nothing+ , if ifsConfigMTime st > ifsBaselineMTime st+ then Just Config+ else Nothing+ , if forceRegeneration conf+ then Just Forced+ else Nothing+ , if ifsTemplateMTime st > ifsBaselineMTime st+ then Just Template+ else Nothing+ ]++ if null (renderCauses post) then+ return () else+ do+ let nextPost = if pos == 0+ then Nothing+ else Just (blogPosts blog !! (pos - 1))++ prevPost = if pos == (length $ blogPosts blog) - 1+ then Nothing+ else Just (blogPosts blog !! (pos + 1))++ notify $ PostRender post $ renderCauses post++ -- Steps:++ -- Transform AST with preprocessors;+ newPost <- applyPreProcessors post++ -- Render the transformed AST as HTML using Pandoc;+ let writerOpts = getWriterOptions blog def+ postBodyHtml = Pandoc.writeHtmlString writerOpts (postAst newPost)++ withTemplate (ifsPageTemplatePath $ inputFS blog) $ \pageTmpl ->+ withTemplate (ifsPostTemplatePath $ inputFS blog) $ \postTmpl ->+ do+ -- Embed the converted Pandoc HTML into the postTemplate;+ let postPageHtml = renderPostTemplate blog post (nextPost, prevPost) postTmpl postBodyHtml+ -- Embed the postTemplate result in the pageTemplate.+ finalPageHtml = buildPage blog postPageHtml (Just $ getRawPostTitle blog post) pageTmpl++ -- Write the final, complete page HTML to the post+ -- HTML file location.+ liftIO $ writeFile (ofsPostFinalHtml (outputFS blog) post) finalPageHtml++ -- Give postprocessors a chance to transform the+ -- final HTML.+ applyPostProcessors (ofsPostFinalHtml (outputFS blog) post) BlogPost
+ src/MB/Gen/PostList.hs view
@@ -0,0 +1,31 @@+module MB.Gen.PostList+ ( generatePostList+ )+where++import Control.Applicative+import Control.Monad.Trans+import Text.StringTemplate+ ( setManyAttrib )++import MB.Types+import MB.Templates+import MB.Processing+import MB.Gen.Base+import MB.Gen.Post (postTemplateAttrs)++generatePostList :: BlogM ()+generatePostList = do+ blog <- theBlog+ let st = inputFS blog++ withTemplate (ifsListTemplatePath st) $ \listTmpl ->+ withTemplate (ifsPageTemplatePath st) $ \pageTmpl ->+ do+ let postData = postTemplateAttrs blog <$> blogPosts blog+ listTmpl' = setManyAttrib [("posts", postData)] listTmpl+ out = fillTemplate blog listTmpl' []++ liftIO $ writeFile (ofsListHtml $ outputFS blog) $+ buildPage blog out Nothing pageTmpl+ applyPostProcessors (ofsListHtml $ outputFS blog) Index
+ src/MB/Gen/RSS.hs view
@@ -0,0 +1,41 @@+module MB.Gen.RSS+ ( generateRssFeed+ )+where++import Control.Applicative ((<|>))+import Data.Time.Format+ ( formatTime+ , parseTime+ )+import System.Locale+ ( rfc822DateFormat+ )+import Data.Time.Format (defaultTimeLocale)+import MB.Types+import MB.Processing ( getRawPostTitle )+import MB.Templates++rssItem :: Blog -> Post -> String+rssItem blog p =+ concat [ "<item>"+ , "<title>" ++ getRawPostTitle blog p ++ "</title>\n"+ , "<link>" ++ baseUrl blog ++ postUrl p ++ "</link>\n"+ , "<pubDate>" ++ rssModificationTime p ++ "</pubDate>\n"+ , "<guid>" ++ baseUrl blog ++ postUrl p ++ "</guid>\n"+ , "</item>\n"+ ]++generateRssFeed :: Blog -> Template -> String+generateRssFeed blog tmpl =+ let items = map (rssItem blog) $ blogPosts blog+ itemStr = concat items+ attrs = [ ("items", itemStr)+ ]+ in fillTemplate blog tmpl attrs++rssModificationTime :: Post -> String+rssModificationTime p =+ let Just t = parsed <|> (Just $ postModificationTime p)+ parsed = parseTime defaultTimeLocale "%B %e, %Y" =<< postDate p+ in formatTime defaultTimeLocale rfc822DateFormat t
− src/MB/Gladtex.hs
@@ -1,92 +0,0 @@-module MB.Gladtex- ( gladtexProcessor- , checkForGladtex- )-where--import Control.Applicative ((<$>))-import System.Exit- ( ExitCode(..)- , exitFailure- )-import System.Directory- ( copyFile- )-import System.Process- ( readProcessWithExitCode- )-import Control.Monad- ( when- )-import qualified Text.Pandoc as Pandoc-import MB.Types--gladtexProcessor :: Processor-gladtexProcessor =- nullProcessor { applyWriterOptions = Just gladtexWriterOptions- , postProcessPost = Just processGladtex- , buildPostTitle = Just gladtexTitle- }--gladtexWriterOptions :: Pandoc.WriterOptions -> Pandoc.WriterOptions-gladtexWriterOptions opts =- opts { Pandoc.writerHTMLMathMethod = Pandoc.GladTeX- }--gladtexProgName :: String-gladtexProgName = "gladtex"--processGladtex :: Blog -> FilePath -> Page -> IO ()-processGladtex blog path page = do- -- Copy the final HTML path (which was passed in) to temp file since- -- we ultimately need to write to the final HTML path.- let htexPath = path ++ ".htex"- textColor = case page of- Index -> "0000FF"- BlogPost -> "000000"-- copyFile path htexPath-- -- gladtex will overwrite the original .html file.- gladTex blog htexPath textColor--gladTex :: Blog -> FilePath -> String -> IO ()-gladTex blog htexPath color = do- let args = [ "-d", imageDir blog- , "-u", "/generated-images/"- , "-r", "120"- , "-s", "4"- , "-b", "FFFFFF"- , "-c", color- , "-l", "displaymath"- , "-i", "math"- , htexPath- ]-- (ecode, _, err) <- readProcessWithExitCode gladtexProgName args ""-- when (ecode /= ExitSuccess) $ do- putStrLn $ "Error processing " ++ (show htexPath) ++ " with " ++ gladtexProgName ++ ":"- putStrLn err- exitFailure--checkForGladtex :: IO ()-checkForGladtex = do- (code, _, _) <- readProcessWithExitCode gladtexProgName [] ""- case code of- (ExitFailure c) ->- do- putStrLn $ "This program requires '" ++ gladtexProgName ++- "'; I attempted to run it but " ++- "got exit status " ++ (show c)- exitFailure- _ -> return ()--gladtexTitle :: Page -> [Pandoc.Inline] -> [Pandoc.Inline]-gladtexTitle BlogPost ts = rewriteInline 190 <$> ts-gladtexTitle Index ts = rewriteInline 110 <$> ts--rewriteInline :: Int -> Pandoc.Inline -> Pandoc.Inline-rewriteInline dpi (Pandoc.Math v s) =- Pandoc.Math v $ "<EQ ENV=\"math\" DPI=\"" ++ show dpi ++ "\">" ++ s ++ "</EQ>"-rewriteInline _ i = i
− src/MB/Gnuplot.hs
@@ -1,110 +0,0 @@-module MB.Gnuplot- ( gnuplotProcessor- )-where--import Control.Monad- ( forM- )-import Data.List- ( intercalate- )-import Data.Digest.Pure.SHA- ( showDigest- , sha1- )-import Data.ByteString.Lazy.Char8- ( pack- )-import System.Directory- ( doesFileExist- )-import System.Process- ( readProcessWithExitCode- )-import System.Exit- ( ExitCode(..)- )-import qualified Text.Pandoc as Pandoc-import MB.Types-import qualified MB.Files as Files--gnuplotProcessor :: Processor-gnuplotProcessor =- nullProcessor { preProcessPost = Just renderGnuPlot- }--renderGnuPlot :: Blog -> Post -> IO Post-renderGnuPlot config post = do- let Pandoc.Pandoc m blocks = postAst post- newBlocks <- forM blocks $ \blk ->- case blk of- Pandoc.CodeBlock (preambleName, classes, _) s ->- renderGnuPlotScript config preambleName s classes- b -> return b-- return $ post { postAst = Pandoc.Pandoc m newBlocks }--loadPreamble :: Blog -> String -> IO (Maybe String)-loadPreamble config preambleName = do- let filename = Files.eqPreambleFile config $ preambleName ++ ".txt"- e <- doesFileExist filename- case e of- False -> return Nothing- True -> do- s <- readFile filename- s `seq` return ()- return $ Just s--renderGnuPlotScript :: Blog- -> String- -> String- -> [String]- -> IO Pandoc.Block-renderGnuPlotScript config preambleName rawScript classes = do- putStrLn $ "Rendering equation graph, type=" ++ preambleName-- mPreamble <- loadPreamble config preambleName-- case mPreamble of- Nothing -> do- putStrLn $ "Error: no such gnuplot preamble: " ++ preambleName- return $ Pandoc.Para [Pandoc.Str "[[COULD NOT DRAW EQUATION]]"]- Just preamble -> do-- let scriptLines = lines rawScript- preambleLines = lines preamble- digestInput = preambleName ++ rawScript-- -- Generate an image name in the images/ directory of the blog- -- data directory. Use a hash of the preamble name and script- -- contents so we can avoid rendering the image again if it- -- already exists.- let hash = showDigest $ sha1 $ pack digestInput- imageFilename = preambleName ++ "-" ++ hash ++ ".png"- imagePath = Files.imageFilename config imageFilename- outputLines = [ "set term png enhanced"- , "set output \"" ++ imagePath ++ "\""- ]- fullScript = intercalate "; " $ outputLines ++ preambleLines ++ scriptLines-- -- Invoke gnuplot to render the image- (status, out, err) <- readProcessWithExitCode "gnuplot" ["-e", fullScript] ""-- case status of- ExitSuccess -> return ()- ExitFailure _ -> do- putStrLn "Could not render equation:"- putStrLn "Equation was:"- putStrLn rawScript- putStrLn "gnuplot output:"- putStrLn out- putStrLn err-- return $ Pandoc.Para [Pandoc.RawInline "html" $ concat [ "<img src=\"/generated-images/"- , imageFilename- , "\" class=\""- , intercalate " " classes- , "\">"- ]- ]
+ src/MB/Initialize.hs view
@@ -0,0 +1,38 @@+module MB.Initialize+ ( initializeDataDir+ )+where++import System.Directory+import System.FilePath++import Paths_mathblog+ ( getDataFileName+ )+import MB.Util (copyContents)++defaultConfigFilename :: String+defaultConfigFilename = "blog.cfg"++skelDir :: IO FilePath+skelDir = getDataFileName "skel"++initializeDataDir :: FilePath -> IO ()+initializeDataDir dir = do+ existsDir <- doesDirectoryExist dir++ case existsDir of+ False -> do+ putStrLn $ "Initializing data directory " ++ dir+ dataDir <- skelDir+ createDirectory dir+ copyContents dataDir dir++ True -> do+ existsConfig <- doesFileExist $ dir </> defaultConfigFilename+ case existsConfig of+ True -> putStrLn $ "Data directory already initialized; found " +++ (dir </> defaultConfigFilename)+ False -> do+ putStrLn $ "Directory " ++ show dir ++ " already exists"+ putStrLn $ "but it does not contain a blog config file (" ++ defaultConfigFilename ++ ")"
− src/MB/Mathjax.hs
@@ -1,58 +0,0 @@-module MB.Mathjax- ( mathjaxProcessor- )-where--import qualified Text.Pandoc as Pandoc-import MB.Types--mathjaxProcessor :: Processor-mathjaxProcessor =- nullProcessor { applyWriterOptions = Just mathjaxOpts- , pageHead = Just mathjaxPageHead- }--mathjaxOpts :: Pandoc.WriterOptions -> Pandoc.WriterOptions-mathjaxOpts opts =- opts { Pandoc.writerHTMLMathMethod = Pandoc.MathJax "MathJax/MathJax.js"- }--mathjaxPageHead :: String-mathjaxPageHead =- "<script type=\"text/x-mathjax-config\">\n\- \ MathJax.Hub.Config(\n\- \ {\"HTML-CSS\": { preferredFont: \"TeX\", availableFonts: [\"STIX\",\"TeX\"] },\n\- \ tex2jax: {\n\- \ element: null,\n\- \ preview: \"none\",\n\- \ skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],\n\- \ inlineMath: [\n\- \ ['$', '$'],\n\- \ [\"\\\\(\", \"\\\\)\"],\n\- \ ],\n\- \ displayMath: [\n\- \ ['$$', '$$'],\n\- \ [\"\\\\[\", \"\\\\]\"],\n\- \ ],\n\- \ processEscapes: true,\n\- \ ignoreClass: \"tex2jax_ignore|dno\"\n\- \ },\n\- \ TeX: {\n\- \ noUndefined: { attributes: {\n\- \ mathcolor: \"red\",\n\- \ mathbackground: \"#FFEEEE\",\n\- \ mathsize: \"90%\" }\n\- \ }\n\- \ },\n\- \ messageStyle: \"none\"\n\- \ });\n\- \</script>\n\- \<script type=\"text/javascript\" src=\"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS_HTML\"></script>\n\- \<script type=\"text/javascript\">\n\- \ // Uncomment this code and set the style of the \"page\" element\n\- \ // below to visibility: hidden initially if you don't like the\n\- \ // MathJax flicker during the rendering process. :(\n\- \ // MathJax.Hub.Queue(function () {\n\- \ // document.getElementById(\"page\").style.visibility = \"visible\";\n\- \ // });\n\- \</script>\n"
src/MB/Processing.hs view
@@ -11,28 +11,33 @@ import Data.Maybe (catMaybes) import qualified Text.Pandoc as Pandoc import MB.Types+import MB.Util -applyPreProcessors :: Blog -> Post -> IO Post-applyPreProcessors b post = applyPreProcessors_ b post (processors b)+applyPreProcessors :: Post -> BlogM Post+applyPreProcessors post = do+ ps <- processors <$> theBlog+ applyPreProcessors_ post ps -applyPostProcessors :: Blog -> FilePath -> Page -> IO ()-applyPostProcessors b path pg = applyPostProcessors_ b path pg (processors b)+applyPostProcessors :: FilePath -> Page -> BlogM ()+applyPostProcessors path pg = do+ ps <- processors <$> theBlog+ applyPostProcessors_ path pg ps -applyPreProcessors_ :: Blog -> Post -> [Processor] -> IO Post-applyPreProcessors_ _ post [] = return post-applyPreProcessors_ b post (p:ps) = do+applyPreProcessors_ :: Post -> [Processor] -> BlogM Post+applyPreProcessors_ post [] = return post+applyPreProcessors_ post (p:ps) = do post' <- case preProcessPost p of Nothing -> return post- Just f -> f b post- applyPreProcessors_ b post' ps+ Just f -> f post+ applyPreProcessors_ post' ps -applyPostProcessors_ :: Blog -> FilePath -> Page -> [Processor] -> IO ()-applyPostProcessors_ _ _ _ [] = return ()-applyPostProcessors_ b pth pg (p:ps) = do+applyPostProcessors_ :: FilePath -> Page -> [Processor] -> BlogM ()+applyPostProcessors_ _ _ [] = return ()+applyPostProcessors_ pth pg (p:ps) = do case postProcessPost p of Nothing -> return ()- Just f -> f b pth pg- applyPostProcessors_ b pth pg ps+ Just f -> f pth pg+ applyPostProcessors_ pth pg ps getWriterOptions :: Blog -> Pandoc.WriterOptions -> Pandoc.WriterOptions getWriterOptions b = foldl (.) id (catMaybes $ applyWriterOptions <$> processors b)@@ -43,16 +48,16 @@ fallback = concat . (getInlineStr <$>) fs = catMaybes $ rawPostTitle <$> processors b -getInlineStr :: Pandoc.Inline -> String-getInlineStr (Pandoc.Str s) = s-getInlineStr (Pandoc.Math _ s) = s-getInlineStr Pandoc.Space = " "-getInlineStr i = error $ "Unexpected inline in document title, got " ++ (show i)- getPostTitle :: Blog -> Post -> Page -> String-getPostTitle b p s = concat $ getInlineStr <$> f (postTitle p)+getPostTitle b p s = concat $ toPostTitle <$> f (postTitle p) where f = foldl (.) id (reverse $ fs <*> (pure s)) fs :: [Page -> [Pandoc.Inline] -> [Pandoc.Inline]] fs = catMaybes $ buildPostTitle <$> processors b++toPostTitle :: Pandoc.Inline -> String+toPostTitle (Pandoc.Str s) = s+toPostTitle (Pandoc.Math _ s) = "$" ++ s ++ "$"+toPostTitle Pandoc.Space = " "+toPostTitle i = error $ "Unexpected inline in document title, got " ++ (show i)
+ src/MB/Processors/Base.hs view
@@ -0,0 +1,22 @@+module MB.Processors.Base+ ( baseProcessor+ )+where++import Control.Applicative+import Control.Monad.Trans++import MB.Types+import MB.Util++baseProcessor :: Processor+baseProcessor =+ nullProcessor { installAssets = Just doInstallAssets+ }++doInstallAssets :: BlogM ()+doInstallAssets = do+ assets <- ifsAssetDir <$> inputFS <$> theBlog+ outputDir <- ofsBaseDir <$> outputFS <$> theBlog++ liftIO $ copyContents assets outputDir
+ src/MB/Processors/Mathjax.hs view
@@ -0,0 +1,17 @@+module MB.Processors.Mathjax+ ( mathjaxProcessor+ )+where++import qualified Text.Pandoc as Pandoc+import MB.Types++mathjaxProcessor :: Processor+mathjaxProcessor =+ nullProcessor { applyWriterOptions = Just mathjaxOpts+ }++mathjaxOpts :: Pandoc.WriterOptions -> Pandoc.WriterOptions+mathjaxOpts opts =+ opts { Pandoc.writerHTMLMathMethod = Pandoc.MathJax "MathJax/MathJax.js"+ }
+ src/MB/Processors/Tikz.hs view
@@ -0,0 +1,139 @@+module MB.Processors.Tikz+ ( tikzProcessor+ )+where++import Control.Monad.Trans+import Data.List+import Data.Digest.Pure.SHA+import Data.ByteString.Lazy.Char8 (pack)+import System.Process+import System.Directory+import System.Exit+import Codec.Picture+import qualified Text.Pandoc as Pandoc+import MB.Types++tikzProcessor :: Processor+tikzProcessor =+ nullProcessor { preProcessPost = Just renderTikz+ }++imgDimensions :: DynamicImage -> (Int, Int)+imgDimensions (ImageY8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageY16 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageYF img) = (imageWidth img, imageHeight img)+imgDimensions (ImageYA8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageYA16 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageRGB8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageRGB16 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageRGBF img) = (imageWidth img, imageHeight img)+imgDimensions (ImageRGBA8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageRGBA16 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageYCbCr8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageCMYK8 img) = (imageWidth img, imageHeight img)+imgDimensions (ImageCMYK16 img) = (imageWidth img, imageHeight img)++renderTikz :: Post -> BlogM Post+renderTikz post = do+ let Pandoc.Pandoc m blocks = postAst post+ newBlocks <- mapM (renderTikzScript post) blocks+ return $ post { postAst = Pandoc.Pandoc m newBlocks }++renderTikzScript :: Post+ -> Pandoc.Block+ -> BlogM Pandoc.Block+renderTikzScript post blk@(Pandoc.CodeBlock ("tikz", classes, _) rawScript) = do+ blog <- theBlog++ let digestInput = postTeXMacros post ++ rawScript++ -- Generate an image name in the images/ directory of the blog+ -- data directory. Use a hash of the preamble name and script+ -- contents so we can avoid rendering the image again if it+ -- already exists.+ hash = showDigest $ sha1 $ pack digestInput+ imageFilename = "tikz-" ++ hash ++ ".png"+ imagePath = ofsImagePath (outputFS blog) imageFilename+ preamble = unlines [ "\\documentclass{article}"+ , "\\usepackage{tikz}"+ , "\\usetikzlibrary{intersections,backgrounds,fit,calc,positioning}"+ , "\\usepackage{pgfplots}"+ , "\\usepackage{amsmath}"+ , "\\pgfrealjobname{tmp}"++ -- Include any TeX macro content in the+ -- document preamble so it can be used in the+ -- TikZ markup.+ , postTeXMacros post++ , "\\begin{document}"+ , "\\begin{figure}"+ , "\\beginpgfgraphicnamed{testfigure}"+ , "\\begin{tikzpicture}"+ ]+ postamble = unlines [ "\\end{tikzpicture}"+ , "\\endpgfgraphicnamed"+ , "\\end{figure}"+ , "\\end{document}"+ ]++ latexSource = preamble ++ rawScript ++ postamble++ let newBlock pth = do+ imgResult <- readImage pth+ case imgResult of+ Left e -> do+ putStrLn $ "Yikes! Error reading an image we generated (" ++ show pth ++ "): " ++ e+ exitFailure+ Right img -> do+ let (w, h) = imgDimensions img+ return $ Pandoc.Para [ Pandoc.RawInline (Pandoc.Format "html") $+ concat [ "<img src=\"/generated-images/"+ , imageFilename+ , "\" width=\""+ , show (w `div` 2)+ , "\" height=\""+ , show (h `div` 2)+ , "\" class=\""+ , intercalate " " classes+ , "\">"+ ]+ ]++ e <- liftIO $ doesFileExist imagePath+ case e of+ True -> liftIO $ newBlock imagePath+ False -> do+ liftIO $ writeFile "/tmp/tmp.tex" latexSource++ (s1, out1, _) <- liftIO $ readProcessWithExitCode "pdflatex" [ "-halt-on-error", "-output-directory", "/tmp"+ , "--jobname", "testfigure", "/tmp/tmp.tex"] ""+ case s1 of+ ExitFailure _ ->+ liftIO $ do+ putStrLn out1+ putStrLn ">>>>>>> Input source >>>>>>>"+ putStrLn latexSource+ putStrLn ">>>>> End input source >>>>>"+ return blk+ ExitSuccess -> do+ -- Convert the temporary file to a PNG.+ (s2, out2, err) <- liftIO $ readProcessWithExitCode "convert" [ "-density", "250%"+ , "-quality", "100"+ , "/tmp/testfigure.pdf"+ , imagePath+ ] ""+ case s2 of+ ExitFailure _ ->+ liftIO $ do+ putStrLn "Could not render Tikz picture:"+ putStrLn "Equation was:"+ putStrLn latexSource+ putStrLn "dvipng output:"+ putStrLn out2+ putStrLn err+ return blk+ ExitSuccess -> liftIO $ newBlock imagePath++renderTikzScript _ b = return b
+ src/MB/Server.hs view
@@ -0,0 +1,181 @@+module MB.Server+ ( withServing+ )+where++import Prelude hiding (catch)+import Control.Exception (SomeException, finally, catch)+import Control.Concurrent+import Control.Monad+import Data.List (isPrefixOf)+import System.Directory+import System.Exit+import System.FilePath ((</>))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Network.HTTP+import Network.HTTP.Server+import Network.HTTP.Server.Logger+import qualified Network.URL as URL+import Network.Socket (SockAddr)++import System.IO.Temp++import MB.Util (copyContents)+import MB.Types++reloadJS :: String+reloadJS =+ "<script type=\"text/javascript\">\n\+ \function waitForReload()\n\+ \{\n\+ \ var req = new XMLHttpRequest();\n\+ \ req.onreadystatechange = function() {\n\+ \ if (req.readyState == 4) {\n\+ \ if (req.status == 200 || req.status == 302) {\n\+ \ location.reload();\n\+ \ } else {\n\+ \ setTimeout(waitForReload, 5000);\n\+ \ }\n\+ \ }\n\+ \ };\n\+ \ req.open(\"GET\", \"/__reload\", true);\n\+ \ req.timeout = 5000;\n\+ \ req.ontimeout = waitForReload;\n\+ \ req.send();\n\+ \}\n\+ \waitForReload();\n\+ \</script>"++serverProcessor :: Processor+serverProcessor =+ nullProcessor { pageHead = Just reloadJS+ }++withServing :: StartupConfig+ -> (StartupConfig -> (Blog -> Blog) -> IO () -> IO ())+ -> IO ()+withServing conf act = do+ (hostname, portNum) <-+ case listenAddr conf of+ Nothing -> putStrLn "BUG: configuration did not provide a listen address!" >> exitFailure+ Just (h, p) -> return (h, p)++ tmpDir <- createTempDirectory "/tmp" "mbhtml.tmp"+ outputDir <- canonicalizePath tmpDir++ let noExists :: SomeException -> IO Bool+ noExists _ = return False+ ex <- (doesDirectoryExist $ htmlOutputDirectory conf) `catch` noExists++ when ex $ copyContents (htmlOutputDirectory conf) outputDir++ reloadChan <- newChan+ let genSignalAct = writeChan reloadChan ()++ -- Set up the temp output directoryy and modify the config and blog.+ serverConf = conf { htmlOutputDirectory = outputDir }+ url = "http://" ++ hostname ++ ":" ++ show portNum ++ "/"+ blogTrans b =+ b { baseUrl = url+ , processors = processors b ++ [serverProcessor]+ , outputFS = blogOutputFS serverConf+ }++ httpConfig = defaultConfig { srvHost = hostname+ , srvPort = portNum+ , srvLog = quietLogger+ }+ cleanup = removeDirectoryRecursive (htmlOutputDirectory serverConf)++ handleError :: SomeException -> IO ()+ handleError e =+ putStrLn $ "Error running server on " ++ url ++ ": " ++ show e++ -- Start the blog generation thread.+ _ <- forkIO $ (act serverConf blogTrans genSignalAct `catch` handleError)++ -- Wait for a successful blog generation, then start serving.+ readChan reloadChan+ putStrLn "Blog generation complete."+ putStrLn $ "Web server listening on " ++ url++ serverWith httpConfig (requestHandler outputDir reloadChan)+ `catch` handleError+ `finally` cleanup++requestHandler :: FilePath+ -> Chan ()+ -> SockAddr+ -> URL.URL+ -> Request BS.ByteString+ -> IO (Response BS.ByteString)+requestHandler docRoot reloadChan _addr url _req = do+ -- If the request is for the special reload control URL, defer to+ -- the reload handler+ if URL.url_path url == "__reload" then+ reloadHandler reloadChan else+ fileHandler docRoot url++reloadHandler :: Chan () -> IO (Response BS.ByteString)+reloadHandler reloadChan = do+ -- Duplicate the channel. This effectively resets the read position+ -- on the channel, so only messages added after the time of+ -- duplication will be read. This way, reload handlers who are+ -- still waiting (from past page loads) even though their clients+ -- have long since disconnected will not consume events intended for+ -- current waiters.+ ch <- dupChan reloadChan+ readChan ch++ let bytes = BSC.pack ""+ return $ (respond Found :: Response BS.ByteString)+ { rspHeaders = [ Header HdrContentLength $ show $ BS.length bytes+ , Header HdrCacheControl "no-cache"+ , Header HdrConnection "close"+ ]+ , rspBody = bytes+ }++fileHandler :: FilePath -> URL.URL -> IO (Response BS.ByteString)+fileHandler docRoot url = do+ -- Concatenate the url_path of the URL to the output directory.+ -- Then attempt to canonicalize the result. If it succeeds and is+ -- not contained within the output directory, return a 404.++ let handleError :: SomeException -> IO (Response BS.ByteString)+ handleError = const $ return (resp404 url)++ serveFile path = do+ realPath <- canonicalizePath path+ if not (docRoot `isPrefixOf` realPath) then+ return (resp404 url) else+ do+ -- If the request was for a directory, rewrite it so we+ -- look for index.html instead+ e <- doesFileExist realPath+ if e then+ fileToResponse realPath else+ serveFile (path </> "index.html")++ serveFile (docRoot </> URL.url_path url) `catch` handleError++resp404 :: URL.URL -> Response BS.ByteString+resp404 url =+ let msg = BSC.pack $ "Not found: " ++ URL.exportURL url+ in (err_response NotFound :: Response BS.ByteString)+ { rspHeaders = [ Header HdrContentType "text/plain"+ , Header HdrContentLength $ show $ BS.length msg+ ]+ , rspBody = msg+ }++fileToResponse :: FilePath -> IO (Response BS.ByteString)+fileToResponse f = do+ bytes <- BS.readFile f+ return $ (respond Found :: Response BS.ByteString)+ { rspHeaders = [ Header HdrContentLength $ show $ BS.length bytes+ , Header HdrCacheControl "no-cache"+ ]+ , rspBody = bytes+ }
src/MB/Startup.hs view
@@ -1,16 +1,22 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, ScopedTypeVariables #-} module MB.Startup- ( StartupConfig(..)- , startupConfigFromEnv+ ( startupConfigFromEnv+ , canonicalizeStartupConfig+ , versionString #ifdef TESTING+ , Flag(..) , startupConfig , baseDirEnvName , baseDirParamName+ , htmlOutputDirEnvName+ , htmlDirParamName , getDataDirFlag #endif ) where +import Prelude hiding (catch)+import Control.Exception import Control.Monad ( mplus , when@@ -22,24 +28,22 @@ ( getEnvironment , getArgs )+import System.Directory import System.FilePath import System.Console.GetOpt+import Network.Socket (HostName, PortNumber) -data StartupConfig = StartupConfig { listenMode :: Bool- , dataDirectory :: FilePath- , initDataDirectory :: Bool- , forceRegeneration :: Bool- , htmlOutputDirectory :: FilePath- , configFilePath :: FilePath- }- deriving (Show, Eq)+import MB.Types -data Flag = Listen+data Flag = Listen (Maybe String) | DataDir FilePath | InitDataDirectory | ForceRegenerate | HtmlOutputDir FilePath | ConfigFile FilePath+ | BaseUrl String+ | Version+ | Help deriving (Eq) getDataDirFlag :: [Flag] -> Maybe FilePath@@ -47,6 +51,16 @@ getDataDirFlag (DataDir p:_) = Just p getDataDirFlag (_:fs) = getDataDirFlag fs +getListenFlag :: [Flag] -> Maybe (Maybe String)+getListenFlag [] = Nothing+getListenFlag (Listen s:_) = Just s+getListenFlag (_:fs) = getListenFlag fs++getBaseUrlFlag :: [Flag] -> Maybe String+getBaseUrlFlag [] = Nothing+getBaseUrlFlag (BaseUrl s:_) = Just s+getBaseUrlFlag (_:fs) = getBaseUrlFlag fs+ getHtmlOutputDirFlag :: [Flag] -> Maybe FilePath getHtmlOutputDirFlag [] = Nothing getHtmlOutputDirFlag (HtmlOutputDir p:_) = Just p@@ -59,29 +73,40 @@ options :: [OptDescr Flag] options = [ Option ['d'] [baseDirParamName] (ReqArg DataDir "PATH")- $ "Path where blog files will be stored. If this is\n" ++- "not specified, " ++ baseDirEnvName ++ " must be set in the\n" ++- "environment."+ $ "Path where blog input data files (configuration, posts,\n" +++ "etc.) are located. If this is not specified,\n" +++ baseDirEnvName ++ " must be set in the environment." , Option ['i'] ["init"] (NoArg InitDataDirectory) $ "Initialize the blog data directory."- , Option ['l'] ["listen"] (NoArg Listen)+ , Option ['l'] ["listen"] (OptArg Listen "HOST:PORT") $ "Make mb poll periodically and regenerate your\n" ++ "blog content when something changes. This is\n" ++ "useful if you want to run a local web server\n" ++- "to view your posts as you're writing them."+ "to view your posts as you're writing them. Spawns\n" +++ "an HTTP server on the specified host and port."+ , Option ['b'] ["base-url"] (ReqArg BaseUrl "URL")+ $ "The base URL to use in URL generation. Overrides the\n" +++ "'baseUrl' configuration setting." , Option ['f'] ["force"] (NoArg ForceRegenerate) "Force a rebuild of all blog content."- , Option ['h'] ["html-dir"] (ReqArg HtmlOutputDir "PATH")- $ "Write generated HTML and images to the specified\n" ++- "directory. The default is the 'html' directory in\n" ++- "the blog data directory."+ , Option ['o'] [htmlDirParamName] (ReqArg HtmlOutputDir "PATH")+ $ "The directory where HTML and image output should be\n" +++ "written. If this is not specified, " ++ htmlOutputDirEnvName +++ "\nmust be set in the environment." , Option ['c'] ["config-file"] (ReqArg ConfigFile "FILENAME") $ "Use the specified config file instead of 'blog.cfg'\n" ++ "in the data directory. This path must be relative\n" ++ "to the data directory."+ , Option ['v'] ["version"] (NoArg Version)+ "The version of this mathblog installation."+ , Option ['h'] ["help"] (NoArg Help)+ "This help output." ] +versionString :: String+versionString = "mathblog version 0.6"+ -- |Inspect the program environment to create a startup configuration. -- If the configuration information is invalid or absent, this will -- automatically emit usage info and exit the program.@@ -90,7 +115,15 @@ env <- getEnvironment args <- getArgs - case startupConfig args env of+ let (flags, _, _) = getOpt Permute options args++ when (Version `elem` flags) $+ (putStrLn versionString >> exitFailure)++ when (Help `elem` flags) $+ (usage >> exitFailure)++ case startupConfig flags env of Nothing -> usage >> exitFailure Just conf -> do when (head (dataDirectory conf) /= '/') $@@ -102,38 +135,87 @@ return conf +parseListenString :: String -> Maybe (HostName, PortNumber)+parseListenString s =+ case break (== ':') s of+ ([], _) -> Nothing+ (_, []) -> Nothing+ (h, ':':p) -> case reads p :: [(Int, String)] of+ [] -> Nothing+ ((i, []):_) -> Just (h, toEnum i)+ _ -> Nothing+ _ -> Nothing+ -- |Create a startup configuration from the specified arguments list -- and environment variable list. Returns Nothing if the required -- information was absent.-startupConfig :: [String] -> [(String, String)] -> Maybe StartupConfig-startupConfig args env =- case getOpt Permute options args of- (_, _, (_:_)) -> Nothing- (flags, _, []) -> do- let lm = Listen `elem` flags- i = InitDataDirectory `elem` flags- f = ForceRegenerate `elem` flags- d <- getDataDirFlag flags `mplus` (lookup baseDirEnvName env)- h <- getHtmlOutputDirFlag flags `mplus` (Just $ d </> "html")- c <- getConfigFilePath flags `mplus` (Just $ d </> "blog.cfg")+startupConfig :: [Flag] -> [(String, String)] -> Maybe StartupConfig+startupConfig flags env = do+ let doInit = InitDataDirectory `elem` flags+ force = ForceRegenerate `elem` flags - return $ StartupConfig { listenMode = lm- , dataDirectory = d- , initDataDirectory = i- , forceRegeneration = f- , htmlOutputDirectory = h- , configFilePath = c- }+ listen <- case getListenFlag flags of+ -- If the listen flag is present, capture the value.+ Just f -> return $ Just f+ Nothing -> return Nothing + d <- getDataDirFlag flags `mplus` (lookup baseDirEnvName env)+ o <- getHtmlOutputDirFlag flags `mplus` (lookup htmlOutputDirEnvName env)+ c <- getConfigFilePath flags `mplus` (Just $ d </> "blog.cfg")+ let b = getBaseUrlFlag flags++ lAddr <- case listen of+ Nothing -> return Nothing+ -- If the listen flag was given, then it must parse+ -- successfully.+ Just Nothing -> return $ Just ("localhost", 8000)+ Just (Just s) ->+ (return . Just) =<< parseListenString s++ return $ StartupConfig { dataDirectory = d+ , initDataDirectory = doInit+ , forceRegeneration = force+ , htmlOutputDirectory = o+ , configFilePath = c+ , listenAddr = lAddr+ , overrideBaseUrl = b+ }++canonicalizeStartupConfig :: StartupConfig -> IO StartupConfig+canonicalizeStartupConfig conf = do+ let dataDirName = takeFileName $ dataDirectory conf+ outputName = takeFileName $ htmlOutputDirectory conf++ d' <- (canonicalizePath $ takeDirectory $ dataDirectory conf) `catch`+ \(_::SomeException) -> do+ putStrLn $ "Invalid data directory: " ++ dataDirectory conf+ exitFailure++ o' <- (canonicalizePath $ takeDirectory $ htmlOutputDirectory conf) `catch`+ \(_::SomeException) -> do+ putStrLn $ "Invalid output directory: " ++ htmlOutputDirectory conf+ exitFailure++ return $ conf { dataDirectory = d' </> dataDirName+ , htmlOutputDirectory = o' </> outputName+ }+ baseDirEnvName :: String-baseDirEnvName = "MB_BASE_DIR"+baseDirEnvName = "MB_DATA_DIR" baseDirParamName :: String-baseDirParamName = "baseDir"+baseDirParamName = "data-dir" +htmlOutputDirEnvName :: String+htmlOutputDirEnvName = "MB_OUTPUT_DIR"++htmlDirParamName :: String+htmlDirParamName = "output-dir"+ usage :: IO () usage = do- let h = concat [ "Usage: mb [args]\n\n"+ let h = concat [ "Usage: mb [args] (or set " ++ baseDirEnvName +++ " and " ++ htmlOutputDirEnvName ++ " in the environment)\n\n" , "mb is a tool for creating and managing a mathematically-inclined\n" , "weblog.\n" ]
+ src/MB/TeXMacros.hs view
@@ -0,0 +1,25 @@+module MB.TeXMacros+ ( extractTeXMacros+ )+where++import Control.Applicative+import Data.Either+import qualified Text.Pandoc as Pandoc++-- |Extract "#tex-macros" blocks from the page and store their+-- contents in the postTeXMacros field. This removes the tex-macros+-- nodes from the Pandoc AST; see the Tikz processor to see how they+-- eventually make it back into the right spot in the output. The+-- post generation process exposes the macros to the post template via+-- the 'tex_macros' template variable.+extractTeXMacros :: [Pandoc.Block]+ -> ([Pandoc.Block], String)+extractTeXMacros blocks =+ let result = gatherMacros <$> blocks+ in (lefts result, concat $ rights result)++gatherMacros :: Pandoc.Block+ -> Either Pandoc.Block String+gatherMacros (Pandoc.CodeBlock ("tex-macros", _, _) rawScript) = Right rawScript+gatherMacros b = Left b
src/MB/Templates.hs view
@@ -1,9 +1,16 @@ module MB.Templates ( renderTemplate- , loadTemplate+ , fillTemplate+ , writeTemplate+ , withTemplate ) where +import Control.Applicative+import Control.Monad.Trans+import Data.Maybe+import System.IO+import System.Exit import Text.StringTemplate ( newSTMP , render@@ -11,12 +18,19 @@ , checkTemplate ) import MB.Types- ( Template- ) -loadTemplate :: FilePath -> IO (Either String Template)+withTemplate :: FilePath -> (Template -> BlogM a) -> BlogM a+withTemplate path f = do+ tmpl <- loadTemplate path+ case tmpl of+ Left msg -> do+ liftIO $ putStrLn $ "Could not load template " ++ show path ++ ": " ++ msg+ liftIO $ exitFailure+ Right t -> f t++loadTemplate :: FilePath -> BlogM (Either String Template) loadTemplate path = do- s <- readFile path+ s <- liftIO $ readFile path s `seq` return () let (a, _, _) = checkTemplate t@@ -28,3 +42,22 @@ renderTemplate :: [(String, String)] -> Template -> String renderTemplate attrs = render . setManyAttrib attrs++fillTemplate :: Blog -> Template -> [(String, String)] -> String+fillTemplate blog t attrs = renderTemplate attrs' t+ where attrs' = commonTemplateAttrs blog ++ attrs++writeTemplate :: Blog -> Handle -> Template -> [(String, String)] -> BlogM ()+writeTemplate blog h t attrs = liftIO $ hPutStr h $ fillTemplate blog t attrs++commonTemplateAttrs :: Blog -> [(String, String)]+commonTemplateAttrs blog =+ [ ( "baseUrl", baseUrl blog )+ , ( "title", title blog )+ , ( "authorName", authorName blog )+ , ( "authorEmail", authorEmail blog )+ , ( "extraPageHead", extraPageHead blog )+ ]++extraPageHead :: Blog -> String+extraPageHead b = concat $ catMaybes $ pageHead <$> processors b
− src/MB/Tikz.hs
@@ -1,102 +0,0 @@-module MB.Tikz- ( tikzProcessor- )-where--import Data.List- ( intercalate- )-import Data.Digest.Pure.SHA- ( showDigest- , sha1- )-import Data.ByteString.Lazy.Char8- ( pack- )-import System.Process- ( readProcessWithExitCode- )-import System.Exit- ( ExitCode(..)- )-import qualified Text.Pandoc as Pandoc-import MB.Types-import qualified MB.Files as Files--tikzProcessor :: Processor-tikzProcessor =- nullProcessor { preProcessPost = Just renderTikz- }--renderTikz :: Blog -> Post -> IO Post-renderTikz config post = do- let Pandoc.Pandoc m blocks = postAst post- newBlocks <- mapM (renderTikzScript config) blocks- return $ post { postAst = Pandoc.Pandoc m newBlocks }--renderTikzScript :: Blog- -> Pandoc.Block- -> IO Pandoc.Block-renderTikzScript config blk@(Pandoc.CodeBlock ("tikz", classes, _) rawScript) = do- putStrLn "Rendering equation graph (tikz)"-- let digestInput = rawScript-- -- Generate an image name in the images/ directory of the blog- -- data directory. Use a hash of the preamble name and script- -- contents so we can avoid rendering the image again if it- -- already exists.- hash = showDigest $ sha1 $ pack digestInput- imageFilename = "tikz-" ++ hash ++ ".png"- imagePath = Files.imageFilename config imageFilename- preamble = unlines [ "\\documentclass{article}"- , "\\usepackage{tikz}"- , "\\usepackage{pgfplots}"- , "\\pgfrealjobname{tmp}"-- , "\\begin{document}"- , "\\begin{figure}"- , "\\beginpgfgraphicnamed{testfigure}"- , "\\begin{tikzpicture}"- ]- postamble = unlines [ "\\end{tikzpicture}"- , "\\endpgfgraphicnamed"- , "\\end{figure}"- , "\\end{document}"- ]-- latexSource = preamble ++ rawScript ++ postamble-- writeFile "/tmp/tmp.tex" latexSource-- (s1, out1, _) <- readProcessWithExitCode "pdflatex" [ "-output-directory", "/tmp"- , "--jobname", "testfigure", "/tmp/tmp.tex"] ""- case s1 of- ExitFailure _ -> putStrLn out1 >> return blk- ExitSuccess -> do- -- Convert the temporary file to a PNG.- (s2, out2, err) <- readProcessWithExitCode "convert" [ "-density", "120"- , "-quality", "100"- , "/tmp/testfigure.pdf"- , imagePath- ] ""-- case s2 of- ExitFailure _ -> do- putStrLn "Could not render Tikz picture:"- putStrLn "Equation was:"- putStrLn latexSource- putStrLn "dvipng output:"- putStrLn out2- putStrLn err- return blk- ExitSuccess ->- return $ Pandoc.Para [Pandoc.RawInline "html" $- concat [ "<img src=\"/generated-images/"- , imageFilename- , "\" class=\""- , intercalate " " classes- , "\">"- ]- ]-renderTikzScript _ b = return b
src/MB/Types.hs view
@@ -1,38 +1,157 @@ module MB.Types ( Blog(..)+ , StartupConfig(..)+ , BlogM+ , GenEvent(..)+ , GenState(..) , Post(..) , Template , ChangeSummary(..) , Page(..) , Processor(..)+ , RenderCause(..)+ , BlogInputFS(..)+ , BlogOutputFS(..)+ , BlogInputFSState(..) , nullProcessor+ , noChanges+ , theBlog+ , theConfig+ , notify+ , runBlogM+ , blogOutputFS+ , blogInputFS ) where-import Data.Time.Clock- ( UTCTime- )+import Control.Concurrent.Chan+import Control.Monad.Reader+import Data.Time.Clock (UTCTime)+import Data.Monoid+import Data.List (nub)+import System.FilePath ((</>))+import Network.Socket (HostName, PortNumber) import qualified Text.Pandoc as Pandoc import Text.StringTemplate ( StringTemplate ) +data StartupConfig = StartupConfig { dataDirectory :: FilePath+ , initDataDirectory :: Bool+ , forceRegeneration :: Bool+ , htmlOutputDirectory :: FilePath+ , configFilePath :: FilePath+ , listenAddr :: Maybe (HostName, PortNumber)+ , overrideBaseUrl :: Maybe String+ }+ deriving (Show, Eq)++blogOutputFS :: StartupConfig -> BlogOutputFS+blogOutputFS c =+ let base = htmlOutputDirectory c+ images = base </> "generated-images"+ posts = base </> "posts"+ in BlogOutputFS { ofsBaseDir = base+ , ofsPostHtmlDir = posts+ , ofsImageDir = images+ , ofsHtmlTempDir = base </> "tmp"+ , ofsImagePath = \fn -> images </> fn+ , ofsIndexHtml = base </> "index.html"+ , ofsRssXml = base </> "feed.xml"+ , ofsListHtml = posts </> "index.html"+ , ofsPostFinalHtml = \p -> posts </> postHtmlFilename p+ }++blogInputFS :: StartupConfig -> BlogInputFS+blogInputFS c =+ let base = dataDirectory c+ templates = base </> "templates"+ posts = base </> "posts"+ in BlogInputFS { ifsBaseDir = base+ , ifsPostSourceDir = posts+ , ifsTemplateDir = templates+ , ifsPostIndexPath = posts </> "posts-index"+ , ifsConfigPath = base </> "blog.cfg"+ , ifsAssetDir = base </> "assets"+ , ifsPageTemplatePath = templates </> "pageTemplate.html"+ , ifsListTemplatePath = templates </> "listTemplate.html"+ , ifsPostTemplatePath = templates </> "postTemplate.html"+ , ifsRssTemplatePath = templates </> "rssTemplate.xml"+ }++data GenState =+ GenState { stBlog :: Blog+ , stChan :: Chan GenEvent+ , stConfig :: StartupConfig+ }++data GenEvent = PostRender Post [RenderCause]+ | Finished++data RenderCause = Config+ | PostIndex+ | Template+ | PostModified+ | Forced+ deriving (Eq, Show)++type BlogM a = ReaderT GenState IO a++theBlog :: BlogM Blog+theBlog = asks stBlog++theConfig :: BlogM StartupConfig+theConfig = asks stConfig++notify :: GenEvent -> BlogM ()+notify ev = do+ ch <- asks stChan+ liftIO $ writeChan ch ev++runBlogM :: Blog -> Chan GenEvent -> StartupConfig -> BlogM a -> IO a+runBlogM b ch conf act = runReaderT act (GenState b ch conf)+ type Template = StringTemplate String -data Blog = Blog { baseDir :: FilePath- , postSourceDir :: FilePath- , htmlDir :: FilePath- , assetDir :: FilePath- , postHtmlDir :: FilePath- , postIntermediateDir :: FilePath- , imageDir :: FilePath- , templateDir :: FilePath- , htmlTempDir :: FilePath+data BlogInputFS =+ BlogInputFS { ifsBaseDir :: FilePath+ , ifsPostSourceDir :: FilePath+ , ifsAssetDir :: FilePath+ , ifsTemplateDir :: FilePath+ , ifsConfigPath :: FilePath+ , ifsPostIndexPath :: FilePath+ , ifsPageTemplatePath :: FilePath+ , ifsListTemplatePath :: FilePath+ , ifsPostTemplatePath :: FilePath+ , ifsRssTemplatePath :: FilePath+ }++data BlogOutputFS =+ BlogOutputFS { ofsBaseDir :: FilePath+ , ofsPostHtmlDir :: FilePath+ , ofsImageDir :: FilePath+ , ofsHtmlTempDir :: FilePath+ , ofsImagePath :: String -> FilePath+ , ofsIndexHtml :: FilePath+ , ofsRssXml :: FilePath+ , ofsListHtml :: FilePath+ , ofsPostFinalHtml :: Post -> FilePath+ }++data BlogInputFSState =+ BlogInputFSState { ifsPostIndexMTime :: UTCTime+ , ifsConfigMTime :: UTCTime+ , ifsBaselineMTime :: UTCTime+ , ifsTemplateMTime :: UTCTime+ }+++data Blog = Blog { inputFS :: BlogInputFS+ , outputFS :: BlogOutputFS+ , inputFSState :: BlogInputFSState , baseUrl :: String- , eqPreamblesDir :: FilePath , title :: String , authorName :: String , authorEmail :: String- , configPath :: FilePath , blogPosts :: [Post] , processors :: [Processor] }@@ -41,24 +160,34 @@ , postPath :: String , postFilename :: String , postModificationTime :: UTCTime+ , postModificationString :: String , postAst :: Pandoc.Pandoc+ , postTeXMacros :: String+ , postAuthors :: [String]+ , postDate :: Maybe String+ , postBaseName :: String+ , postUrl :: String+ , postHtmlFilename :: String }+ deriving (Eq) data Page = BlogPost | Index data Processor = Processor { applyWriterOptions :: Maybe (Pandoc.WriterOptions -> Pandoc.WriterOptions)- , preProcessPost :: Maybe (Blog -> Post -> IO Post)- , postProcessPost :: Maybe (Blog -> FilePath -> Page -> IO ())+ , preProcessPost :: Maybe (Post -> BlogM Post)+ , postProcessPost :: Maybe (FilePath -> Page -> BlogM ()) , pageHead :: Maybe String , buildPostTitle :: Maybe (Page -> [Pandoc.Inline] -> [Pandoc.Inline]) , rawPostTitle :: Maybe ([Pandoc.Inline] -> String)+ , checkDataDir :: Maybe (BlogM ())+ , installAssets :: Maybe (BlogM ()) } nullProcessor :: Processor nullProcessor =- Processor Nothing Nothing Nothing Nothing Nothing Nothing+ Processor Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- Summarize changes in files so we know what to do during the -- regeneration phase. postsChanged and configChanged are the primary@@ -67,8 +196,21 @@ data ChangeSummary = ChangeSummary { postsChanged :: [String] , configChanged :: Bool- , templatesChanged :: Bool+ , templatesChanged :: [FilePath] , postIndexChanged :: Bool- , assetsChanged :: Bool+ , assetsChanged :: [FilePath] } deriving (Show)++noChanges :: ChangeSummary+noChanges = ChangeSummary [] False [] False []++instance Monoid ChangeSummary where+ mempty = noChanges+ a `mappend` b =+ ChangeSummary { postsChanged = nub $ postsChanged a ++ postsChanged b+ , configChanged = configChanged a || configChanged b+ , templatesChanged = templatesChanged a `mappend` templatesChanged b+ , postIndexChanged = postIndexChanged a || postIndexChanged b+ , assetsChanged = assetsChanged a `mappend` assetsChanged b+ }
src/MB/Util.hs view
@@ -1,22 +1,18 @@ module MB.Util- ( copyTree+ ( copyContents , toUtcTime- , toLocalTime- , rssModificationTime , loadPostIndex , getModificationTime , allPostFilenames , dirFilenames- , anyChanges- , summarizeChanges+ , dirFilenamesRecursive , serializePostIndex+ , ensureDir+ , getInlineStr+ , fromInlines ) where import Control.Applicative- ( (<$>)- , (<*>)- , pure- ) import System.Directory ( doesDirectoryExist , doesFileExist@@ -24,22 +20,27 @@ , getDirectoryContents , copyFile )+import Data.Default+ ( def+ ) import System.FilePath ( (</>) , takeFileName+ , takeBaseName )+import Control.Monad.Trans (liftIO)+import Control.Monad.Trans.Either import Control.Monad ( when , forM_ , forM , filterM )-import System.Exit- ( exitFailure- ) import System.Posix.Files ( getFileStatus , modificationTime+ , accessTime+ , setFileTimes ) import System.Posix.Types ( EpochTime@@ -48,25 +49,13 @@ ( isSuffixOf , isPrefixOf )+import Data.Time.LocalTime import Data.Time.Clock- ( UTCTime(utctDay)- , getCurrentTime- )-import Data.Time.Calendar- ( addDays- ) import Data.Time.Format ( parseTime- , formatTime )-import Data.Time.LocalTime- ( LocalTime- , getCurrentTimeZone- , utcToLocalTime- )-import System.Locale+import Data.Time.Format ( defaultTimeLocale- , rfc822DateFormat ) import System.IO ( IOMode(ReadMode)@@ -82,67 +71,85 @@ , catMaybes ) import qualified Text.Pandoc as Pandoc-import qualified MB.Files as Files import MB.Types--copyTree :: FilePath -> FilePath -> IO ()-copyTree srcPath dstPath = do- dstFExists <- doesFileExist dstPath- dstDExists <- doesDirectoryExist dstPath-- when (dstFExists) $ do- putStrLn $ "Cannot copy " ++ (show srcPath) ++ " to existing destination path " ++- (show dstPath) ++ "; remove to continue."- exitFailure+import MB.TeXMacros+import Control.DeepSeq - when (not dstDExists) $ createDirectory dstPath+-- |Given a source path SRC and a destination path DST, the SRC and+-- DST paths MUST exist and must both be directories. All contents of+-- SRC/ will be copied, recursively, to DST/.+copyContents :: FilePath -> FilePath -> IO ()+copyContents src dst = do+ -- For each file in src, copy it to dest.+ entries <- filter (not . flip elem [".", ".."]) <$> getDirectoryContents src - copyTree' srcPath dstPath+ dirs <- filterM doesDirectoryExist $ map (src </>) entries+ files <- filterM doesFileExist $ map (src </>) entries - where- copyTree' src dst = do- -- For each file in src, copy it to dest.- entries <- filter (not . flip elem [".", ".."]) <$> getDirectoryContents src+ -- For each directory in src, create it in dest, then descend into+ -- that directory in both src and dest.+ forM_ files $ \f -> do+ let destPath = dst </> takeFileName f+ st <- getFileStatus f+ copyFile f destPath+ setFileTimes destPath (accessTime st) (modificationTime st) - dirs <- filterM doesDirectoryExist $ map (src </>) entries- files <- filterM doesFileExist $ map (src </>) entries+ forM_ dirs $ \dir ->+ do+ let dstDir = dst </> dirName+ dirName = takeFileName dir - -- For each directory in src, create it in dest, then descend- -- into that directory in both src and dest.- forM_ files $ \f -> copyFile f $ dst </> takeFileName f- forM_ dirs $ \dir ->- do- let dstDir = dst </> dirName- dirName = takeFileName dir+ e <- doesDirectoryExist dstDir+ when (not e) $ do+ createDirectory dstDir+ st <- getFileStatus $ src </> dirName+ setFileTimes dstDir (accessTime st) (modificationTime st) - e <- doesDirectoryExist dstDir- when (not e) $ createDirectory dstDir- copyTree' (src </> dirName) dstDir+ copyContents (src </> dirName) dstDir toUtcTime :: EpochTime -> UTCTime toUtcTime t = fromJust $ parseTime defaultTimeLocale "%s" $ show t -toLocalTime :: UTCTime -> IO LocalTime-toLocalTime u = do- tz <- getCurrentTimeZone- return $ utcToLocalTime tz u+loadPost :: FilePath -> EitherT String IO Post+loadPost fullPath = do+ fileContent <- liftIO $ readFile fullPath+ t <- liftIO $ getModificationTime fullPath+ (Pandoc.Pandoc m blocks) <- hoistEither $ case Pandoc.readMarkdown def fileContent of+ Left pandocErr -> Left $ show pandocErr+ Right v -> Right v -rssModificationTime :: Post -> String-rssModificationTime =- formatTime defaultTimeLocale rfc822DateFormat . postModificationTime+ -- Extract defined TeX macros in the post and store them in+ -- the post data structure to make them available to other+ -- parts of the page generation process (see Mathjax and TikZ+ -- for examples.)+ let (newBlocks, macros) = extractTeXMacros blocks -loadPost :: FilePath -> IO Post-loadPost fullPath = do- fileContent <- readFile fullPath- t <- getModificationTime fullPath- let doc = Pandoc.readMarkdown Pandoc.defaultParserState fileContent- Pandoc.Pandoc m _ = doc+ pas = case Pandoc.docAuthors m of+ [] -> []+ as -> fromInlines <$> as + pd = case Pandoc.docDate m of+ [] -> Nothing+ d -> Just $ fromInlines d++ tz <- liftIO getCurrentTimeZone+ localTime <- liftIO $ toLocalTime t+ let modStr = show localTime ++ " " ++ timeZoneName tz+ bn = takeBaseName $ takeFileName fullPath+ htmlFilename = bn ++ ".html"+ return $ Post { postTitle = Pandoc.docTitle m , postPath = fullPath , postFilename = takeFileName fullPath , postModificationTime = t- , postAst = doc+ , postAst = Pandoc.Pandoc m newBlocks+ , postTeXMacros = macros+ , postAuthors = pas+ , postDate = pd+ , postModificationString = modStr+ , postBaseName = bn+ , postUrl = "/posts/" ++ htmlFilename+ , postHtmlFilename = htmlFilename } dirFilenames :: FilePath -> IO [FilePath]@@ -173,25 +180,24 @@ info <- getFileStatus fullPath return $ toUtcTime $ modificationTime info -loadPostIndex :: FilePath -> IO [Post]-loadPostIndex postSrcDir = do- let indexFilename = postSrcDir </> "posts-index"- e <- doesFileExist indexFilename+loadPostIndex :: BlogInputFS -> EitherT String IO [Post]+loadPostIndex ifs = do+ let indexFilename = ifsPostIndexPath ifs+ e <- liftIO $ doesFileExist indexFilename - indexNames <- case e of+ indexNames <- liftIO $ case e of False -> return [] True -> do h <- openFile indexFilename ReadMode s <- hGetContents h- s `seq` return ()+ s `deepseq` return () let idx = unserializePostIndex s hClose h return idx -- Now that we have a postIndex to deal with, load posts from disk -- and insert them into the post index in the proper order-- postFiles <- allPostFilenames postSrcDir+ postFiles <- liftIO $ allPostFilenames $ ifsPostSourceDir ifs posts <- mapM loadPost postFiles -- There are two types of posts to put into the index: the ones that@@ -215,55 +221,22 @@ sortPosts = sortBy (\a b -> postModificationTime b `compare` postModificationTime a) -anyChanges :: ChangeSummary -> Bool-anyChanges s = or $ predicates <*> pure s- where- predicates = [ configChanged- , not . null . postsChanged- , templatesChanged- , postIndexChanged- , assetsChanged- ]+ensureDir :: FilePath -> IO ()+ensureDir d = do+ exists <- doesDirectoryExist d+ when (not exists) $ createDirectory d -summarizeChanges :: Blog -> Bool -> IO ChangeSummary-summarizeChanges config forceAll = do- -- Determine whether the configuration file changed. Check to see- -- if it's newer than the index.html file, or if no index.html- -- exists then that's equivalent to "the config changed"- configMtime <- getModificationTime $ configPath config- indexExists <- doesFileExist $ Files.indexHtml config- baseTime <- case indexExists of- False -> do- t <- getCurrentTime- return $ t { utctDay = addDays (- 1) $ utctDay t }- True -> getModificationTime $ Files.indexHtml config+getInlineStr :: Pandoc.Inline -> String+getInlineStr (Pandoc.Str s) = s+getInlineStr (Pandoc.Math _ s) = s+getInlineStr Pandoc.Space = " "+getInlineStr i = error $ "Unexpected inline in document title, got " ++ (show i) - postIndexExists <- doesFileExist $ Files.postIndex config- postIndexChanged' <- case postIndexExists of- False -> return True- True -> do- t <- getModificationTime $ Files.postIndex config- return $ t > baseTime+fromInlines :: [Pandoc.Inline] -> String+fromInlines = concat . (getInlineStr <$>) - let configChanged' = configMtime > baseTime- needsRebuild p = forceAll || (postModificationTime p > baseTime)- modifiedPosts = filter needsRebuild $ blogPosts config - -- Determine whether any templates changed- templateFiles <- dirFilenames (templateDir config)- templateChanges <- forM templateFiles $ \f -> do- mtime <- getModificationTime f- return $ mtime > baseTime-- -- Determine whether any assets changed- assetFiles <- dirFilenamesRecursive (assetDir config)- assetChanges <- forM assetFiles $ \f -> do- mtime <- getModificationTime f- return $ mtime > baseTime-- return $ ChangeSummary { configChanged = configChanged' || forceAll- , postsChanged = map postFilename modifiedPosts- , templatesChanged = or (forceAll : templateChanges)- , postIndexChanged = postIndexChanged' || forceAll- , assetsChanged = or (forceAll : assetChanges)- }+toLocalTime :: UTCTime -> IO LocalTime+toLocalTime u = do+ tz <- getCurrentTimeZone+ return $ utcToLocalTime tz u
src/Main.hs view
@@ -2,300 +2,196 @@ import Control.Applicative import Control.Monad+import Control.Monad.Reader import Control.Concurrent+import Control.Monad.Trans.Either import Data.Maybe+import Data.Time.Clock+import Data.Time.Calendar+import Data.List import System.IO import System.Exit import System.Directory+ hiding (getModificationTime) import System.FilePath-import Data.Time.LocalTime-import qualified Text.Pandoc as Pandoc++import System.FSNotify+ import qualified MB.Config as Config-import MB.Templates- ( loadTemplate- , renderTemplate- )-import MB.Processing+import MB.Server import MB.Util- ( copyTree- , toLocalTime- , rssModificationTime- , loadPostIndex- , anyChanges- , serializePostIndex- , summarizeChanges- ) import MB.Types-import qualified MB.Files as Files-import Paths_mathblog- ( getDataFileName- ) import MB.Startup- ( StartupConfig(..)- , dataDirectory- , listenMode- , startupConfigFromEnv- , forceRegeneration- , initDataDirectory- )-import MB.Gnuplot-import MB.Tikz-import MB.Mathjax-import MB.Gladtex--defaultConfigFilename :: String-defaultConfigFilename = "blog.cfg"--skelDir :: IO FilePath-skelDir = getDataFileName "skel"--commonTemplateAttrs :: Blog -> [(String, String)]-commonTemplateAttrs blog =- [ ( "baseUrl", baseUrl blog )- , ( "title", title blog )- , ( "authorName", authorName blog )- , ( "authorEmail", authorEmail blog )- , ( "extraPageHead", extraPageHead blog )- ]--extraPageHead :: Blog -> String-extraPageHead b = concat $ catMaybes $ pageHead <$> processors b--fillTemplate :: Blog -> Template -> [(String, String)] -> String-fillTemplate blog t attrs = renderTemplate attrs' t- where attrs' = commonTemplateAttrs blog ++ attrs--writeTemplate :: Blog -> Handle -> Template -> [(String, String)] -> IO ()-writeTemplate blog h t attrs = hPutStr h $ fillTemplate blog t attrs--writePost :: Blog -> Handle -> Post -> IO ()-writePost blog h post = do- let writerOpts = getWriterOptions blog Pandoc.defaultWriterOptions- created <- postModificationString post- hPutStr h $ "<h1>" ++ getPostTitle blog post BlogPost ++ "</h1>"- hPutStr h $ "<span class=\"post-created\">Posted " ++ created ++ "</span>"- hPutStr h $ Pandoc.writeHtmlString writerOpts (postAst post)--buildLinks :: Blog -> Maybe Post -> Maybe Post -> String-buildLinks _blog prev next =- "<div id=\"prev-next-links\">"- ++ link "next-link" "older »" next- ++ link "prev-link" "« newer" prev- ++ "</div>"- where- link cls name Nothing =- "<span class=\"" ++ cls ++ "-subdued\">" ++ name ++ "</span>"- link cls name (Just p) =- "<a class=\"" ++ cls ++ "\" href=\"" ++ Files.postUrl p ++- "\">" ++ name ++ "</a>"--jsInfo :: Post -> String-jsInfo post =- "<script type=\"text/javascript\">\n" ++- "Blog = {\n" ++- " pageName: " ++ show (Files.postBaseName post) ++- "\n" ++- "};\n" ++- "</script>\n"--buildPage :: Handle -> Blog -> String -> Maybe String -> IO ()-buildPage h blog content extraTitle = do- eTmpl <- loadTemplate $ Files.pageTemplatePath blog-- case eTmpl of- Left msg -> putStrLn msg >> exitFailure- Right tmpl ->- do- let attrs = [ ("content", content)- ] ++ maybe [] (\t -> [("extraTitle", t)]) extraTitle-- writeTemplate blog h tmpl attrs- hClose h--buildPost :: Handle -> Blog -> Post -> (Maybe Post, Maybe Post) -> IO ()-buildPost h blog post prevNext = do- eTmpl <- loadTemplate $ Files.postTemplatePath blog-- case eTmpl of- Left msg -> putStrLn msg >> exitFailure- Right tmpl ->- do- html <- readFile $ Files.postIntermediateHtml blog post-- let attrs = [ ("post", html)- , ("nextPrevLinks", uncurry (buildLinks blog) prevNext)- , ("jsInfo", jsInfo post)- ]-- let out = (fillTemplate blog tmpl attrs)- buildPage h blog out $ Just $ getRawPostTitle blog post--generatePost :: Blog -> Post -> ChangeSummary -> IO ()-generatePost blog post summary = do- let finalHtml = Files.postIntermediateHtml blog post- generate = (postFilename post `elem` (postsChanged summary))- || configChanged summary+import MB.Initialize+import MB.Templates - when generate $ do- putStrLn $ "Rendering " ++ Files.postBaseName post+import MB.Gen.Post+import MB.Gen.PostList+import MB.Gen.Index+import MB.Gen.RSS - newPost <- applyPreProcessors blog post+import MB.Processors.Tikz+import MB.Processors.Mathjax+import MB.Processors.Base - h <- openFile finalHtml WriteMode- writePost blog h newPost- hClose h- applyPostProcessors blog finalHtml BlogPost+ensureDirs :: BlogInputFS -> BlogOutputFS -> IO ()+ensureDirs ifs ofs = do+ let ifsDirs = [ ifsPostSourceDir+ , ifsAssetDir+ , ifsTemplateDir+ ]+ ofsDirs = [ ofsBaseDir+ , ofsPostHtmlDir+ , ofsImageDir+ , ofsHtmlTempDir+ ] -generatePosts :: Blog -> ChangeSummary -> IO ()-generatePosts blog summary = do- let numRegenerated = if configChanged summary- then length $ blogPosts blog- else length $ postsChanged summary- when (numRegenerated > 0) $ putStrLn $ "Rendering " ++ (show numRegenerated) ++ " post(s)..."+ forM_ (ifsDirs <*> pure ifs) ensureDir+ forM_ (ofsDirs <*> pure ofs) ensureDir - let n = length posts- posts = blogPosts blog- forM_ (zip posts [0..]) $ \(p, i) ->- do- let prevPost = if i == 0 then Nothing else Just (posts !! (i - 1))- nextPost = if i == n - 1 then Nothing else Just (posts !! (i + 1))+doGeneration :: StartupConfig -> Blog -> (GenEvent -> IO ()) -> IO ()+doGeneration config blog handler = do+ ch <- newChan+ mv <- newEmptyMVar - generatePost blog p summary- h <- openFile (Files.postFinalHtml blog p) WriteMode- buildPost h blog p (prevPost, nextPost)- hClose h+ let waitForEvents = do+ ev <- readChan ch+ handler ev+ case ev of+ Finished -> putMVar mv ()+ _ -> waitForEvents -buildIndexPage :: Blog -> IO ()-buildIndexPage blog = do- let src = Files.postFinalHtml blog post- index = Files.indexHtml blog- post = head $ blogPosts blog+ _ <- forkIO waitForEvents+ runBlogM blog ch config regenerateContent - copyFile src index+ -- Signal event handler to shut down+ writeChan ch Finished -postModificationString :: Post -> IO String-postModificationString p = do- tz <- getCurrentTimeZone- localTime <- toLocalTime $ postModificationTime p- return $ show localTime ++ " " ++ timeZoneName tz+ -- Wait for event handler to shut down+ _ <- readMVar mv+ return () -generatePostList :: Blog -> IO ()-generatePostList blog = do- -- For each post in the order they were given, extract the- -- unrendered title and construct an htex document. Then render it- -- to the listing location.- entries <- forM (blogPosts blog) $ \p ->- do- created <- postModificationString p- return $ concat [ "<div class=\"listing-entry\"><span class=\"post-title\">"- , "<a href=\"" ++ Files.postUrl p ++ "\">"- , getPostTitle blog p Index- , "</a></span><span class=\"post-created\">Posted "- , created- , "</span></div>\n"- ]+isEventInteresting :: BlogInputFS -> Event -> Bool+isEventInteresting ifs ev =+ let fp = case ev of+ Added f _ -> f+ Modified f _ -> f+ Removed f _ -> f - let content = "<div id=\"all-posts\">" ++ concat entries ++ "</div>"+ isPost f = (ifsPostSourceDir ifs) `isPrefixOf` f &&+ ".txt" `isSuffixOf` f &&+ not ("." `isPrefixOf` takeFileName f) - h <- openFile (Files.listHtml blog) WriteMode- buildPage h blog content Nothing- hClose h+ isPostIndex f = ifsPostIndexPath ifs == f - applyPostProcessors blog (Files.listHtml blog) Index+ isAsset f = (ifsAssetDir ifs) `isPrefixOf` f -rssItem :: Blog -> Post -> String-rssItem blog p =- concat [ "<item>"- , "<title>" ++ getRawPostTitle blog p ++ "</title>\n"- , "<link>" ++ baseUrl blog ++ Files.postUrl p ++ "</link>\n"- , "<pubDate>" ++ rssModificationTime p ++ "</pubDate>\n"- , "<guid>" ++ baseUrl blog ++ Files.postUrl p ++ "</guid>\n"- , "</item>\n"- ]+ isTemplate f = (ifsTemplateDir ifs) `isPrefixOf` f &&+ (not ("." `isPrefixOf` takeFileName f)) &&+ ((".html" `isSuffixOf` f) ||+ (".xml" `isSuffixOf` f)) -generateRssFeed :: Blog -> IO ()-generateRssFeed blog = do- h <- openFile (Files.rssXml blog) WriteMode+ isConfig f = ifsConfigPath ifs == f - eTmpl <- loadTemplate $ Files.rssTemplatePath blog+ in or ([ isPost+ , isAsset+ , isTemplate+ , isConfig+ , isPostIndex+ ] <*> pure fp) - case eTmpl of- Left msg -> putStrLn msg >> exitFailure- Right tmpl ->+scanForChanges :: StartupConfig+ -> (GenEvent -> IO ())+ -> (Blog -> Blog)+ -> IO ()+ -> IO ()+scanForChanges conf h blogTrans signalAct = do+ let ifs = blogInputFS conf+ forever $ do+ withManager $ \m -> do- let items = map (rssItem blog) $ blogPosts blog- itemStr = concat items- attrs = [ ("items", itemStr)- ]-- writeTemplate blog h tmpl attrs- hClose h--initializeDataDir :: FilePath -> IO ()-initializeDataDir dir = do- existsBase <- doesDirectoryExist dir- existsConfig <- doesFileExist $ dir </> defaultConfigFilename-- dataDir <- skelDir-- when (not existsBase || not existsConfig) $ do- putStrLn $ "Setting up data directory using skeleton: " ++ dataDir- when (not existsBase) $ createDirectory dir- copyTree dataDir dir-- when existsConfig $- putStrLn $ "Data directory already initialized; found " ++- (dir </> defaultConfigFilename)+ let loadBlog =+ do+ result <- runEitherT (mkBlog conf)+ case result of+ Left e -> do+ putStrLn $ "Error reading blog configuration: " ++ e+ threadDelay 1000000+ loadBlog+ Right blog -> return $ blogTrans blog -ensureDirs :: Blog -> IO ()-ensureDirs blog = do- let dirs = [ postSourceDir- , htmlDir- , assetDir- , postHtmlDir- , postIntermediateDir- , imageDir- , templateDir- , htmlTempDir- , eqPreamblesDir- ]+ blog <- loadBlog+ doGeneration conf blog h+ signalAct+ putStrLn "" - forM_ (dirs <*> pure blog) $ \d ->- do- exists <- doesDirectoryExist d- when (not exists) $ createDirectory d+ -- Wait for a bit so the filesystem scan doesn't pick up the+ -- posts-index change in the source tree+ threadDelay $ 500 * 1000 -scanForChanges :: IO Bool -> IO ()-scanForChanges act = do- scan- where- scan = do- didWork <- act- when didWork $ putStrLn ""- threadDelay $ 1 * 1000 * 1000- scan+ ch <- newChan+ watchTreeChan m (dataDirectory conf) (const True) ch+ let nextEv = do+ ev <- readChan ch+ if isEventInteresting ifs ev then return ev else nextEv+ evt <- nextEv+ case evt of+ Added fp _ -> putStrLn $ "File created: " ++ fp+ Modified fp _ -> putStrLn $ "File modified: " ++ fp+ Removed fp _ -> putStrLn $ "File removed: " ++ fp mathBackends :: [(String, Processor)] mathBackends =- [ ("gladtex", gladtexProcessor)- , ("mathjax", mathjaxProcessor)+ [ ("mathjax", mathjaxProcessor) ] eqBackends :: [(String, Processor)] eqBackends =- [ ("gnuplot", gnuplotProcessor)- , ("tikz", tikzProcessor)+ [ ("tikz", tikzProcessor) ] -mkBlog :: StartupConfig -> IO Blog+getIFSState :: BlogInputFS -> BlogOutputFS -> IO BlogInputFSState+getIFSState ifs ofs =+ BlogInputFSState <$> indexMod <*> configMod <*> baseline <*> template+ where+ -- As a fallback timestamp, use a time in the past to ensure+ -- things get regenerated if they're missing.+ fallback = previousDay <$> getCurrentTime+ previousDay t =+ t { utctDay = addDays (-1000) (utctDay t) }++ indexMod = do+ let pth = ifsPostIndexPath ifs+ ex <- doesFileExist pth+ if ex then getModificationTime pth else fallback++ configMod = do+ let pth = ifsConfigPath ifs+ ex <- doesFileExist pth+ if ex then getModificationTime pth else fallback++ template = do+ contents <- getDirectoryContents $ ifsTemplateDir ifs+ let templates = filter (not . flip elem [".", ".."]) contents+ templatePath = (ifsTemplateDir ifs </>)+ last <$> sort <$>+ mapM getModificationTime (templatePath <$> templates)++ baseline = do+ let indexHtml = ofsIndexHtml ofs+ ex <- doesFileExist indexHtml+ if ex then getModificationTime indexHtml else fallback++mkBlog :: StartupConfig -> EitherT String IO Blog mkBlog conf = do- let base = dataDirectory conf- configFile = base </> (configFilePath conf)- e <- doesFileExist configFile+ let ifs = blogInputFS conf+ ofs = blogOutputFS conf+ configPath = ifsConfigPath ifs - when (not e) $ do- putStrLn $ "Configuration file " ++ configFile ++ " not found"- exitFailure+ e <- liftIO $ doesFileExist configPath+ case e of+ False -> left $ "Configuration file " ++ configPath ++ " not found"+ True -> return () let requiredValues = [ "baseUrl" , "title"@@ -303,7 +199,7 @@ , "authorEmail" ] - cfg <- Config.readConfig configFile requiredValues+ cfg <- Config.readConfig configPath requiredValues let Just cfg_baseUrl = lookup "baseUrl" cfg Just cfg_title = lookup "title" cfg@@ -311,117 +207,116 @@ Just cfg_authorEmail = lookup "authorEmail" cfg -- Load blog posts from disk- let postSrcDir = base </> "posts"- allPosts <- loadPostIndex postSrcDir+ allPosts <- loadPostIndex ifs let requestedMathBackend = lookup "mathBackend" cfg- mathBackend = case requestedMathBackend of- Nothing -> mathjaxProcessor- Just b -> case lookup b mathBackends of- Nothing -> error $ "Unsupported math backend " ++ show b- ++ "; valid choices are "- ++ (show $ fst <$> mathBackends)- Just proc -> proc-- requestedEqBackend = lookup "eqBackend" cfg- eqBackend = case requestedEqBackend of- Nothing -> gnuplotProcessor- Just b -> case lookup b eqBackends of- Nothing -> error $ "Unsupported equation backend " ++ show b- ++ "; valid choices are "- ++ (show $ fst <$> eqBackends)- Just proc -> proc-- procs = [eqBackend, mathBackend]-- let html = htmlOutputDirectory conf- b = Blog { baseDir = base- , postSourceDir = postSrcDir- , htmlDir = html- , assetDir = base </> "assets"- , postHtmlDir = html </> "posts"- , postIntermediateDir = base </> "generated"- , imageDir = html </> "generated-images"- , templateDir = base </> "templates"- , htmlTempDir = base </> "tmp"- , baseUrl = cfg_baseUrl- , title = cfg_title- , authorName = cfg_authorName- , authorEmail = cfg_authorEmail- , eqPreamblesDir = base </> "eq-preambles"- , configPath = configFile- , blogPosts = allPosts- , processors = procs- }+ isBackendRequested (nam, p) =+ let Just opt = lookup nam cfg <|> Just "no"+ in if Config.affirmative opt+ then Just p+ else Nothing - ensureDirs b- return b+ mathBackend <- case requestedMathBackend of+ Nothing -> return mathjaxProcessor+ Just b -> case lookup b mathBackends of+ Nothing -> left $ "Unsupported math backend " ++ show b+ ++ "; valid choices are "+ ++ (show $ fst <$> mathBackends)+ Just proc -> return proc -installAssets :: Blog -> IO ()-installAssets blog = do- let ad = assetDir blog+ let procs = baseProcessor : eqBackendConfig ++ [mathBackend]+ eqBackendConfig = catMaybes $ isBackendRequested <$> eqBackends - -- For each file and directory in assets/, copy it to the output- -- directory.- entries <- filter (not . flip elem [".", ".."]) <$> getDirectoryContents ad+ ifsState <- liftIO $ getIFSState ifs ofs+ liftIO $ ensureDirs ifs ofs - dirs <- filterM doesDirectoryExist $ map (ad </>) entries- files <- filterM doesFileExist $ map (ad </>) entries+ return $ Blog { inputFS = ifs+ , outputFS = ofs+ , inputFSState = ifsState+ , baseUrl = fromJust (overrideBaseUrl conf <|> Just cfg_baseUrl)+ , title = cfg_title+ , authorName = cfg_authorName+ , authorEmail = cfg_authorEmail+ , blogPosts = allPosts+ , processors = procs+ } - forM_ dirs $ \d -> copyTree d (htmlDir blog </> (takeBaseName d))- forM_ files $ \f -> copyFile f (htmlDir blog)+-- For each configured document processor, run its check routine in+-- case it needs to install data files or do validation.+runProcessorChecks :: BlogM ()+runProcessorChecks = do+ ps <- processors <$> theBlog+ let checks = catMaybes $ checkDataDir <$> ps+ sequence_ checks -regenerateContent :: StartupConfig -> IO Bool-regenerateContent conf = do- blog <- mkBlog conf- summary <- summarizeChanges blog (forceRegeneration conf)+doInstallAssets :: BlogM ()+doInstallAssets = do+ ps <- processors <$> theBlog+ let fs = catMaybes $ installAssets <$> ps+ sequence_ fs - case anyChanges summary of- False -> return False- True -> do- putStrLn $ "Blog directory: " ++ baseDir blog- putStrLn $ "Config file: " ++ configFilePath conf+regenerateContent :: BlogM ()+regenerateContent = do+ blog <- theBlog+ let ifs = inputFS blog+ ofs = outputFS blog - when (configChanged summary) $- putStrLn "Configuration file changed; regenerating all content."- when (templatesChanged summary) $- putStrLn "Templates changed; regenerating accordingly."- when (not $ null $ postsChanged summary) $- do- putStrLn "Posts changed:"- forM_ (postsChanged summary) $ \n -> putStrLn $ " " ++ n- when (postIndexChanged summary) $- putStrLn "Post index changed; regenerating next/previous links."+ runProcessorChecks - when (assetsChanged summary) $- do- putStrLn "Assets changed; reinstalling."- installAssets blog+ generatePosts+ buildIndexPage+ generatePostList - generatePosts blog summary+ withTemplate (ifsRssTemplatePath ifs) $ \t ->+ liftIO $ writeFile (ofsRssXml ofs) $ generateRssFeed blog t - buildIndexPage blog- generatePostList blog- generateRssFeed blog+ liftIO $ writeFile (ifsPostIndexPath ifs) $+ serializePostIndex $ blogPosts blog - writeFile (Files.postIndex blog) $- serializePostIndex $ blogPosts blog+ doInstallAssets - putStrLn "Done."- return True+printHandler :: GenEvent -> IO ()+printHandler (PostRender p cs) =+ let cause Config = "config"+ cause PostIndex = "post-index"+ cause Template = "template"+ cause PostModified = "modified"+ cause Forced = "forced"+ reasons = intercalate ", " (cause <$> cs)+ in if cs == [PostModified] || Forced `elem` cs+ then putStrLn $ "Rendering post: " ++ (show $ postBaseName p)+ else putStrLn $ "Rendering post (" ++ reasons+ ++ "): " ++ (show $ postBaseName p)+printHandler Finished =+ putStrLn "Done." main :: IO () main = do+ -- This is only to make it possible to run "mb" during the LaTeX+ -- manual build process. I run "mb" to generate output for+ -- demonstrations in the manual and output buffering was causing+ -- output to not get sent to pdfLaTeX.+ hSetBuffering stdout NoBuffering+ conf <- startupConfigFromEnv let dir = dataDirectory conf - when (initDataDirectory conf) $ initializeDataDir dir+ newConf <- case initDataDirectory conf of+ True -> do+ initializeDataDir dir+ return $ conf { forceRegeneration = True }+ False -> return conf - case listenMode conf of- False -> do- didWork <- regenerateContent conf- when (not didWork) $ putStrLn "No changes found!"- True -> do- putStrLn $ "Waiting for changes in " ++ (dataDirectory conf) ++ " ..."- scanForChanges- (regenerateContent $ conf { forceRegeneration = False })+ canonicalConfig <- canonicalizeStartupConfig newConf++ result <- runEitherT (mkBlog canonicalConfig)+ blog <- case result of+ Left e -> (putStrLn $ "Error: " ++ e) >> exitFailure+ Right b -> return b++ case listenAddr canonicalConfig of+ Nothing -> doGeneration canonicalConfig blog printHandler+ Just _ -> do+ putStrLn $ "Starting up in listen mode..."+ let conf' = canonicalConfig { forceRegeneration = False }+ withServing conf' $ flip scanForChanges printHandler
tests/src/MB/StartupTests.hs view
@@ -8,27 +8,56 @@ ( (@=?), assertFailure ) import MB.Startup+import MB.Types tests :: Test tests = testGroup "Startup configuration tests" [- testGroup "Base directory tests" $ map testBaseDir [+ testGroup "Data directory tests" $ map (testBaseDir dataDirectory) [ -- (desc, cmdline, env, base dir result) ("base dir in environment only"- , [], [(baseDirEnvName, "foo")], "foo")+ , [], [ (htmlOutputDirEnvName, "pth")+ , (baseDirEnvName, "foo")+ ]+ , "foo") , ("base dir on command line only"- , ["--" ++ baseDirParamName, "foo"], [], "foo")+ , [DataDir "foo"]+ , [(htmlOutputDirEnvName, "pth")]+ , "foo") , ("base dir in both places, command line takes precedence"- , ["--" ++ baseDirParamName, "foo"], [(baseDirEnvName, "bar")], "foo")+ , [DataDir "foo"]+ , [(baseDirEnvName, "bar"), (htmlOutputDirEnvName, "pth")]+ , "foo") ]- , testCase "No base directory" $ Nothing @=? startupConfig [] []+ , testGroup "HTML output directory tests" $ map (testBaseDir htmlOutputDirectory) [+ -- (desc, cmdline, env, base dir result)+ ("html dir in environment only"+ , [], [ (htmlOutputDirEnvName, "pth")+ , (baseDirEnvName, "foo")+ ]+ , "pth")+ , ("html dir on command line only"+ , [HtmlOutputDir "pth"]+ , [(baseDirEnvName, "foo")]+ , "pth")+ , ("html dir in both places, command line takes precedence"+ , [HtmlOutputDir "pth1"]+ , [(baseDirEnvName, "bar"), (htmlOutputDirEnvName, "pth2")]+ , "pth1")+ ]+ , testGroup "No base directory specified" $+ [ testCase "HTML output dir in environment" $ Nothing @=? startupConfig [] [(htmlOutputDirEnvName, "foo")]+ , testCase "HTML output dir in args" $ Nothing @=? startupConfig [HtmlOutputDir "foo"] []+ ]+ , testGroup "No html output directory specified" $+ [ testCase "Data dir in environment" $ Nothing @=? startupConfig [] [(baseDirEnvName, "foo")]+ , testCase "Data dir in args" $ Nothing @=? startupConfig [DataDir "foo"] []+ ] ] -testBaseDir :: (String, [String], [(String, String)], FilePath) -> Test-testBaseDir (desc, args, env, result) =+testBaseDir :: (Show a, Eq a) => (StartupConfig -> a) -> (String, [Flag], [(String, String)], a) -> Test+testBaseDir f (desc, args, env, result) = testCase desc assert where mConfig = startupConfig args env assert = case mConfig of Nothing -> assertFailure "could not construct configuration"- Just cfg -> result @=? dataDirectory cfg--+ Just cfg -> result @=? f cfg