diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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)) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 - - 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 `` tag of the page, such as - javascript tags, stylesheets, etc. You'll need to ensure that - this is somewhere in your `` 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} - - ~~~ - -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 - -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: - - - -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 () + - The TikZ and pgfplots LaTeX packages if you set `tikz = yes` in + your config. This is the recommended backend for function graph + plotting. diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 --- /dev/null +++ b/doc/Makefile @@ -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?/*~ diff --git a/doc/macros.tex b/doc/macros.tex new file mode 100644 --- /dev/null +++ b/doc/macros.tex @@ -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} + } +} diff --git a/doc/mathblog-manual.pdf b/doc/mathblog-manual.pdf new file mode 100644 Binary files /dev/null and b/doc/mathblog-manual.pdf differ diff --git a/doc/mathblog-manual.tex b/doc/mathblog-manual.tex new file mode 100644 --- /dev/null +++ b/doc/mathblog-manual.tex @@ -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{ , + }'' 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{} + tag of the page, such as javascript tags, stylesheets, etc. You'll + need to ensure that this is somewhere in your \fw{} 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} +
+\\( +$tex_macros$ +\\) +
+\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} diff --git a/doc/scripts/changed-post.sh b/doc/scripts/changed-post.sh new file mode 100644 --- /dev/null +++ b/doc/scripts/changed-post.sh @@ -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 diff --git a/doc/scripts/init.sh b/doc/scripts/init.sh new file mode 100644 --- /dev/null +++ b/doc/scripts/init.sh @@ -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 diff --git a/doc/scripts/listen-mode.sh b/doc/scripts/listen-mode.sh new file mode 100644 --- /dev/null +++ b/doc/scripts/listen-mode.sh @@ -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 diff --git a/doc/title_page.tex b/doc/title_page.tex new file mode 100644 --- /dev/null +++ b/doc/title_page.tex @@ -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 diff --git a/doc/toc.tex b/doc/toc.tex new file mode 100644 --- /dev/null +++ b/doc/toc.tex @@ -0,0 +1,2 @@ +\tableofcontents +\newpage diff --git a/mathblog.cabal b/mathblog.cabal --- a/mathblog.cabal +++ b/mathblog.cabal @@ -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 +Homepage: http://jtdaugherty.github.io/mathblog/ Maintainer: Jonathan Daugherty 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 diff --git a/skel/assets/stylesheets/stylesheet.css b/skel/assets/stylesheets/stylesheet.css --- a/skel/assets/stylesheets/stylesheet.css +++ b/skel/assets/stylesheets/stylesheet.css @@ -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; diff --git a/skel/blog.cfg b/skel/blog.cfg --- a/skel/blog.cfg +++ b/skel/blog.cfg @@ -2,3 +2,6 @@ title = A blog authorName = Your name here authorEmail = your@email.here +mathBackend = mathjax +tikz = yes +gnuplot = no diff --git a/skel/eq-templates/eq-basic.txt b/skel/eq-templates/eq-basic.txt deleted file mode 100644 --- a/skel/eq-templates/eq-basic.txt +++ /dev/null @@ -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 diff --git a/skel/posts/first-post.txt b/skel/posts/first-post.txt --- a/skel/posts/first-post.txt +++ b/skel/posts/first-post.txt @@ -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! diff --git a/skel/templates/listTemplate.html b/skel/templates/listTemplate.html new file mode 100644 --- /dev/null +++ b/skel/templates/listTemplate.html @@ -0,0 +1,10 @@ +
+$posts:{post| +
+ + $post.title$ + + Posted $post.date$ +
+}$ +
diff --git a/skel/templates/pageTemplate.html b/skel/templates/pageTemplate.html --- a/skel/templates/pageTemplate.html +++ b/skel/templates/pageTemplate.html @@ -6,6 +6,37 @@ + + $extraPageHead$ diff --git a/skel/templates/postTemplate.html b/skel/templates/postTemplate.html --- a/skel/templates/postTemplate.html +++ b/skel/templates/postTemplate.html @@ -1,5 +1,24 @@ -$jsInfo$ -$nextPrevLinks$ + + +
+\\( +$post.tex_macros$ +\\) +
+
-$post$ +

$post.title$

