summaryrefslogtreecommitdiff
path: root/provider/posts/blog
diff options
context:
space:
mode:
Diffstat (limited to 'provider/posts/blog')
-rw-r--r--provider/posts/blog/hakyll.md131
-rw-r--r--provider/posts/blog/origin.md9
-rw-r--r--provider/posts/blog/rss.md43
-rw-r--r--provider/posts/blog/tex-support.md243
-rw-r--r--provider/posts/blog/ymir.md7
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 @@
1---
2title: Switch to Hakyll
3published: 2015-08-03
4tags: Blog Software
5---
6
7I stopped using the software suite inherited from
8[math.kleen.org](http://math.kleen.org) and switched over to using
9[hakyll](http://jaspervdj.be/hakyll/) instead, since I realised that the two
10were doing essentially the same job and keeping my mess in one haskell file
11(`src/Site.hs`, for those of you who are willing to checkout the
12[git repo](https://git.yggdrasil.li/gkleen/pub/dirty-haskell.org)) instead of spread over a
13large number of interlocking zsh and haskell scripts.
14
15I expect nothing to be seriously broken (Only the filepaths of lists have
16changed), but some feed readers might have stopped working (hakyll´s
17deceptively named `renderRss` actually renders atom).
18
19## Implementation Details
20
21I´m using this post to document some of the more involved things I had to do
22during migration in no particular order.
23
24### Lists → Tags
25
26I´m using hakyll´s implementation of
27[tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html)
28instead of the [math.kleen.org](http://math.kleen.org) concept of lists, now.
29
30This required some tweaking.
31
32In order to retain the [All Posts](/tags/all-posts.html) list I introduced a
33function to add new tags to an already existing
34[Tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#t:Tags)
35structure and used it to add my desired pseudo-tag.
36
37~~~ {.haskell}
38main = hakyllWith config $ do
39
40 tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*"
41
42
43addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags
44addTag name pattern tags = do
45 ids <- getMatches pattern
46 return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] }
47~~~
48
49### Printing lists is an involved affair
50
51I wanted to keep the layout of the site including the lists of posts on the
52[index page](/).
53
54Generating those lists turned out to be a hassle.
55
56The `Rule` for `index.md` adds to the context of the templates used in it´s
57creation a list field which contains verbatim HTML as produced by renderTag for
58each tag.
59A trick I used to implement the desired behaviour of replacing old posts with
60"…" is to introduce a pseudo post-item which has a flag in it´s context to tell
61the corresponding template to only print "…".
62Trimming the list of posts is straightforward.
63
64~~~ {.haskell}
65renderTag :: String -- ^ Tag name
66 -> Tags
67 -> Compiler (Item String)
68renderTag tag tags = do
69 ellipsisItem <- makeItem ""
70 let
71 ids = fromMaybe [] $ lookup tag $ tagsMap tags
72 postCtx = mconcat [ listField "posts" (ellipsisContext ellipsisItem) $
73 liftM (withEllipsis ellipsisItem) $ chronological =<< mapM load ids
74 , constField "title" tag
75 , constField "rss" ("tags/" ++ tagTranslation tag ++ ".rss")
76 , constField "url" ("tags/" ++ tagTranslation tag ++ ".html")
77 , defaultContext
78 ]
79 makeItem ""
80 >>= loadAndApplyTemplate "templates/post-list.html" postCtx
81 >>= loadAndApplyTemplate "templates/tag.html" postCtx
82 where
83 ellipsisContext item = mconcat [ boolField "ellipsis" (== item)
84 , defaultContext
85 ]
86 boolField name f = field name (\i -> if f i
87 then pure (error $ unwords ["no string value for bool field:",name])
88 else empty)
89 withEllipsis ellipsisItem xs
90 | length xs > max = [ellipsisItem] ++ takeEnd (max - 1) xs
91 | otherwise = xs
92 takeEnd i = reverse . take i . reverse
93 max = 4
94~~~
95
96### Everything needs a [Rule](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Core-Rules.html#t:Rules)
97
98I was stumped for a while when my templates wouldn´t
99[load](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Template.html#v:loadAndApplyTemplate).
100
101This was easily rectified by realising, that even templates need (of course) a
102declaration of how to compile them:
103
104~~~ {.haskell}
105main = hakyllWith config $ do
106 match "templates/*" $ compile templateCompiler
107
108~~~
109
110### Duplicate Rules are duplicate
111
112Hakyll tracks dependencies.
113Therefore it seems to keep a list of
114[Identifier](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Core-Identifier.html#t:Identifier)s
115it has encountered with priority given to the more early ones.
116
117It was thus necessary to tweak the function that does `Identifier`/`String`
118conversion for tags contained within a
119[Tags](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#v:Tags)
120structure if I wanted to use (the very convenient)
121[tagsRules](http://hackage.haskell.org/package/hakyll-4.7.2.2/docs/Hakyll-Web-Tags.html#v:tagsRules)
122twice.
123
124So I did:
125
126~~~ {.haskell}
127main = hakyllWith config $ do
128 tags <- buildTags "posts/*" tagTranslation' …
129 let
130 tags' = tags { tagsMakeId = fromFilePath . (\b -> "rss" </> b <.> "rss") . takeBaseName . toFilePath . tagsMakeId tags}
131~~~
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 @@
1---
2title: On the Origin of dirty-haskell.org
3published: 2015-03-12
4tags: Blog Software
5---
6
7The software used is a trivially modified version of the one powering [math.kleen.org](http://math.kleen.org/lists/blog.html).
8
9The 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 @@
1---
2title: dirty-haskell.org´s rss feeds
3published: 2015-03-29
4tags: Blog Software
5---
6
7I extended the software suite inherited from [math.kleen.org](http://math.kleen.org) to include support for rss feeds.
8The heart of the issue is a ~80 line haskell script I chose to call, in a bout of creativity, "generate-rss.hs".
9The script uses the [feed](http://hackage.haskell.org/package/feed-0.3.9.2) package.
10
11generate-rss.hs gets passed a title and a list of paths below ./lists to incorporate as items.
12It 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.
13This 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.
14Each item carries a title, an url, a date, and contents as follows:
15
16- 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).
17- 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.
18- 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).
19- The contents are read into Pandoc and rendered into [AsciiDoc](http://en.wikipedia.org/wiki/AsciiDoc) format (it seemed convenient at the time).
20
21Along 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:
22
23~~~ {.haskell}
24(<->) :: [(a -> b)] -> a -> [b]
25[] <-> _ = []
26(f:fs) <-> x = (f x:fs <-> x)
27
28(<-->) :: [(a -> a)] -> a -> a
29[] <--> x = x
30(f:fs) <--> x = fs <--> (f x)
31~~~
32
33## Update ##
34
35~~~ {.haskell}
36import Control.Applicative ((<*>), pure)
37
38(<->) fs = (<*>) fs . pure
39
40(<-->) = flip $ foldl (.) id
41~~~
42
43Thanks, 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 @@
1---
2title: Cursory Math-Support
3published: 2015-11-05
4tags: Blog Software
5---
6
7## Demonstration
8
9I added some cursory support for math as shown below:
10
11<div class="theorem">
12
13Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG).
14
15<div class="proof">
16$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$
17</div>
18<div class="lemma">
19
20Inline formulae get correctly aligned to match the baseline of the surrounding text.
21
22<div class="proof">
23$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$
24</div>
25</div>
26</div>
27
28## Implementation
29
30Theorem environments are written using [pandoc](http://pandoc.org)s support for block environments:
31
32~~~ {.markdown}
33<div class="theorem">
34
35Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG).
36
37<div class="proof">
38$$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$
39</div>
40<div class="lemma">
41
42Inline formulae get correctly aligned to match the baseline of the surrounding text.
43
44<div class="proof">
45$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$
46</div>
47</div>
48</div>
49~~~
50
51Combined with a smattering of CSS this works nicely.
52$\text{\LaTeX}$ support is, however, lacking as I opted not to patch pandoc ([math.kleen.org](https://math.kleen.org) did).
53
54### `Math.hs`
55
56The actual compilation happens in a new module I named `Math.hs`. We´ll start there.
57For your reading pleasure I added some comments to the reproduction below.
58
59~~~ {.haskell}
60module Math
61 ( compileMath
62 ) where
63
64import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile)
65import System.IO.Temp (withSystemTempDirectory)
66import System.Process (callProcess, readProcessWithExitCode)
67import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory)
68import System.FilePath (takeFileName, FilePath(..), (</>))
69import System.Exit (ExitCode(..))
70
71import Control.Monad (when)
72import Control.Exception (bracket, throwIO)
73import Data.Maybe (fromMaybe, listToMaybe)
74
75import Control.Monad.Writer.Strict (WriterT(..), execWriterT, tell)
76import Control.Monad.Trans (liftIO)
77
78import Control.DeepSeq (($!!))
79
80import Text.Regex.TDFA ((=~))
81
82-- We built a monoid instance for `ExitCode` so we can easily collect failure using a `MonadWriter`
83instance Monoid ExitCode where
84 mempty = ExitSuccess
85 (ExitFailure a) `mappend` _ = ExitFailure a
86 ExitSuccess `mappend` x@(ExitFailure _) = x
87 ExitSuccess `mappend` ExitSuccess = ExitSuccess
88
89
90compileMath :: String -> IO (String, String)
91compileMath = withSystemTempDirectory "math" . compileMath' -- Create a temporary directory, run `compileMath'`, and make sure the directory get's deleted
92
93compileMath' :: String -> FilePath -> IO (String, String)
94compileMath' input tmpDir = do
95 mapM_ (copyToTmp . ("tex" </>)) [ "preamble.tex"
96 , "preview.dtx"
97 , "preview.ins"
98 ]
99 (exitCode, out, err) <- withCurrentDirectory tmpDir $ execWriterT $ do -- Collect stdout, stderr, and exitCode of all subprocesses (stdout and stderr simply get appended to one another)
100 run "latex" [ "-interaction=batchmode"
101 , "preview.ins"
102 ] ""
103 liftIO $ writeFile (tmpDir </> "image.tex") input
104 run "latex" [ "-interaction=batchmode"
105 , "image.tex"
106 ] ""
107 run "dvisvgm" [ "--exact"
108 , "--no-fonts"
109 , tmpDir </> "image.dvi"
110 ] ""
111 when (exitCode /= ExitSuccess) $ do -- Fail with maximum noise if any of the latex passes fail -- otherwise be silent
112 hPutStrLn stdout out
113 hPutStrLn stderr err
114 throwIO exitCode
115 (\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
116 where
117 copyToTmp fp = copyFile fp (tmpDir </> takeFileName fp)
118 run :: String -> [String] -> String -> WriterT (ExitCode, String, String) IO ()
119 run bin args stdin = tell =<< liftIO (readProcessWithExitCode bin args stdin)
120
121withCurrentDirectory :: FilePath -- ^ Directory to execute in
122 -> IO a -- ^ Action to be executed
123 -> IO a
124-- ^ This is provided in newer versions of temporary
125withCurrentDirectory dir action =
126 bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
127 setCurrentDirectory dir
128 action
129
130extractAlignment :: String -> String
131extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") -- One of the few places where regular expressions really prove usefull
132 where
133 extract :: (String, String, String, [String]) -> Maybe String
134 extract (_, _, _, xs) = listToMaybe xs
135~~~
136
137### `Site.hs`
138
139The more trick part proved to be integration into the framework as provided by [Hakyll](http://jaspervdj.be/hakyll/).
140
141~~~ {.haskell}
142
143
144import qualified Crypto.Hash.SHA256 as SHA256 (hash)
145import qualified Data.ByteString.Char8 as CBS
146import Data.Hex (hex)
147import Data.Char (toLower)
148
149import Math (compileMath)
150import Text.Printf (printf)
151
152main :: IO ()
153main = hakyllWith config $ do
154
155
156 math <- getMath "posts/*" mathTranslation'
157 forM_ math $ \(_, mathStr) -> create [mathTranslation' mathStr] $ do
158 route idRoute
159 compile $ do
160 item <- makeItem mathStr
161 >>= loadAndApplyTemplate "templates/math.tex" defaultContext
162 >>= withItemBody (unsafeCompiler . compileMath) -- unsafeCompiler :: IO a -> Compiler a
163 saveSnapshot "alignment" $ fmap snd item
164 return $ fmap fst item
165
166 match "posts/*" $ do
167 route $ setExtension ".html"
168 compile $ do
169 getResourceBody >>= saveSnapshot "content"
170 pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions mathTransform -- pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions -> (Pandoc -> Compiler Pandoc) -> Item String
171 >>= loadAndApplyTemplate "templates/default.html" defaultContext
172 >>= relativizeUrls
173
174
175
176
177mathTranslation' :: String -> Identifier
178-- ^ This generates the filename for a svg file given the TeX-source
179mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack
180
181getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)]
182-- ^ We scrape all posts for math, calls `readPandoc'`
183getMath pattern makeId = do
184 ids <- getMatches pattern
185 mathStrs <- concat `liftM` mapM (\id -> map ((,) [id]) `liftM` getMath' (toFilePath' id)) ids
186 return $ mergeGroups $ groupBy ((==) `on` snd) $ mathStrs
187 where
188 getMath' :: FilePath -> Rules [String]
189 getMath' path = preprocess (query extractMath `liftM` readPandoc' path)
190 extractMath :: Inline -> [String]
191 extractMath (Math _ str) = [str]
192 extractMath _ = []
193 mergeGroups :: [[([Identifier], String)]] -> [([Identifier], String)]
194 mergeGroups = map mergeGroups' . filter (not . null)
195 mergeGroups' :: [([Identifier], String)] -> ([Identifier], String)
196 mergeGroups' xs@((_, str):_) = (concatMap fst xs, str)
197
198readPandoc' :: FilePath -> IO Pandoc
199-- ^ This is copied, almost verbatim, from Hakyll source -- Does what it says on the tin
200readPandoc' path = readFile path >>= either fail return . result'
201 where
202 result' str = case result str of
203 Left (ParseFailure err) -> Left $
204 "parse failed: " ++ err
205 Left (ParsecError _ err) -> Left $
206 "parse failed: " ++ show err
207 Right item' -> Right item'
208 result str = reader defaultHakyllReaderOptions (fileType path) str
209 reader ro t = case t of
210 DocBook -> readDocBook ro
211 Html -> readHtml ro
212 LaTeX -> readLaTeX ro
213 LiterateHaskell t' -> reader (addExt ro Ext_literate_haskell) t'
214 Markdown -> readMarkdown ro
215 MediaWiki -> readMediaWiki ro
216 OrgMode -> readOrg ro
217 Rst -> readRST ro
218 Textile -> readTextile ro
219 _ -> error $
220 "I don't know how to read a file of " ++
221 "the type " ++ show t ++ " for: " ++ path
222
223 addExt ro e = ro {readerExtensions = Set.insert e $ readerExtensions ro}
224
225mathTransform :: Pandoc -> Compiler Pandoc
226-- ^ We replace math by raw html includes of the respective svg files here
227mathTransform = walkM mathTransform'
228 where
229 mathTransform' :: Inline -> Compiler Inline
230 mathTransform' (Math mathType tex) = do
231 alignment <- loadSnapshotBody texId "alignment"
232 let
233 html = printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s\">%s</object>"
234 (toFilePath texId) (alignment :: String) tex
235 return $ Span ("", [classOf mathType], []) [RawInline (Format "html") html]
236 where
237 texId = mathTranslation' tex
238 classOf DisplayMath = "display-math"
239 classOf InlineMath = "inline-math"
240 mathTransform' x = return x
241
242
243~~~
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 @@
1---
2title: Moved servers
3published: 2015-11-05
4tags: Blog Software
5---
6
7dirty-haskell.org now lives on ymir.yggdrasil.li.