mathblog 0.1 → 0.2
raw patch · 23 files changed
+1104/−262 lines, 23 filesdep +ConfigFiledep +HStringTemplatedep +SHA
Dependencies added: ConfigFile, HStringTemplate, SHA, bytestring
Files
- README +188/−47
- mathblog.cabal +24/−9
- skel/blog.cfg +4/−0
- skel/eq-templates/eq-basic.txt +6/−0
- skel/html/stylesheets/stylesheet.css +14/−0
- skel/posts/first-post.txt +4/−0
- skel/templates/pagePostamble.html +0/−6
- skel/templates/pagePreamble.html +0/−12
- skel/templates/pageTemplate.html +22/−0
- skel/templates/postPostamble.html +0/−1
- skel/templates/postPreamble.html +0/−1
- skel/templates/postTemplate.html +5/−0
- skel/templates/rssPostamble.xml +0/−2
- skel/templates/rssPreamble.xml +0/−8
- skel/templates/rssTemplate.xml +11/−0
- src/MB/Config.hs +43/−0
- src/MB/Files.hs +65/−0
- src/MB/Gladtex.hs +53/−0
- src/MB/Processing.hs +108/−0
- src/MB/Templates.hs +30/−0
- src/MB/Types.hs +55/−0
- src/MB/Util.hs +267/−0
- src/Main.hs +205/−176
README view
@@ -51,9 +51,9 @@ mathblog takes advantage of three primary software components: - - pandoc, which will be installed for you automatically if you use- "cabal" to install mathblog. For best results, use the revision- control version of Pandoc.+ - pandoc, a document-processing library. For best results, use the+ revision control version of Pandoc. If you do not, inline and+ block-level equations will look the same. - gladTeX, a package of tools for rendering LaTeX equations. At present you MUST get gladTeX from revision control, since mathblog@@ -64,48 +64,77 @@ How to use ---------- -mathblog doesn't have any persistent configuration file; the way you-configure it is by setting two environment variables:+To begin, set the following environment variable: MB_BASE_DIR - The location of your blog files on the filesystem. Must be an- absolute path.-- MB_BASE_URL-- The base URL of your blog as it will be hosted. This is used to- generate fully-qualified URLs. A trailing slash is not expected.- E.g., "http://localhost:8080".+This is the location of your blog files on the filesystem. It must be+an absolute path. -Once you've set those environment variables, just run "mb". 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:+Once you've set the environment variable, just run "mb". 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_URL="http://localhost:8080" $ export MB_BASE_DIR=`pwd`/myBlog $ mb- mb: using base directory "/home/.../myBlog"- mb: using base url "http://localhost:8080"- Setting up data directory using skeleton: /home/.../.cabal/share/mathblog-0.1/skel- Processing: first-post- Generating all-posts list.+ Blog directory: .../myBlog+ 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. Now you have a blog; fire up a web server pointing at myBlog/html and you'll see a demo post. +(NOTE: to serve your blog files you can either make the "html"+directory a document root for your web server or virtual host, or you+can symlink the "html" 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.)++Next, you'll need to make a few changes to the default configuration,+"blog.cfg". This file contains information about you which may be+included in the generated pages, such as your name, e-mail address,+and the title of your blog. Most importantly, this file contains the+base URL of your blog which is used to generate URLs in the blog's+pages.+ Next, you might want to edit or create a new post, or even remove one. Just edit the appropriate file in myBlog/posts/ accordingly and re-run mb. Here's an example of adding a new post: $ mb- mb: using base directory "/home/.../blog/myBlog"- mb: using base url "http://localhost:8080"+ mb: using base directory ".../myBlog" Processing: second-post Generating all-posts list. 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 ----------- @@ -130,19 +159,27 @@ detects a change. Running mathblog in listen mode is simple: $ mb -l- mb: using base directory "/home/.../myBlog"- mb: using base url "http://localhost:8080"+ Blog directory: /.../blog+ Post index changed; regenerating next/previous links.+ Done. - Changes detected:- /home/.../myBlog/posts/second-post.txt- Processing: second-post- Generating all-posts list.+ Blog directory: /.../blog+ Configuration file changed; regenerating all content.+ Rendering 1 post(s)...+ Rendering first-post Done. -Above I ran "mb" in listen mode and then modified one of the posts,-second-post.txt, and "mb" detected the change and ran its typical-regeneration routine.+ Blog directory: /Users/cygnus/blog3+ 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 --------------------- @@ -155,29 +192,113 @@ stored in the "templates/" subdirectory of your blog data directory and are as follows: - templates/rssPreamble.xml- templates/rssPostamble.xml+ templates/rssTemplate.xml - These files make up the leading and trailing RSS XML that will be- used to wrap the individual elements of your blog's RSS feed.- You'll probably want to change the rssPreamble.xml file, since it- contains information about the blog author.+ This is the template used to generate your RSS feed. - templates/pagePreamble.html- templates/pagePostamble.html+ templates/pageTemplate.html - These files make up the outermost HTML content of the blog post- pages, including the index page and the post list page.+ This file makes up the overall structure of every page on the+ blog. - templates/postPreamble.html- templates/postPostamble.html+ templates/postTemplate.html - These files make up the HTML content surrounding the post body- itself.+ This file makes up the structure of the post portion of the page,+ for pages which show posts (i.e., not the post index). In addition, subdirectories of the "html/" directory contain things you might want to customize, such as a CSS stylesheet. +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.++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.++Gnuplot Graph Embedding+-----------------------++mathblog supports embedding gnuplot scripts in blog posts. To do+this, we overload the Pandoc code block syntax. Here's an example:++~~~ {#eq-basic}+f(x) = x+plot [-5.0:5.0] [-5.0:5.0] f(x) lt rgb "blue"+~~~++This defines a single function and plots it in blue over the specified+intervals. The most important part is the "#eq-basic" bit: this+specifies the equation preamble to use when generating the output+image. This string refers to this preamble file in your blog+directory:++ eq-preambles/eq-basic.txt++This file contains the commands responsible for determining the output+image size and axis configuration. The contents of the code block+that you write get appended to the contents of the preamble file you+specify to result in the full gnuplot script, whose output gets+embedded in the page. We use these templates to make it easier to+create many graphs that have the same general structure (e.g., axis+configuration, image size) without having to repeat the full gnuplot+script each time.++You can create other gnuplot premables to suit your needs; just+reference them in the code block in the same way. For example, you+might create eq-preambles/eq-fancy.txt, in which case the code block+syntax to use it is:++~~~ {#eq-fancy}+<your script here>+~~~++Note that the pandoc syntax also allows us to assign CSS class names+to the code block, and mathblog passes these through to the generated+image. So if you wanted to wrap your text around the generated image,+you could create a CSS class like this:++.eq-right {+ float: right;+}++and then assign it to your equation graph like this:++~~~ {#eq-basic .eq-right}+...+~~~++For more information on the code block syntax, please see:++ http://johnmacfarlane.net/pandoc/README.html#delimited-code-blocks+ Other features -------------- @@ -196,6 +317,26 @@ 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 ---------
mathblog.cabal view
@@ -1,5 +1,5 @@ Name: mathblog-Version: 0.1+Version: 0.2 Synopsis: A program for creating and managing a static, mathematically-inclined weblog Description: This package provides a program for creating and@@ -9,7 +9,12 @@ parts and support for embedded LaTeX math and the UNIX editor of your choice, then this is the blogging platform for you! For detailed- information, please see the README.+ information and a full feature list, please see+ the README.++ To see a live example of this software, you might+ consider taking a look at my math-oriented blog+ at <http://dw.codevine.org/>. Author: Jonathan Daugherty <drcygnus@gmail.com> Maintainer: Jonathan Daugherty <drcygnus@gmail.com> Build-Type: Simple@@ -26,13 +31,12 @@ skel/html/images/newer.png skel/html/images/older-subdued.png skel/html/stylesheets/stylesheet.css- skel/templates/postPostamble.html- skel/templates/postPreamble.html- skel/templates/pagePreamble.html- skel/templates/pagePostamble.html- skel/templates/rssPreamble.xml- skel/templates/rssPostamble.xml+ skel/templates/postTemplate.html+ skel/templates/pageTemplate.html+ skel/templates/rssTemplate.xml+ skel/eq-templates/eq-basic.txt skel/posts/first-post.txt+ skel/blog.cfg Executable mb Build-depends:@@ -43,10 +47,21 @@ unix >= 2.3 && < 2.5, process >= 1.0 && < 1.1, time >= 1.1 && < 1.2,- old-locale >= 1.0 && < 1.1+ old-locale >= 1.0 && < 1.1,+ SHA >= 1.4 && < 1.5,+ bytestring >= 0.9 && < 1.0,+ HStringTemplate >= 0.6 && < 0.7,+ ConfigFile >= 1.0 && < 1.1 Other-modules: Paths_mathblog+ MB.Config+ MB.Templates+ MB.Files+ MB.Types+ MB.Util+ MB.Gladtex+ MB.Processing GHC-Options: -Wall
+ skel/blog.cfg view
@@ -0,0 +1,4 @@+baseUrl = http://localhost:8000+title = A blog+authorName = Your name here+authorEmail = your@email.here
+ skel/eq-templates/eq-basic.txt view
@@ -0,0 +1,6 @@+set term png size 400,300+set samples 500+set zeroaxis+set noborder+set xtics axis nomirror+set ytics axis nomirror
skel/html/stylesheets/stylesheet.css view
@@ -59,6 +59,7 @@ display: block; margin-left: 1em; color: #555;+ margin-bottom: 1em; } div#prev-next-links { margin-top: 1em;@@ -107,4 +108,17 @@ } #post span.post-created { color: #999;+}+.eq-left {+ float: left;+ margin-right: 0.5em;+ margin-bottom: 0.5em;+}+.eq-right {+ float: right;+}+.eq-center {+ display: block;+ margin-left: auto;+ margin-right: auto; }
skel/posts/first-post.txt view
@@ -25,6 +25,10 @@ $\int^n_0{\ldots} = \sum^n_{i=1}{b_0 G(u^s)} \Longrightarrow \frac{\tan x}{\lim_{h \to \infty}{\Phi}}$ +(NOTE: if the two images immediately above are identical, then you+must run the revision control version of Pandoc, which includes an+unreleased fix!)+ The content of this post can be found in the `posts` subdirectory of your blog data directory; the rest of the content of this page can be found in "preamble" and "postamble" files in the `templates`
− skel/templates/pagePostamble.html
@@ -1,6 +0,0 @@- <div id="footer">- Copyright © 2010 Your Name Here- </div>- </div>- </body>-</html>
− skel/templates/pagePreamble.html
@@ -1,12 +0,0 @@-<html>- <head>- <title>A Blog</title>- <link rel="stylesheet" type="text/css" href="/stylesheets/stylesheet.css"/>- <link rel="alternate" type="application/rss+xml" href="/feed.xml"/>- </head>- <body>- <div id="page">- <div id="header">- <a id="listing" href="/posts/">all posts</a>- <a href="/">A Blog</a>- </div>
+ skel/templates/pageTemplate.html view
@@ -0,0 +1,22 @@+<html>+ <head>+ <title>$if(extraTitle)$$extraTitle$ - $endif$$title$</title>+ <link rel="stylesheet" type="text/css" href="http://yui.yahooapis.com/3.2.0/build/cssreset/reset-min.css">+ <link rel="stylesheet" type="text/css" href="http://yui.yahooapis.com/3.2.0/build/cssbase/base-min.css">+ <link rel="stylesheet" type="text/css" href="http://yui.yahooapis.com/3.2.0/build/cssfonts/fonts-min.css">+ <link rel="stylesheet" type="text/css" href="$baseUrl$/stylesheets/stylesheet.css"/>+ <link rel="alternate" type="application/rss+xml" href="$baseUrl$/feed.xml"/>+ </head>+ <body>+ <div id="page">+ <div id="header">+ <a id="listing" href="$baseUrl$/posts/">all posts</a>+ <a href="$baseUrl$">$title$</a>+ </div>+ $content$+ <div id="footer">+ Copyright © 2010 $authorName$+ </div>+ </div>+ </body>+</html>
− skel/templates/postPostamble.html
@@ -1,1 +0,0 @@-</div>
− skel/templates/postPreamble.html
@@ -1,1 +0,0 @@-<div id="post">
+ skel/templates/postTemplate.html view
@@ -0,0 +1,5 @@+$jsInfo$+$nextPrevLinks$+<div id="post">+$post$+</div>
− skel/templates/rssPostamble.xml
@@ -1,2 +0,0 @@-</channel>-</rss>
− skel/templates/rssPreamble.xml
@@ -1,8 +0,0 @@-<rss version="2.0">- <channel>- <title>A Blog</title>- <link>http://localhost:8080/</link>- <description>A Blog.</description>- <language>en-us</language>- <managingEditor>your@email.com</managingEditor>- <webMaster>your@email.com</webMaster>
+ skel/templates/rssTemplate.xml view
@@ -0,0 +1,11 @@+<rss version="2.0">+ <channel>+ <title>$title$</title>+ <link>$baseUrl$</link>+ <description>$title$</description>+ <language>en-us</language>+ <managingEditor>$authorEmail$</managingEditor>+ <webMaster>$authorEmail$</webMaster>+ $items$+ </channel>+</rss>
+ src/MB/Config.hs view
@@ -0,0 +1,43 @@+module MB.Config+ ( readConfig+ )+where++import Data.ConfigFile.Parser+ ( parse_file+ )+import System.Exit+ ( exitFailure+ )+import Data.Maybe+ ( fromJust+ , isNothing+ )+import Control.Monad+ ( forM_+ , when+ )++section :: String+section = "DEFAULT"++readConfig :: FilePath -> [String] -> IO [(String, String)]+readConfig path requiredArgs = do+ result <- parse_file path++ case result of+ Left e ->+ do+ putStrLn $ "Error parsing config file " ++ path ++ ": " ++ show e+ exitFailure+ 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++ return pairs
+ src/MB/Files.hs view
@@ -0,0 +1,65 @@+module MB.Files where++import System.FilePath+ ( (</>)+ , takeBaseName+ )+import MB.Types+ ( Config(..)+ , Post(..)+ )++indexHtml :: Config -> FilePath+indexHtml c = htmlDir c </> "index.html"++imageFilename :: Config -> String -> FilePath+imageFilename c fn = imageDir c </> fn++rssXml :: Config -> FilePath+rssXml c = htmlDir c </> "feed.xml"++eqPreambleFile :: Config -> String -> FilePath+eqPreambleFile config n = eqPreamblesDir config </> n++rssTemplatePath :: Config -> FilePath+rssTemplatePath c = templateDir c </> "rssTemplate.xml"++listHtml :: Config -> FilePath+listHtml c = postHtmlDir c </> "index.html"++listHtex :: Config -> FilePath+listHtex c = htmlTempDir c </> "list.htex"++postIndex :: Config -> FilePath+postIndex c = postSourceDir c </> "posts-index"++listTmpHtml :: Config -> FilePath+listTmpHtml c = htmlTempDir c </> "list.html"++firstPost :: Config -> FilePath+firstPost c = postSourceDir c </> "first-post.txt"++pageTemplatePath :: Config -> FilePath+pageTemplatePath c = templateDir c </> "pageTemplate.html"++postTemplatePath :: Config -> FilePath+postTemplatePath c = templateDir c </> "postTemplate.html"++postUrl :: Config -> Post -> String+postUrl c p = baseUrl c ++ "/posts/" ++ postBaseName p ++ ".html"++postBaseName :: Post -> String+postBaseName = takeBaseName . postFilename++postHtex :: Config -> Post -> String+postHtex config p = htmlTempDir config </> postBaseName p ++ ".htex"++postIntermediateHtml :: Config -> Post -> FilePath+postIntermediateHtml config post =+ postIntermediateDir config </> postBaseName post ++ ".html"++postFinalHtml :: Config -> Post -> FilePath+postFinalHtml config p = postHtmlDir config </> postBaseName p ++ ".html"++stylesheet :: Config -> FilePath+stylesheet c = stylesheetDir c </> "stylesheet.css"
+ src/MB/Gladtex.hs view
@@ -0,0 +1,53 @@+module MB.Gladtex+ ( gladTex+ , checkForGladtex+ )+where+import System.Exit+ ( ExitCode(..)+ , exitFailure+ )+import System.Process+ ( readProcessWithExitCode+ )+import Control.Monad+ ( when+ )+import MB.Types++gladtexProgName :: String+gladtexProgName = "gladtex"++gladTex :: Config -> FilePath -> String -> IO ()+gladTex config htexPath color = do+ let args = [ "-d"+ , imageDir config+ , "-u"+ , baseUrl config ++ "/generated-images/"+ , "-r"+ , "120"+ , "-b"+ , "FFFFFF"+ , "-c"+ , color+ , 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 ()
+ src/MB/Processing.hs view
@@ -0,0 +1,108 @@+module MB.Processing+ ( processPost+ )+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++processPost :: Config -> Post -> IO Post+processPost = renderGnuPlot++renderGnuPlot :: Config -> 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 :: Config -> 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 :: Config+ -> 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.HtmlInline $ concat [ "<img src=\"" ++ baseUrl config ++ "/generated-images/"+ , imageFilename+ , "\" class=\""+ , intercalate " " classes+ , "\">"+ ]+ ]
+ src/MB/Templates.hs view
@@ -0,0 +1,30 @@+module MB.Templates+ ( renderTemplate+ , loadTemplate+ )+where++import Text.StringTemplate+ ( newSTMP+ , render+ , setManyAttrib+ , checkTemplate+ )+import MB.Types+ ( Template+ )++loadTemplate :: FilePath -> IO (Either String Template)+loadTemplate path = do+ s <- readFile path+ s `seq` return ()++ let (a, _, _) = checkTemplate t+ t = newSTMP s++ case a of+ Nothing -> return $ Right t+ Just msg -> return $ Left $ "Error parsing template " ++ path ++ ": " ++ msg++renderTemplate :: [(String, String)] -> Template -> String+renderTemplate attrs = render . setManyAttrib attrs
+ src/MB/Types.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module MB.Types+ ( Config(..)+ , Post(..)+ , Template+ , ChangeSummary(..)+ )+where+import Data.Time.Clock+ ( UTCTime+ )+import qualified Text.Pandoc.Definition as Pandoc+import Text.StringTemplate+ ( StringTemplate+ )++type Template = StringTemplate String++data Config = Config { baseDir :: FilePath+ , postSourceDir :: FilePath+ , htmlDir :: FilePath+ , stylesheetDir :: FilePath+ , postHtmlDir :: FilePath+ , postIntermediateDir :: FilePath+ , imageDir :: FilePath+ , templateDir :: FilePath+ , htmlTempDir :: FilePath+ , baseUrl :: String+ , eqPreamblesDir :: FilePath+ , title :: String+ , authorName :: String+ , authorEmail :: String+ , configPath :: FilePath+ , blogPosts :: [Post]+ }++data Post = Post { postTitle :: Int -> String+ , postTitleRaw :: String+ , postPath :: String+ , postFilename :: String+ , postModificationTime :: UTCTime+ , postAst :: Pandoc.Pandoc+ }++-- Summarize changes in files so we know what to do during the+-- regeneration phase. postsChanged and configChanged are the primary+-- measurements, but knowing whether other metadata files changed+-- (like templates) is useful for the "listen" mode of mb.+data ChangeSummary =+ ChangeSummary { postsChanged :: [String]+ , configChanged :: Bool+ , templatesChanged :: Bool+ , postIndexChanged :: Bool+ }+ deriving (Show)
+ src/MB/Util.hs view
@@ -0,0 +1,267 @@+module MB.Util+ ( copyTree+ , toUtcTime+ , toLocalTime+ , pandocTitle+ , pandocTitleRaw+ , rssModificationTime+ , loadPostIndex+ , getModificationTime+ , allPostFilenames+ , dirFilenames+ , anyChanges+ , summarizeChanges+ , serializePostIndex+ )+where+import Control.Applicative+ ( (<$>)+ , (<*>)+ , pure+ )+import System.Directory+ ( doesDirectoryExist+ , doesFileExist+ , createDirectory+ , getDirectoryContents+ , copyFile+ )+import System.FilePath+ ( (</>)+ , takeFileName+ )+import Control.Monad+ ( when+ , forM_+ , forM+ , filterM+ )+import System.Exit+ ( exitFailure+ )+import System.Posix.Files+ ( getFileStatus+ , modificationTime+ )+import System.Posix.Types+ ( EpochTime+ )+import Data.List+ ( isSuffixOf+ , isPrefixOf+ )+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+ ( defaultTimeLocale+ , rfc822DateFormat+ )+import System.IO+ ( IOMode(ReadMode)+ , openFile+ , hClose+ , hGetContents+ )+import Data.List+ ( sortBy+ )+import Data.Maybe+ ( fromJust+ , 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 || dstDExists) $ do+ putStrLn $ "Cannot copy " ++ (show srcPath) ++ " to existing destination path " +++ (show dstPath) ++ "; remove to continue."+ exitFailure++ createDirectory dstPath+ copyTree' srcPath dstPath++ where+ copyTree' src dst = do+ -- For each file in src, copy it to dest.+ entries <- filter (not . flip elem [".", ".."]) <$> getDirectoryContents src++ dirs <- filterM doesDirectoryExist $ map (src </>) entries+ files <- filterM doesFileExist $ map (src </>) entries++ -- 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++ createDirectory dstDir+ copyTree' (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++pandocTitle :: Pandoc.Pandoc -> Int -> String+pandocTitle (Pandoc.Pandoc m _) dpi = concat $ map getStr $ Pandoc.docTitle m+ where+ getStr (Pandoc.Str s) = s+ getStr (Pandoc.Math _ s) = "<EQ DPI=\"" ++ show dpi ++ "\">" ++ s ++ "</EQ>"+ getStr Pandoc.Space = " "+ getStr i = error $ "Unexpected inline in document title, got " ++ (show i)++pandocTitleRaw :: Pandoc.Pandoc -> String+pandocTitleRaw (Pandoc.Pandoc m _) = concat $ map getStr $ Pandoc.docTitle m+ where+ getStr (Pandoc.Str s) = s+ getStr (Pandoc.Math _ s) = s+ getStr Pandoc.Space = " "+ getStr i = error $ "Unexpected inline in document title, got " ++ (show i)++rssModificationTime :: Post -> String+rssModificationTime =+ formatTime defaultTimeLocale rfc822DateFormat . postModificationTime++loadPost :: FilePath -> IO Post+loadPost fullPath = do+ fileContent <- readFile fullPath+ t <- getModificationTime fullPath+ let doc = Pandoc.readMarkdown Pandoc.defaultParserState fileContent++ return $ Post { postTitle = pandocTitle doc+ , postTitleRaw = pandocTitleRaw doc+ , postPath = fullPath+ , postFilename = takeFileName fullPath+ , postModificationTime = t+ , postAst = doc+ }++dirFilenames :: FilePath -> IO [FilePath]+dirFilenames dir = do+ allFiles <- getDirectoryContents dir+ return [ dir </> f | f <- allFiles+ , not $ "." `isPrefixOf` f+ ]++allPostFilenames :: FilePath -> IO [FilePath]+allPostFilenames postSrcDir = do+ allFiles <- dirFilenames postSrcDir+ return [ f | f <- allFiles+ , ".txt" `isSuffixOf` f+ ]++getModificationTime :: FilePath -> IO UTCTime+getModificationTime fullPath = do+ info <- getFileStatus fullPath+ return $ toUtcTime $ modificationTime info++loadPostIndex :: FilePath -> IO [Post]+loadPostIndex postSrcDir = do+ let indexFilename = postSrcDir </> "posts-index"+ e <- doesFileExist indexFilename++ indexNames <- case e of+ False -> return []+ True -> do+ h <- openFile indexFilename ReadMode+ s <- hGetContents h+ s `seq` 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+ posts <- mapM loadPost postFiles++ -- There are two types of posts to put into the index: the ones that+ -- are not already in the index, and the ones that are (and in a+ -- specific order).++ let pairs = [ (postFilename p, p) | p <- posts ]+ newPosts = [ p | p <- posts, not $ postFilename p `elem` indexNames ]+ preexistingPosts = catMaybes [ lookup n pairs | n <- indexNames ]+ ps = sortPosts newPosts ++ preexistingPosts++ return ps++serializePostIndex :: [Post] -> String+serializePostIndex ps = unlines $ map postFilename ps++unserializePostIndex :: String -> [String]+unserializePostIndex = lines++sortPosts :: [Post] -> [Post]+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+ ]++summarizeChanges :: Config -> IO ChangeSummary+summarizeChanges config = 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++ postIndexExists <- doesFileExist $ Files.postIndex config+ postIndexChanged' <- case postIndexExists of+ False -> return True+ True -> do+ t <- getModificationTime $ Files.postIndex config+ return $ t > baseTime++ let configChanged' = configMtime > baseTime+ modifiedPosts = filter (\p -> postModificationTime p > baseTime) $ blogPosts config++ -- Determine whether any templates changed+ templateFiles <- dirFilenames (templateDir config)+ templateChanges <- forM templateFiles $ \f -> do+ mtime <- getModificationTime f+ return $ mtime > baseTime++ return $ ChangeSummary { configChanged = configChanged'+ , postsChanged = map postFilename modifiedPosts+ , templatesChanged = or templateChanges+ , postIndexChanged = postIndexChanged'+ }
src/Main.hs view
@@ -7,6 +7,7 @@ import Control.Monad ( when , forM_+ , forM ) import Control.Concurrent ( threadDelay@@ -28,7 +29,6 @@ import System.Directory ( doesDirectoryExist , doesFileExist- , getDirectoryContents , removeFile , copyFile , createDirectory@@ -37,13 +37,7 @@ ( (</>) ) import System.Posix.Files- ( getFileStatus- , modificationTime- , createSymbolicLink- )-import Data.List- ( sortBy- , isSuffixOf+ ( createSymbolicLink ) import Data.Maybe ( isNothing@@ -52,18 +46,23 @@ ( TimeZone(timeZoneName) , getCurrentTimeZone )-import Data.Time.Clock- ( UTCTime- , getCurrentTime- ) import qualified Text.Pandoc as Pandoc+import qualified MB.Config as Config+import MB.Templates+ ( loadTemplate+ , renderTemplate+ )+import MB.Processing+ ( processPost+ ) import MB.Util ( copyTree- , toUtcTime , toLocalTime- , pandocTitle- , pandocTitleRaw , rssModificationTime+ , loadPostIndex+ , anyChanges+ , serializePostIndex+ , summarizeChanges ) import MB.Gladtex ( gladTex@@ -81,44 +80,22 @@ baseDirEnvName :: String baseDirEnvName = "MB_BASE_DIR" -baseUrlEnvName :: String-baseUrlEnvName = "MB_BASE_URL"--allPostFilenames :: Config -> IO [FilePath]-allPostFilenames config = do- allFiles <- getDirectoryContents $ postSourceDir config- return [ postSourceDir config </> f | f <- allFiles- , ".txt" `isSuffixOf` f- ]--getModificationTime :: FilePath -> IO UTCTime-getModificationTime fullPath = do- info <- getFileStatus fullPath- return $ toUtcTime $ modificationTime info--loadPost :: FilePath -> IO Post-loadPost fullPath = do- fileContent <- readFile fullPath- t <- getModificationTime fullPath- let doc = Pandoc.readMarkdown Pandoc.defaultParserState fileContent-- return $ Post { postTitle = pandocTitle doc- , postTitleRaw = pandocTitleRaw doc- , postFilename = fullPath- , postModificationTime = t- , postAst = doc- }+configFilename :: String+configFilename = "blog.cfg" -allPosts :: Config -> IO [Post]-allPosts config = do- postFiles <- allPostFilenames config+commonTemplateAttrs :: Config -> [(String, String)]+commonTemplateAttrs config = [ ( "baseUrl", baseUrl config )+ , ( "title", title config )+ , ( "authorName", authorName config )+ , ( "authorEmail", authorEmail config )+ ] - -- For each file, construct a Post from it.- posts <- mapM loadPost postFiles+fillTemplate :: Config -> Template -> [(String, String)] -> String+fillTemplate config t attrs = renderTemplate attrs' t+ where attrs' = commonTemplateAttrs config ++ attrs - -- Return posts sorted by modification time, descending- return $ sortBy (\a b -> postModificationTime b `compare`- postModificationTime a) posts+writeTemplate :: Config -> Handle -> Template -> [(String, String)] -> IO ()+writeTemplate config h t attrs = hPutStr h $ fillTemplate config t attrs pandocWriterOptions :: Pandoc.WriterOptions pandocWriterOptions =@@ -132,8 +109,8 @@ hPutStr h $ "<span class=\"post-created\">Posted " ++ created ++ "</span>" hPutStr h $ Pandoc.writeHtmlString pandocWriterOptions (postAst post) -buildLinks :: Maybe Post -> Maybe Post -> String-buildLinks prev next =+buildLinks :: Config -> Maybe Post -> Maybe Post -> String+buildLinks config prev next = "<div id=\"prev-next-links\">" ++ link "next-link" "older" next ++ link "prev-link" "newer" prev@@ -142,7 +119,7 @@ link cls name Nothing = "<span class=\"" ++ cls ++ "-subdued\">" ++ name ++ "</span>" link cls name (Just p) =- "<a class=\"" ++ cls ++ "\" href=\"" ++ Files.postUrl p +++ "<a class=\"" ++ cls ++ "\" href=\"" ++ Files.postUrl config p ++ "\">" ++ name ++ "</a>" jsInfo :: Post -> String@@ -154,33 +131,51 @@ "};\n" ++ "</script>\n" +buildPage :: Handle -> Config -> String -> Maybe String -> IO ()+buildPage h config content extraTitle = do+ eTmpl <- loadTemplate $ Files.pageTemplatePath config++ case eTmpl of+ Left msg -> putStrLn msg >> exitFailure+ Right tmpl ->+ do+ let attrs = [ ("content", content)+ ] ++ maybe [] (\t -> [("extraTitle", t)]) extraTitle++ writeTemplate config h tmpl attrs+ hClose h+ buildPost :: Handle -> Config -> Post -> (Maybe Post, Maybe Post) -> IO () buildPost h config post prevNext = do- hPutStr h =<< (readFile $ Files.pagePreamble config)- hPutStr h $ jsInfo post- hPutStr h $ uncurry buildLinks prevNext- hPutStr h =<< (readFile $ Files.postPreamble config)- hPutStr h =<< (readFile $ Files.postIntermediateHtml config post)- hPutStr h =<< (readFile $ Files.postPostamble config)- hPutStr h =<< (readFile $ Files.pagePostamble config)+ eTmpl <- loadTemplate $ Files.postTemplatePath config -generatePost :: Config -> Post -> IO ()-generatePost config post = do+ case eTmpl of+ Left msg -> putStrLn msg >> exitFailure+ Right tmpl ->+ do+ html <- readFile $ Files.postIntermediateHtml config post++ let attrs = [ ("post", html)+ , ("nextPrevLinks", uncurry (buildLinks config) prevNext)+ , ("jsInfo", jsInfo post)+ ]++ let out = (fillTemplate config tmpl attrs)+ buildPage h config out $ Just $ postTitleRaw post++generatePost :: Config -> Post -> ChangeSummary -> IO ()+generatePost config post summary = do let tempHtml = htmlTempDir config </> Files.postBaseName post ++ ".html" finalHtml = Files.postIntermediateHtml config post - htmlExists <- doesFileExist finalHtml- skip <- case htmlExists of- False -> return False- True -> do- info <- getFileStatus finalHtml- return $ (toUtcTime $ modificationTime info) > postModificationTime post+ let generate = (postFilename post `elem` (postsChanged summary))+ || configChanged summary - when (not skip) $ do- putStrLn $ "Processing: " ++ Files.postBaseName post+ when generate $ do+ putStrLn $ "Rendering " ++ Files.postBaseName post h <- openFile (Files.postHtex config post) WriteMode- writePost h post+ writePost h =<< processPost config post hClose h -- Run gladtex on the temp file to generate the final file.@@ -194,23 +189,30 @@ removeFile $ Files.postHtex config post removeFile tempHtml -generatePosts :: Config -> [Post] -> IO ()-generatePosts config posts = do+generatePosts :: Config -> ChangeSummary -> IO ()+generatePosts config summary = do+ let numRegenerated = if configChanged summary+ then length $ blogPosts config+ else length $ postsChanged summary+ when (numRegenerated > 0) $ putStrLn $ "Rendering " ++ (show numRegenerated) ++ " post(s)..."+ let n = length posts+ posts = blogPosts config 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)) - generatePost config p+ generatePost config p summary h <- openFile (Files.postFinalHtml config p) WriteMode buildPost h config p (prevPost, nextPost) hClose h -generateIndex :: Config -> Post -> IO ()-generateIndex config post = do+generateIndex :: Config -> IO ()+generateIndex config = do let dest = Files.postFinalHtml config post index = Files.indexHtml config+ post = head $ blogPosts config exists <- doesFileExist index when exists $ removeFile index@@ -223,30 +225,26 @@ localTime <- toLocalTime $ postModificationTime p return $ show localTime ++ " " ++ timeZoneName tz -generateList :: Config -> [Post] -> IO ()-generateList config posts = do- putStrLn "Generating all-posts list."-- h <- openFile (Files.listHtex config) WriteMode-- hPutStr h =<< (readFile $ Files.pagePreamble config)- hPutStr h "<div id=\"all-posts\">"-+generateList :: Config -> IO ()+generateList config = 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.- forM_ posts $ \p -> do- created <- postModificationString p- hPutStr h $ concat [ "<div class=\"listing-entry\"><span class=\"post-title\">"- , "<a href=\"" ++ Files.postUrl p ++ "\">"- , postTitle p 110- , "</a></span><span class=\"post-created\">Posted "- , created- , "</span></div>\n"- ]+ entries <- forM (blogPosts config) $ \p ->+ do+ created <- postModificationString p+ return $ concat [ "<div class=\"listing-entry\"><span class=\"post-title\">"+ , "<a href=\"" ++ Files.postUrl config p ++ "\">"+ , postTitle p 110+ , "</a></span><span class=\"post-created\">Posted "+ , created+ , "</span></div>\n"+ ] - hPutStr h "</div>"- hPutStr h =<< (readFile $ Files.pagePostamble config)+ let content = "<div id=\"all-posts\">" ++ concat entries ++ "</div>"++ h <- openFile (Files.listHtex config) WriteMode+ buildPage h config content Nothing hClose h gladTex config (Files.listHtex config) "0000FF"@@ -259,39 +257,42 @@ removeFile $ Files.listHtex config removeFile $ Files.listTmpHtml config -fullPostUrl :: Config -> Post -> String-fullPostUrl config p = baseUrl config ++ Files.postUrl p- rssItem :: Config -> Post -> String rssItem config p = concat [ "<item>" , "<title>" ++ postTitleRaw p ++ "</title>\n"- , "<link>" ++ fullPostUrl config p ++ "</link>\n"+ , "<link>" ++ Files.postUrl config p ++ "</link>\n" , "<pubDate>" ++ rssModificationTime p ++ "</pubDate>\n"- , "<guid>" ++ fullPostUrl config p ++ "</guid>\n"+ , "<guid>" ++ Files.postUrl config p ++ "</guid>\n" , "</item>\n" ] -generateRssFeed :: Config -> [Post] -> IO ()-generateRssFeed config posts = do+generateRssFeed :: Config -> IO ()+generateRssFeed config = do h <- openFile (Files.rssXml config) WriteMode- hPutStr h =<< (readFile $ Files.rssPreamble config) - forM_ posts (hPutStr h . rssItem config)+ eTmpl <- loadTemplate $ Files.rssTemplatePath config - hPutStr h =<< (readFile $ Files.rssPostamble config)- hClose h+ case eTmpl of+ Left msg -> putStrLn msg >> exitFailure+ Right tmpl ->+ do+ let items = map (rssItem config) $ blogPosts config+ itemStr = concat items+ attrs = [ ("items", itemStr)+ ] -setup :: Config -> IO ()-setup config = do- exists <- doesDirectoryExist $ baseDir config+ writeTemplate config h tmpl attrs+ hClose h++setup :: FilePath -> IO ()+setup dir = do+ exists <- doesDirectoryExist dir dataDir <- skelDir when (not exists) $ do putStrLn $ "Setting up data directory using skeleton: " ++ dataDir- copyTree dataDir $ baseDir config-- ensureDirs config+ copyTree dataDir dir ensureDirs :: Config -> IO () ensureDirs config = do@@ -303,6 +304,7 @@ , imageDir , templateDir , htmlTempDir+ , eqPreamblesDir ] forM_ (dirs <*> pure config) $ \d ->@@ -310,59 +312,63 @@ exists <- doesDirectoryExist d when (not exists) $ createDirectory d --- The files we look at to decide whether to regenerate the blog.--- We'll always look at the post input files, but we also want to look--- at other files to trigger a regeneration.-changedFiles :: Config -> [FilePath]-changedFiles config = [ Files.rssPreamble- , Files.rssPostamble- , Files.pagePreamble- , Files.pagePostamble- , Files.postPreamble- , Files.postPostamble- ] <*> pure config- preserveM :: (Monad m) => (a -> m b) -> a -> m (a, b) preserveM act val = act val >>= \r -> return (val, r) -scanForChanges :: Config -> IO () -> IO ()-scanForChanges config act = do- t <- getCurrentTime- scan t+scanForChanges :: FilePath -> (FilePath -> IO Bool) -> IO ()+scanForChanges dir act = do+ scan where- scan t = do- posts <- allPostFilenames config- let filesToInspect = posts ++ changedFiles config- allTimes <- mapM (preserveM getModificationTime) filesToInspect+ scan = do+ didWork <- act dir+ when didWork $ putStrLn ""+ threadDelay $ 1 * 1000 * 1000+ scan - let modified = filter ((> t) . snd) allTimes- nextTime = if null modified- then t- else maximum $ map snd modified+mkConfig :: FilePath -> IO Config+mkConfig base = do+ let configFilePath = base </> configFilename+ e <- doesFileExist configFilePath - when (not $ null modified) $- do- putStrLn ""- putStrLn "Changes detected:"- forM_ modified $ \(fp, _) -> do- putStrLn $ " " ++ fp- act- threadDelay $ 1 * 1000 * 1000- scan nextTime+ when (not e) $ do+ putStrLn $ "Configuration file " ++ configFilePath ++ " not found"+ exitFailure -mkConfig :: FilePath -> String -> Config-mkConfig base url = Config { baseDir = base- , postSourceDir = base </> "posts"- , htmlDir = base </> "html"- , stylesheetDir = base </> "html" </> "stylesheets"- , postHtmlDir = base </> "html" </> "posts"- , postIntermediateDir = base </> "generated"- , imageDir = base </> "html" </> "generated-images"- , templateDir = base </> "templates"- , htmlTempDir = base </> "tmp"- , baseUrl = url- }+ let requiredValues = [ "baseUrl"+ , "title"+ , "authorName"+ , "authorEmail"+ ] + cfg <- Config.readConfig configFilePath requiredValues++ let Just cfg_baseUrl = lookup "baseUrl" cfg+ Just cfg_title = lookup "title" cfg+ Just cfg_authorName = lookup "authorName" cfg+ Just cfg_authorEmail = lookup "authorEmail" cfg++ -- Load blog posts from disk+ let postSrcDir = base </> "posts"+ allPosts <- loadPostIndex postSrcDir++ return $ Config { baseDir = base+ , postSourceDir = postSrcDir+ , htmlDir = base </> "html"+ , stylesheetDir = base </> "html" </> "stylesheets"+ , postHtmlDir = base </> "html" </> "posts"+ , postIntermediateDir = base </> "generated"+ , imageDir = base </> "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 = configFilePath+ , blogPosts = allPosts+ }+ usage :: IO () usage = do putStrLn "Usage: mb [-l]\n"@@ -370,12 +376,44 @@ putStrLn "weblog. To use mb, you must set a few environment variables:" putStrLn "" putStrLn $ " " ++ baseDirEnvName ++ ": path where blog files will be stored"- putStrLn $ " " ++ baseUrlEnvName ++ ": base URL where blog will be hosted" putStrLn "" putStrLn " -l: make mb poll periodically and regenerate your blog content" putStrLn " when something changes. This is useful if you want to run a" putStrLn " local web server to view your posts as you're writing them." +regenerateContent :: FilePath -> IO Bool+regenerateContent dir = do+ config <- mkConfig dir+ summary <- summarizeChanges config++ case anyChanges summary of+ True -> do+ putStrLn $ "Blog directory: " ++ baseDir config++ 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."++ generatePosts config summary++ generateIndex config+ generateList config+ generateRssFeed config++ writeFile (Files.postIndex config) $+ serializePostIndex $ blogPosts config++ putStrLn "Done."+ return True+ False -> return False+ main :: IO () main = do env <- getEnvironment@@ -384,31 +422,22 @@ checkForGladtex let mBase = lookup baseDirEnvName env- mBaseUrl = lookup baseUrlEnvName env - when (isNothing (mBase >> mBaseUrl)) $ usage >> exitFailure+ when (isNothing mBase) $ usage >> exitFailure let Just dir = mBase- Just url = mBaseUrl when (head dir /= '/') $ do putStrLn $ baseDirEnvName ++ " must contain an absolute path" exitFailure - putStrLn $ "mb: using base directory " ++ (show dir)- putStrLn $ "mb: using base url " ++ (show url)- let config = mkConfig dir url- setup config-- let work = do- posts <- allPosts config- generatePosts config posts- generateIndex config $ head posts- generateList config posts- generateRssFeed config posts- putStrLn "Done."+ setup dir+ config <- mkConfig dir+ ensureDirs config case args of- [] -> work- ["-l"] -> scanForChanges config work+ [] -> do+ didWork <- regenerateContent dir+ when (not didWork) $ putStrLn "No changes found!"+ ["-l"] -> scanForChanges dir regenerateContent _ -> usage >> exitFailure