+ Posted $post.date$ by $post_authors; separator=", "$ +$post_html$
diff --git a/src/MB/Config.hs b/src/MB/Config.hs --- a/src/MB/Config.hs +++ b/src/MB/Config.hs @@ -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 diff --git a/src/MB/Files.hs b/src/MB/Files.hs deleted file mode 100644 --- a/src/MB/Files.hs +++ /dev/null @@ -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" diff --git a/src/MB/Gen/Index.hs b/src/MB/Gen/Index.hs new file mode 100644 --- /dev/null +++ b/src/MB/Gen/Index.hs @@ -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 diff --git a/src/MB/Gen/Post.hs b/src/MB/Gen/Post.hs new file mode 100644 --- /dev/null +++ b/src/MB/Gen/Post.hs @@ -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 diff --git a/src/MB/Gen/PostList.hs b/src/MB/Gen/PostList.hs new file mode 100644 --- /dev/null +++ b/src/MB/Gen/PostList.hs @@ -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 diff --git a/src/MB/Gen/RSS.hs b/src/MB/Gen/RSS.hs new file mode 100644 --- /dev/null +++ b/src/MB/Gen/RSS.hs @@ -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 [ "" + , "" ++ getRawPostTitle blog p ++ "\n" + , "" ++ baseUrl blog ++ postUrl p ++ "\n" + , "" ++ rssModificationTime p ++ "\n" + , "" ++ baseUrl blog ++ postUrl p ++ "\n" + , "\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 diff --git a/src/MB/Gladtex.hs b/src/MB/Gladtex.hs deleted file mode 100644 --- a/src/MB/Gladtex.hs +++ /dev/null @@ -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 $ "" ++ s ++ "" -rewriteInline _ i = i diff --git a/src/MB/Gnuplot.hs b/src/MB/Gnuplot.hs deleted file mode 100644 --- a/src/MB/Gnuplot.hs +++ /dev/null @@ -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 [ "" - ] - ] diff --git a/src/MB/Initialize.hs b/src/MB/Initialize.hs new file mode 100644 --- /dev/null +++ b/src/MB/Initialize.hs @@ -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 ++ ")" diff --git a/src/MB/Mathjax.hs b/src/MB/Mathjax.hs deleted file mode 100644 --- a/src/MB/Mathjax.hs +++ /dev/null @@ -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 = - "\n\ - \\n\ - \\n" diff --git a/src/MB/Processing.hs b/src/MB/Processing.hs --- a/src/MB/Processing.hs +++ b/src/MB/Processing.hs @@ -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) diff --git a/src/MB/Processors/Base.hs b/src/MB/Processors/Base.hs new file mode 100644 --- /dev/null +++ b/src/MB/Processors/Base.hs @@ -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 diff --git a/src/MB/Processors/Mathjax.hs b/src/MB/Processors/Mathjax.hs new file mode 100644 --- /dev/null +++ b/src/MB/Processors/Mathjax.hs @@ -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" + } diff --git a/src/MB/Processors/Tikz.hs b/src/MB/Processors/Tikz.hs new file mode 100644 --- /dev/null +++ b/src/MB/Processors/Tikz.hs @@ -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 [ "" + ] + ] + + 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 diff --git a/src/MB/Server.hs b/src/MB/Server.hs new file mode 100644 --- /dev/null +++ b/src/MB/Server.hs @@ -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 = + "" + +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 + } diff --git a/src/MB/Startup.hs b/src/MB/Startup.hs --- a/src/MB/Startup.hs +++ b/src/MB/Startup.hs @@ -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" ] diff --git a/src/MB/TeXMacros.hs b/src/MB/TeXMacros.hs new file mode 100644 --- /dev/null +++ b/src/MB/TeXMacros.hs @@ -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 diff --git a/src/MB/Templates.hs b/src/MB/Templates.hs --- a/src/MB/Templates.hs +++ b/src/MB/Templates.hs @@ -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 diff --git a/src/MB/Tikz.hs b/src/MB/Tikz.hs deleted file mode 100644 --- a/src/MB/Tikz.hs +++ /dev/null @@ -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 [ "" - ] - ] -renderTikzScript _ b = return b diff --git a/src/MB/Types.hs b/src/MB/Types.hs --- a/src/MB/Types.hs +++ b/src/MB/Types.hs @@ -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 + } diff --git a/src/MB/Util.hs b/src/MB/Util.hs --- a/src/MB/Util.hs +++ b/src/MB/Util.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 $ "

" ++ getPostTitle blog post BlogPost ++ "

" - hPutStr h $ "Posted " ++ created ++ "" - hPutStr h $ Pandoc.writeHtmlString writerOpts (postAst post) - -buildLinks :: Blog -> Maybe Post -> Maybe Post -> String -buildLinks _blog prev next = - "
" - ++ link "next-link" "older »" next - ++ link "prev-link" "« newer" prev - ++ "
" - where - link cls name Nothing = - "" ++ name ++ "" - link cls name (Just p) = - "" ++ name ++ "" - -jsInfo :: Post -> String -jsInfo post = - "\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 [ "
" - , "" - , getPostTitle blog p Index - , "Posted " - , created - , "
\n" - ] +isEventInteresting :: BlogInputFS -> Event -> Bool +isEventInteresting ifs ev = + let fp = case ev of + Added f _ -> f + Modified f _ -> f + Removed f _ -> f - let content = "
" ++ concat entries ++ "
" + 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 [ "" - , "" ++ getRawPostTitle blog p ++ "\n" - , "" ++ baseUrl blog ++ Files.postUrl p ++ "\n" - , "" ++ rssModificationTime p ++ "\n" - , "" ++ baseUrl blog ++ Files.postUrl p ++ "\n" - , "\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 diff --git a/tests/src/MB/StartupTests.hs b/tests/src/MB/StartupTests.hs --- a/tests/src/MB/StartupTests.hs +++ b/tests/src/MB/StartupTests.hs @@ -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