summaryrefslogtreecommitdiff
path: root/provider/posts/tex-support.md
blob: 7f43eb66542a22abb28577bf0f28b831e2f88f96 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
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

…
~~~