structure

5 files changed, 433 insertions, 0 deletions

diff --git a/provider/posts/blog/hakyll.md b/provider/posts/blog/hakyll.md
new file mode 100644
index 0000000..be3bc1b
--- /dev/null
+++ b/provider/posts/blog/hakyll.md
@@ -0,0 +1,131 @@
+---
+title: Switch to Hakyll
+published: 2015-08-03
+tags: Blog Software
+---
+
+I stopped using the software suite inherited from
+[math.kleen.org](http://math.kleen.org) and switched over to using
+[hakyll](http://jaspervdj.be/hakyll/) instead, since I realised that the two
+were doing essentially the same job and keeping my mess in one haskell file
+(`src/Site.hs`, for those of you who are willing to checkout the
+[git repo](https://git.yggdrasil.li/gkleen/pub/dirty-haskell.org)) instead of spread over a
+large number of interlocking zsh and haskell scripts.
+
+I expect nothing to be seriously broken (Only the filepaths of lists have
+changed), but some feed readers might have stopped working (hakyll´s
+deceptively named `renderRss` actually renders atom).
+
+## Implementation Details
+
+I´m using this post to document some of the more involved things I had to do
+during migration in no particular order.
+
+### Lists → Tags
+
+I´m using hakyll´s implementation of
+[tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html)
+instead of the [math.kleen.org](http://math.kleen.org) concept of lists, now.
+
+This required some tweaking.
+
+In order to retain the [All Posts](/tags/all-posts.html) list I introduced a
+function to add new tags to an already existing
+[Tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#t:Tags)
+structure and used it to add my desired pseudo-tag.
+
+~~~ {.haskell}
+main = hakyllWith config $ do
+  …
+  tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*"
+  …
+
+addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags
+addTag name pattern tags = do
+  ids <- getMatches pattern
+  return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] }
+~~~
+
+### Printing lists is an involved affair
+
+I wanted to keep the layout of the site including the lists of posts on the
+[index page](/).
+
+Generating those lists turned out to be a hassle.
+
+The `Rule` for `index.md` adds to the context of the templates used in it´s
+creation a list field which contains verbatim HTML as produced by renderTag for
+each tag.
+A trick I used to implement the desired behaviour of replacing old posts with
+"…" is to introduce a pseudo post-item which has a flag in it´s context to tell
+the corresponding template to only print "…".
+Trimming the list of posts is straightforward.
+
+~~~ {.haskell}
+renderTag :: String -- ^ Tag name
+          -> Tags
+          -> Compiler (Item String)
+renderTag tag tags = do
+  ellipsisItem <- makeItem ""
+  let
+    ids = fromMaybe [] $ lookup tag $ tagsMap tags
+    postCtx = mconcat [ listField "posts" (ellipsisContext ellipsisItem) $
+                          liftM (withEllipsis ellipsisItem) $ chronological =<< mapM load ids
+                      , constField "title" tag
+                      , constField "rss" ("tags/" ++ tagTranslation tag ++ ".rss")
+                      , constField "url" ("tags/" ++ tagTranslation tag ++ ".html")
+                      , defaultContext
+                      ]
+  makeItem ""
+    >>= loadAndApplyTemplate "templates/post-list.html" postCtx
+    >>= loadAndApplyTemplate "templates/tag.html" postCtx
+  where
+    ellipsisContext item = mconcat [ boolField "ellipsis" (== item)
+                                   , defaultContext
+                                   ]
+    boolField name f = field name (\i -> if f i
+                                         then pure (error $ unwords ["no string value for bool field:",name])
+                                         else empty)
+    withEllipsis ellipsisItem xs
+      | length xs > max = [ellipsisItem] ++ takeEnd (max - 1) xs
+      | otherwise = xs
+    takeEnd i = reverse . take i . reverse
+    max = 4
+~~~
+
+### Everything needs a [Rule](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Core-Rules.html#t:Rules)
+
+I was stumped for a while when my templates wouldn´t
+[load](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Template.html#v:loadAndApplyTemplate).
+
+This was easily rectified by realising, that even templates need (of course) a
+declaration of how to compile them:
+
+~~~ {.haskell}
+main = hakyllWith config $ do
+  match "templates/*" $ compile templateCompiler
+  …
+~~~
+
+### Duplicate Rules are duplicate
+
+Hakyll tracks dependencies.
+Therefore it seems to keep a list of
+[Identifier](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Core-Identifier.html#t:Identifier)s
+it has encountered with priority given to the more early ones.
+
+It was thus necessary to tweak the function that does `Identifier`/`String`
+conversion for tags contained within a
+[Tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#v:Tags)
+structure if I wanted to use (the very convenient)
+[tagsRules](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#v:tagsRules)
+twice.
+
+So I did:
+
+~~~ {.haskell}
+main = hakyllWith config $ do
+  tags <- buildTags "posts/*" tagTranslation' …
+  let
+    tags' = tags { tagsMakeId = fromFilePath . (\b -> "rss" </> b <.> "rss") . takeBaseName . toFilePath . tagsMakeId tags}
+~~~
diff --git a/provider/posts/blog/origin.md b/provider/posts/blog/origin.md
new file mode 100644
index 0000000..b0d4af6
--- /dev/null
+++ b/provider/posts/blog/origin.md
@@ -0,0 +1,9 @@
+---
+title: On the Origin of dirty-haskell.org
+published: 2015-03-12
+tags: Blog Software
+---
+
+The software used is a trivially modified version of the one powering [math.kleen.org](http://math.kleen.org/lists/blog.html).
+
+The title is without deeper meaning.
diff --git a/provider/posts/blog/rss.md b/provider/posts/blog/rss.md
new file mode 100644
index 0000000..095ff56
--- /dev/null
+++ b/provider/posts/blog/rss.md
@@ -0,0 +1,43 @@
+---
+title: dirty-haskell.org´s rss feeds
+published: 2015-03-29
+tags: Blog Software
+---
+
+I extended the software suite inherited from [math.kleen.org](http://math.kleen.org) to include support for rss feeds.
+The heart of the issue is a ~80 line haskell script I chose to call, in a bout of creativity, "generate-rss.hs".
+The script uses the [feed](http://hackage.haskell.org/package/feed-0.3.9.2) package.
+
+generate-rss.hs gets passed a title and a list of paths below ./lists to incorporate as items.
+It generates an empty feed structure, adds title and a (hardcoded) base url for RSS metadata, and iterates over the given paths — generating for each path an item to be included in the finished feed.
+This procedure makes use of a state monad (StateT (Feed, Maybe ClockTime) IO ()) to sequentially add items to the feed and keep track of the modification/change time of the newest path examined.
+Each item carries a title, an url, a date, and contents as follows:
+
+-  The date used is the modification/change time of the path supplied as a command line argument at the beginning of the program (usually a symbolic link in ./lists) — as such it is the time the post was linked into the particular list we´re generating a RSS feed for (this was not a deliberate design choice but a side effect of the canonical implementation — it was later decided that this behaviour was in fact the one expected all along).
+-  The url is generated by following, recursively, the trail of symbolic links starting in ./lists, assuming the final target is indeed in ./posts, and forming the filename of that target into a (hopefully) functional url in a hardcoded fashion.
+-  The title is extracted from the markdown file using a function shamelessly copied from extract-title.hs (The author wrote that one too, after all).
+-  The contents are read into Pandoc and rendered into [AsciiDoc](http://en.wikipedia.org/wiki/AsciiDoc) format (it seemed convenient at the time).
+
+Along the way two helper functions were introduced — if an implementation of those already exists in Prelude or somewhere else common please mail in a comment:
+
+~~~ {.haskell}
+(<->) :: [(a -> b)] -> a -> [b]
+[] <-> _ = []
+(f:fs) <-> x = (f x:fs <-> x)
+
+(<-->) :: [(a -> a)] -> a -> a
+[] <--> x = x
+(f:fs) <--> x = fs <--> (f x)
+~~~
+
+## Update ##
+
+~~~ {.haskell}
+import Control.Applicative ((<*>), pure)
+
+(<->) fs = (<*>) fs . pure
+
+(<-->) = flip $ foldl (.) id
+~~~
+
+Thanks, viktor.
diff --git a/provider/posts/blog/tex-support.md b/provider/posts/blog/tex-support.md
new file mode 100644
index 0000000..7f43eb6
--- /dev/null
+++ b/provider/posts/blog/tex-support.md
@@ -0,0 +1,243 @@
+---
+title: Cursory Math-Support
+published: 2015-11-05
+tags: Blog Software
+---
+
+## Demonstration
+
+I added some cursory support for math as shown below:
+
+<div class="theorem">
+
+Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG).
+
+<div class="proof">
+$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$
+</div>
+<div class="lemma">
+
+Inline formulae get correctly aligned to match the baseline of the surrounding text.
+
+<div class="proof">
+$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$
+</div>
+</div>
+</div>
+
+## Implementation
+
+Theorem environments are written using [pandoc](http://pandoc.org)s support for block environments:
+
+~~~ {.markdown}
+<div class="theorem">
+
+Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG).
+
+<div class="proof">
+$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$
+</div>
+<div class="lemma">
+
+Inline formulae get correctly aligned to match the baseline of the surrounding text.
+
+<div class="proof">
+$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$
+</div>
+</div>
+</div>
+~~~
+
+Combined with a smattering of CSS this works nicely.
+$\text{\LaTeX}$ support is, however, lacking as I opted not to patch pandoc ([math.kleen.org](https://math.kleen.org) did).
+
+### `Math.hs`
+
+The actual compilation happens in a new module I named `Math.hs`. We´ll start there.
+For your reading pleasure I added some comments to the reproduction below.
+
+~~~ {.haskell}
+module Math
+       ( compileMath
+       ) where
+
+import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile)
+import System.IO.Temp (withSystemTempDirectory)
+import System.Process (callProcess, readProcessWithExitCode)
+import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory)
+import System.FilePath (takeFileName, FilePath(..), (</>))
+import System.Exit (ExitCode(..))
+
+import Control.Monad (when)
+import Control.Exception (bracket, throwIO)
+import Data.Maybe (fromMaybe, listToMaybe)
+
+import Control.Monad.Writer.Strict (WriterT(..), execWriterT, tell)
+import Control.Monad.Trans (liftIO)
+
+import Control.DeepSeq (($!!))
+
+import Text.Regex.TDFA ((=~))
+
+-- We built a monoid instance for `ExitCode` so we can easily collect failure using a `MonadWriter`
+instance Monoid ExitCode where
+  mempty = ExitSuccess
+  (ExitFailure a) `mappend` _ = ExitFailure a
+  ExitSuccess `mappend` x@(ExitFailure _) = x
+  ExitSuccess `mappend` ExitSuccess = ExitSuccess
+
+
+compileMath :: String -> IO (String, String)
+compileMath = withSystemTempDirectory "math" . compileMath' -- Create a temporary directory, run `compileMath'`, and make sure the directory get's deleted
+
+compileMath' :: String -> FilePath -> IO (String, String)
+compileMath' input tmpDir = do
+  mapM_ (copyToTmp . ("tex" </>)) [ "preamble.tex"
+                                  , "preview.dtx"
+                                  , "preview.ins"
+                                  ]
+  (exitCode, out, err) <- withCurrentDirectory tmpDir $ execWriterT $ do -- Collect stdout, stderr, and exitCode of all subprocesses (stdout and stderr simply get appended to one another)
+    run "latex" [ "-interaction=batchmode"
+                , "preview.ins"
+                ] ""
+    liftIO $ writeFile (tmpDir </> "image.tex") input
+    run "latex" [ "-interaction=batchmode"
+                , "image.tex"
+                ] ""
+    run "dvisvgm" [ "--exact"
+                  , "--no-fonts"
+                  , tmpDir </> "image.dvi"
+                  ] ""
+  when (exitCode /= ExitSuccess) $ do -- Fail with maximum noise if any of the latex passes fail -- otherwise be silent
+    hPutStrLn stdout out
+    hPutStrLn stderr err
+    throwIO exitCode
+  (\x -> return $!! (x, extractAlignment err)) =<< (readFile $ tmpDir </> "image.svg") -- Note the call to `($!!)` -- since we'll be deleting `tmpDir` we need to make sure the entire generated output resides in memory before we leave this block
+  where
+    copyToTmp fp = copyFile fp (tmpDir </> takeFileName fp)
+    run :: String -> [String] -> String -> WriterT (ExitCode, String, String) IO ()
+    run bin args stdin = tell =<< liftIO (readProcessWithExitCode bin args stdin)
+
+withCurrentDirectory :: FilePath  -- ^ Directory to execute in
+                     -> IO a      -- ^ Action to be executed
+                     -> IO a
+-- ^ This is provided in newer versions of temporary
+withCurrentDirectory dir action =
+  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
+    setCurrentDirectory dir
+    action
+
+extractAlignment :: String -> String
+extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") -- One of the few places where regular expressions really prove usefull
+  where
+    extract :: (String, String, String, [String]) -> Maybe String
+    extract (_, _, _, xs) = listToMaybe xs
+~~~
+
+### `Site.hs`
+
+The more trick part proved to be integration into the framework as provided by [Hakyll](http://jaspervdj.be/hakyll/).
+
+~~~ {.haskell}
+…
+
+import qualified Crypto.Hash.SHA256 as SHA256 (hash)
+import qualified Data.ByteString.Char8 as CBS
+import Data.Hex (hex)
+import Data.Char (toLower)
+
+import Math (compileMath)
+import Text.Printf (printf)
+
+main :: IO ()
+main = hakyllWith config $ do
+  …
+
+  math <- getMath "posts/*" mathTranslation'
+  forM_ math $ \(_, mathStr) -> create [mathTranslation' mathStr] $ do
+      route idRoute
+      compile $ do
+        item <- makeItem mathStr
+          >>= loadAndApplyTemplate "templates/math.tex" defaultContext
+          >>= withItemBody (unsafeCompiler . compileMath) -- unsafeCompiler :: IO a -> Compiler a
+        saveSnapshot "alignment" $ fmap snd item
+        return $ fmap fst item
+
+  match "posts/*" $ do
+    route $ setExtension ".html"
+    compile $ do
+      getResourceBody >>= saveSnapshot "content"
+      pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions mathTransform -- pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions -> (Pandoc -> Compiler Pandoc) -> Item String
+        >>= loadAndApplyTemplate "templates/default.html" defaultContext
+        >>= relativizeUrls
+  …
+
+…
+
+mathTranslation' :: String -> Identifier
+-- ^ This generates the filename for a svg file given the TeX-source
+mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack
+
+getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)]
+-- ^ We scrape all posts for math, calls `readPandoc'`
+getMath pattern makeId = do
+  ids <- getMatches pattern
+  mathStrs <- concat `liftM` mapM (\id -> map ((,) [id]) `liftM` getMath' (toFilePath' id)) ids
+  return $ mergeGroups $ groupBy ((==) `on` snd) $ mathStrs
+    where
+      getMath' :: FilePath -> Rules [String]
+      getMath' path = preprocess (query extractMath `liftM` readPandoc' path)
+      extractMath :: Inline -> [String]
+      extractMath (Math _ str) = [str]
+      extractMath _ = []
+      mergeGroups :: [[([Identifier], String)]] -> [([Identifier], String)]
+      mergeGroups = map mergeGroups' . filter (not . null)
+      mergeGroups' :: [([Identifier], String)] -> ([Identifier], String)
+      mergeGroups' xs@((_, str):_) = (concatMap fst xs, str)
+
+readPandoc' :: FilePath -> IO Pandoc
+-- ^ This is copied, almost verbatim, from Hakyll source -- Does what it says on the tin
+readPandoc' path = readFile path >>= either fail return . result'
+  where
+    result' str = case result str of
+        Left (ParseFailure err)  -> Left $
+            "parse failed: " ++ err
+        Left (ParsecError _ err) -> Left $
+            "parse failed: " ++ show err
+        Right item'              -> Right item'
+    result str = reader defaultHakyllReaderOptions (fileType path) str
+    reader ro t = case t of
+        DocBook            -> readDocBook ro
+        Html               -> readHtml ro
+        LaTeX              -> readLaTeX ro
+        LiterateHaskell t' -> reader (addExt ro Ext_literate_haskell) t'
+        Markdown           -> readMarkdown ro
+        MediaWiki          -> readMediaWiki ro
+        OrgMode            -> readOrg ro
+        Rst                -> readRST ro
+        Textile            -> readTextile ro
+        _                  -> error $
+            "I don't know how to read a file of " ++
+            "the type " ++ show t ++ " for: " ++ path
+
+    addExt ro e = ro {readerExtensions = Set.insert e $ readerExtensions ro}
+
+mathTransform :: Pandoc -> Compiler Pandoc
+-- ^ We replace math by raw html includes of the respective svg files here
+mathTransform = walkM mathTransform'
+  where
+    mathTransform' :: Inline -> Compiler Inline
+    mathTransform' (Math mathType tex) = do
+      alignment <- loadSnapshotBody texId "alignment"
+      let
+        html = printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s\">%s</object>"
+               (toFilePath texId) (alignment :: String) tex
+      return $ Span ("", [classOf mathType], []) [RawInline (Format "html") html]
+      where
+        texId = mathTranslation' tex
+        classOf DisplayMath = "display-math"
+        classOf InlineMath  = "inline-math"
+    mathTransform' x = return x
+
+…
+~~~
diff --git a/provider/posts/blog/ymir.md b/provider/posts/blog/ymir.md
new file mode 100644
index 0000000..83e5811
--- /dev/null
+++ b/provider/posts/blog/ymir.md
@@ -0,0 +1,7 @@
+---
+title: Moved servers
+published: 2015-11-05
+tags: Blog Software
+---
+
+dirty-haskell.org now lives on ymir.yggdrasil.li.