From 5b063193f389ef472366e4355a683f1843f29733 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 27 May 2016 19:40:18 +0200 Subject: structure --- provider/posts/blog/hakyll.md | 131 ++++++++++++++++++++ provider/posts/blog/origin.md | 9 ++ provider/posts/blog/rss.md | 43 +++++++ provider/posts/blog/tex-support.md | 243 +++++++++++++++++++++++++++++++++++++ provider/posts/blog/ymir.md | 7 ++ 5 files changed, 433 insertions(+) create mode 100644 provider/posts/blog/hakyll.md create mode 100644 provider/posts/blog/origin.md create mode 100644 provider/posts/blog/rss.md create mode 100644 provider/posts/blog/tex-support.md create mode 100644 provider/posts/blog/ymir.md (limited to 'provider/posts/blog') 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: + +
+ +Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG). + +
+$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$ +
+
+ +Inline formulae get correctly aligned to match the baseline of the surrounding text. + +
+$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$ +
+
+
+ +## Implementation + +Theorem environments are written using [pandoc](http://pandoc.org)s support for block environments: + +~~~ {.markdown} +
+ +Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG). + +
+$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$ +
+
+ +Inline formulae get correctly aligned to match the baseline of the surrounding text. + +
+$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$ +
+
+
+~~~ + +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 "%s" + (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. -- cgit v1.2.3