diff options
-rw-r--r-- | blog.cabal | 2 | ||||
-rw-r--r-- | blog.nix | 6 | ||||
-rw-r--r-- | default.nix | 6 | ||||
-rw-r--r-- | provider/css/default.css | 2 | ||||
-rw-r--r-- | provider/css/math.css | 49 | ||||
-rw-r--r-- | provider/posts/tex-support.md | 235 | ||||
-rw-r--r-- | provider/templates/default.html | 1 | ||||
-rw-r--r-- | provider/templates/math.tex | 2 | ||||
-rw-r--r-- | shell.nix | 5 | ||||
-rw-r--r-- | src/Math.hs | 63 | ||||
-rw-r--r-- | src/Site.hs | 53 | ||||
-rw-r--r-- | tex/preamble.tex | 2 |
12 files changed, 376 insertions, 50 deletions
@@ -34,3 +34,5 @@ executable site | |||
34 | , process >=1.2 && <2 | 34 | , process >=1.2 && <2 |
35 | , directory >=1.2 && <2 | 35 | , directory >=1.2 && <2 |
36 | , deepseq >=1.4 && <2 | 36 | , deepseq >=1.4 && <2 |
37 | , regex-tdfa >=1.2 && <2 | ||
38 | , mtl >=2.2 && <3 | ||
@@ -1,7 +1,8 @@ | |||
1 | # This file was auto-generated by cabal2nix. Please do NOT edit manually! | 1 | # This file was auto-generated by cabal2nix. Please do NOT edit manually! |
2 | 2 | ||
3 | { mkDerivation, stdenv | 3 | { mkDerivation, stdenv |
4 | , hakyll, containers, pandoc, data-default, filepath, hex, cryptohash, process, temporary, directory, deepseq | 4 | , hakyll, containers, pandoc, data-default, filepath, hex, cryptohash |
5 | , process, temporary, directory, deepseq, regex-tdfa, mtl | ||
5 | }: | 6 | }: |
6 | 7 | ||
7 | mkDerivation { | 8 | mkDerivation { |
@@ -11,7 +12,8 @@ mkDerivation { | |||
11 | isExecutable = true; | 12 | isExecutable = true; |
12 | isLibrary = false; | 13 | isLibrary = false; |
13 | buildDepends = [ | 14 | buildDepends = [ |
14 | hakyll containers pandoc data-default filepath hex cryptohash process temporary directory deepseq | 15 | hakyll containers pandoc data-default filepath hex cryptohash |
16 | process temporary directory deepseq regex-tdfa mtl | ||
15 | ]; | 17 | ]; |
16 | license = stdenv.lib.licenses.publicDomain; | 18 | license = stdenv.lib.licenses.publicDomain; |
17 | } | 19 | } |
diff --git a/default.nix b/default.nix index 73581f5..d6e481e 100644 --- a/default.nix +++ b/default.nix | |||
@@ -10,8 +10,8 @@ rec { | |||
10 | ''; | 10 | ''; |
11 | } | 11 | } |
12 | ); | 12 | ); |
13 | texEnv = with pkgs; texLiveAggregationFun { | 13 | texEnv = with pkgs; texlive.combine { |
14 | paths = [ texLive texLiveExtra lmodern libertine tipa texLiveContext texLiveCMSuper ]; | 14 | inherit (texlive) scheme-small standalone dvisvgm amsmath; |
15 | }; | 15 | }; |
16 | dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec { | 16 | dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec { |
17 | name = "dirty-haskell-wrapper"; | 17 | name = "dirty-haskell-wrapper"; |
@@ -19,7 +19,7 @@ rec { | |||
19 | buildCommand = '' | 19 | buildCommand = '' |
20 | mkdir -p $out/bin | 20 | mkdir -p $out/bin |
21 | makeWrapper ${dirty-haskell}/bin/site $out/bin/dirty-haskell \ | 21 | makeWrapper ${dirty-haskell}/bin/site $out/bin/dirty-haskell \ |
22 | --append PATH : ${texEnv}/bin | 22 | --suffix PATH : ${texEnv}/bin |
23 | ''; | 23 | ''; |
24 | }; | 24 | }; |
25 | } | 25 | } |
diff --git a/provider/css/default.css b/provider/css/default.css index 8f796e0..2d2a777 100644 --- a/provider/css/default.css +++ b/provider/css/default.css | |||
@@ -25,5 +25,5 @@ pre { | |||
25 | } | 25 | } |
26 | 26 | ||
27 | p code { | 27 | p code { |
28 | font-style:italic; | 28 | font-style:italic; |
29 | } \ No newline at end of file | 29 | } \ No newline at end of file |
diff --git a/provider/css/math.css b/provider/css/math.css new file mode 100644 index 0000000..4dc0dd7 --- /dev/null +++ b/provider/css/math.css | |||
@@ -0,0 +1,49 @@ | |||
1 | span.inline-math { | ||
2 | display:inline; | ||
3 | } | ||
4 | |||
5 | span.display-math { | ||
6 | display:block; | ||
7 | text-align:center; | ||
8 | margin-top:0.2em; | ||
9 | margin-bottom:0.2em; | ||
10 | } | ||
11 | |||
12 | div.theorem, div.lemma, div.definition, div.corollary, div.proof { | ||
13 | margin-left: 2em; | ||
14 | margin-top: 1em; | ||
15 | margin-bottom: 1em; | ||
16 | } | ||
17 | |||
18 | div.theorem > p:first-child:before { | ||
19 | content: "Theorem. "; | ||
20 | font-weight: bold; | ||
21 | } | ||
22 | |||
23 | div.lemma > p:first-child:before { | ||
24 | content: "Lemma. "; | ||
25 | font-weight: bold; | ||
26 | } | ||
27 | |||
28 | div.definition > p:first-child:before { | ||
29 | content: "Definition. "; | ||
30 | font-weight: bold; | ||
31 | } | ||
32 | |||
33 | div.corollary > p:first-child:before { | ||
34 | content: "Corollary. "; | ||
35 | font-weight: bold; | ||
36 | } | ||
37 | |||
38 | div.proof > p:first-child:before { | ||
39 | content: "Proof. "; | ||
40 | font-style: italic; | ||
41 | } | ||
42 | |||
43 | div.proof > p:last-child:after { | ||
44 | content: " ∎"; | ||
45 | } | ||
46 | |||
47 | div.theorem + div.proof { | ||
48 | margin-top: -1em; | ||
49 | } \ No newline at end of file | ||
diff --git a/provider/posts/tex-support.md b/provider/posts/tex-support.md index 16468ca..0beade1 100644 --- a/provider/posts/tex-support.md +++ b/provider/posts/tex-support.md | |||
@@ -1,14 +1,243 @@ | |||
1 | --- | 1 | --- |
2 | title: Cursory LaTeX-Support | 2 | title: Cursory Math-Support |
3 | published: 2015-11-05 | 3 | published: 2015-11-05 |
4 | tags: Blog Software | 4 | tags: Blog Software |
5 | --- | 5 | --- |
6 | 6 | ||
7 | I added some cursory support for LaTeX as shown below: | 7 | ## Demonstration |
8 | |||
9 | I added some cursory support for math as shown below: | ||
8 | 10 | ||
9 | <div class="theorem"> | 11 | <div class="theorem"> |
12 | |||
13 | Formulae are rendered with $\text{\LaTeX}$ and included as [SVG](https://en.wikipedia.org/wiki/SVG). | ||
14 | |||
15 | <div class="proof"> | ||
10 | $$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$ | 16 | $$e^{ix} =\text{cos}(x) + i \text{sin} (x)$$ |
11 | </div> | 17 | </div> |
18 | <div class="lemma"> | ||
19 | |||
20 | Inline 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 | |||
30 | Theorem environments are written using [pandoc](http://pandoc.org)s support for block environments: | ||
31 | |||
32 | ~~~ {.markdown .numberLines} | ||
12 | <div class="theorem"> | 33 | <div class="theorem"> |
13 | $$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$$ | 34 | |
35 | Formulae 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 | |||
42 | Inline 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> | ||
14 | </div> | 48 | </div> |
49 | ~~~ | ||
50 | |||
51 | Combined 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 | |||
56 | The actual compilation happens in a new module I named `Math.hs`. We´ll start there. | ||
57 | For your reading pleasure I added some comments to the reproduction below. | ||
58 | |||
59 | ~~~ {.haskell .numberLines} | ||
60 | module Math | ||
61 | ( compileMath | ||
62 | ) where | ||
63 | |||
64 | import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile) | ||
65 | import System.IO.Temp (withSystemTempDirectory) | ||
66 | import System.Process (callProcess, readProcessWithExitCode) | ||
67 | import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory) | ||
68 | import System.FilePath (takeFileName, FilePath(..), (</>)) | ||
69 | import System.Exit (ExitCode(..)) | ||
70 | |||
71 | import Control.Monad (when) | ||
72 | import Control.Exception (bracket, throwIO) | ||
73 | import Data.Maybe (fromMaybe, listToMaybe) | ||
74 | |||
75 | import Control.Monad.Writer.Strict (WriterT(..), execWriterT, tell) | ||
76 | import Control.Monad.Trans (liftIO) | ||
77 | |||
78 | import Control.DeepSeq (($!!)) | ||
79 | |||
80 | import Text.Regex.TDFA ((=~)) | ||
81 | |||
82 | -- We built a monoid instance for `ExitCode` so we can easily collect failure using a `MonadWriter` | ||
83 | instance 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 | |||
90 | compileMath :: String -> IO (String, String) | ||
91 | compileMath = withSystemTempDirectory "math" . compileMath' -- Create a temporary directory, run `compileMath'`, and make sure the directory get's deleted | ||
92 | |||
93 | compileMath' :: String -> FilePath -> IO (String, String) | ||
94 | compileMath' 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 | |||
121 | withCurrentDirectory :: FilePath -- ^ Directory to execute in | ||
122 | -> IO a -- ^ Action to be executed | ||
123 | -> IO a | ||
124 | -- ^ This is provided in newer versions of temporary | ||
125 | withCurrentDirectory dir action = | ||
126 | bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do | ||
127 | setCurrentDirectory dir | ||
128 | action | ||
129 | |||
130 | extractAlignment :: String -> String | ||
131 | extractAlignment = 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 | |||
139 | The more trick part proved to be integration into the framework as provided by [Hakyll](http://jaspervdj.be/hakyll/). | ||
140 | |||
141 | ~~~ {.haskell .numberLines} | ||
142 | … | ||
143 | |||
144 | import qualified Crypto.Hash.SHA256 as SHA256 (hash) | ||
145 | import qualified Data.ByteString.Char8 as CBS | ||
146 | import Data.Hex (hex) | ||
147 | import Data.Char (toLower) | ||
148 | |||
149 | import Math (compileMath) | ||
150 | import Text.Printf (printf) | ||
151 | |||
152 | main :: IO () | ||
153 | main = 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 | |||
177 | mathTranslation' :: String -> Identifier | ||
178 | -- ^ This generates the filename for a svg file given the TeX-source | ||
179 | mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack | ||
180 | |||
181 | getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)] | ||
182 | -- ^ We scrape all posts for math, calls `readPandoc'` | ||
183 | getMath 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 | |||
198 | readPandoc' :: FilePath -> IO Pandoc | ||
199 | -- ^ This is copied, almost verbatim, from Hakyll source -- Does what it says on the tin | ||
200 | readPandoc' 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 | |||
225 | mathTransform :: Pandoc -> Compiler Pandoc | ||
226 | -- ^ We replace math by raw html includes of the respective svg files here | ||
227 | mathTransform = 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/templates/default.html b/provider/templates/default.html index 5bc0e9f..ba412e6 100644 --- a/provider/templates/default.html +++ b/provider/templates/default.html | |||
@@ -10,6 +10,7 @@ | |||
10 | <script src="http://html5shim.googlecode.com/svn/trunk/html5.js"></script> | 10 | <script src="http://html5shim.googlecode.com/svn/trunk/html5.js"></script> |
11 | <![endif]--> | 11 | <![endif]--> |
12 | <link rel="stylesheet" href="/css/default.css"> | 12 | <link rel="stylesheet" href="/css/default.css"> |
13 | <link rel="stylesheet" href="/css/math.css"> | ||
13 | <link rel="stylesheet" href="/css/syntax.css"> | 14 | <link rel="stylesheet" href="/css/syntax.css"> |
14 | $if(rss)$<link rel="alternate" type="application/atom+xml" href="$rss$" title="Atom 1.0">$endif$ | 15 | $if(rss)$<link rel="alternate" type="application/atom+xml" href="$rss$" title="Atom 1.0">$endif$ |
15 | </head> | 16 | </head> |
diff --git a/provider/templates/math.tex b/provider/templates/math.tex index 4d5455f..23774bf 100644 --- a/provider/templates/math.tex +++ b/provider/templates/math.tex | |||
@@ -1,5 +1,5 @@ | |||
1 | \documentclass[14pt,preview,border=1pt,class=extarticle]{standalone} | 1 | \documentclass[14pt,preview,border=1pt,class=extarticle]{standalone} |
2 | \include{preamble.tex} | 2 | \include{preamble} |
3 | \begin{document} | 3 | \begin{document} |
4 | \begin{preview} | 4 | \begin{preview} |
5 | \( | 5 | \( |
@@ -3,8 +3,9 @@ | |||
3 | 3 | ||
4 | pkgs.stdenv.mkDerivation rec { | 4 | pkgs.stdenv.mkDerivation rec { |
5 | name = "dirty-haskell"; | 5 | name = "dirty-haskell"; |
6 | buildInputs = [ (import ./default.nix {}).dirty-haskell-wrapper | 6 | buildInputs = with (import ./default.nix {}); [ dirty-haskell-wrapper |
7 | ]; | 7 | (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ])) |
8 | ]; | ||
8 | shellHook = '' | 9 | shellHook = '' |
9 | export PROMPT_INFO=${name} | 10 | export PROMPT_INFO=${name} |
10 | ''; | 11 | ''; |
diff --git a/src/Math.hs b/src/Math.hs index e927fdd..db01f75 100644 --- a/src/Math.hs +++ b/src/Math.hs | |||
@@ -2,40 +2,61 @@ module Math | |||
2 | ( compileMath | 2 | ( compileMath |
3 | ) where | 3 | ) where |
4 | 4 | ||
5 | import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile) | ||
5 | import System.IO.Temp (withSystemTempDirectory) | 6 | import System.IO.Temp (withSystemTempDirectory) |
6 | import System.Process (callProcess) | 7 | import System.Process (callProcess, readProcessWithExitCode) |
7 | import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory) | 8 | import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory) |
8 | import System.FilePath (takeFileName, FilePath(..), (</>)) | 9 | import System.FilePath (takeFileName, FilePath(..), (</>)) |
10 | import System.Exit (ExitCode(..)) | ||
9 | 11 | ||
10 | import Control.Monad | 12 | import Control.Monad (when) |
11 | import Control.Exception (bracket) | 13 | import Control.Exception (bracket, throwIO) |
14 | import Data.Maybe (fromMaybe, listToMaybe) | ||
15 | |||
16 | import Control.Monad.Writer.Strict (WriterT(..), execWriterT, tell) | ||
17 | import Control.Monad.Trans (liftIO) | ||
12 | 18 | ||
13 | import Control.DeepSeq (($!!)) | 19 | import Control.DeepSeq (($!!)) |
14 | 20 | ||
15 | compileMath :: String -> IO String | 21 | import Text.Regex.TDFA ((=~)) |
22 | |||
23 | instance Monoid ExitCode where | ||
24 | mempty = ExitSuccess | ||
25 | (ExitFailure a) `mappend` _ = ExitFailure a | ||
26 | ExitSuccess `mappend` x@(ExitFailure _) = x | ||
27 | ExitSuccess `mappend` ExitSuccess = ExitSuccess | ||
28 | |||
29 | |||
30 | compileMath :: String -> IO (String, String) | ||
16 | compileMath = withSystemTempDirectory "math" . compileMath' | 31 | compileMath = withSystemTempDirectory "math" . compileMath' |
17 | 32 | ||
18 | compileMath' :: String -> FilePath -> IO String | 33 | compileMath' :: String -> FilePath -> IO (String, String) |
19 | compileMath' input tmpDir = do | 34 | compileMath' input tmpDir = do |
20 | mapM_ (copyToTmp . ("tex" </>)) [ "preamble.tex" | 35 | mapM_ (copyToTmp . ("tex" </>)) [ "preamble.tex" |
21 | , "preview.dtx" | 36 | , "preview.dtx" |
22 | , "preview.ins" | 37 | , "preview.ins" |
23 | ] | 38 | ] |
24 | withCurrentDirectory tmpDir $ do | 39 | (exitCode, out, err) <- withCurrentDirectory tmpDir $ execWriterT $ do |
25 | callProcess "latex" [ "-interaction=batchmode" | 40 | run "latex" [ "-interaction=batchmode" |
26 | , "preview.ins" | 41 | , "preview.ins" |
27 | ] | 42 | ] "" |
28 | writeFile (tmpDir </> "image.tex") input | 43 | liftIO $ writeFile (tmpDir </> "image.tex") input |
29 | callProcess "latex" [ "-interaction=batchmode" | 44 | run "latex" [ "-interaction=batchmode" |
30 | , "image.tex" | 45 | , "image.tex" |
31 | ] | 46 | ] "" |
32 | callProcess "dvisvgm" [ "--exact" | 47 | run "dvisvgm" [ "--exact" |
33 | , "--no-fonts" | 48 | , "--no-fonts" |
34 | , tmpDir </> "image.dvi" | 49 | , tmpDir </> "image.dvi" |
35 | ] | 50 | ] "" |
36 | (\x -> return $!! x) =<< (readFile $ tmpDir </> "image.svg") | 51 | when (exitCode /= ExitSuccess) $ do |
52 | hPutStrLn stdout out | ||
53 | hPutStrLn stderr err | ||
54 | throwIO exitCode | ||
55 | (\x -> return $!! (x, extractAlignment err)) =<< (readFile $ tmpDir </> "image.svg") | ||
37 | where | 56 | where |
38 | copyToTmp fp = copyFile fp (tmpDir </> takeFileName fp) | 57 | copyToTmp fp = copyFile fp (tmpDir </> takeFileName fp) |
58 | run :: String -> [String] -> String -> WriterT (ExitCode, String, String) IO () | ||
59 | run bin args stdin = tell =<< liftIO (readProcessWithExitCode bin args stdin) | ||
39 | 60 | ||
40 | withCurrentDirectory :: FilePath -- ^ Directory to execute in | 61 | withCurrentDirectory :: FilePath -- ^ Directory to execute in |
41 | -> IO a -- ^ Action to be executed | 62 | -> IO a -- ^ Action to be executed |
@@ -44,3 +65,9 @@ withCurrentDirectory dir action = | |||
44 | bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do | 65 | bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do |
45 | setCurrentDirectory dir | 66 | setCurrentDirectory dir |
46 | action | 67 | action |
68 | |||
69 | extractAlignment :: String -> String | ||
70 | extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") | ||
71 | where | ||
72 | extract :: (String, String, String, [String]) -> Maybe String | ||
73 | extract (_, _, _, xs) = listToMaybe xs | ||
diff --git a/src/Site.hs b/src/Site.hs index e821322..dcb9a7d 100644 --- a/src/Site.hs +++ b/src/Site.hs | |||
@@ -13,18 +13,19 @@ import Data.List (take, reverse, nub, groupBy, concatMap) | |||
13 | import Data.Function (on) | 13 | import Data.Function (on) |
14 | import Data.Default | 14 | import Data.Default |
15 | import Text.Pandoc | 15 | import Text.Pandoc |
16 | import Text.Pandoc.Walk (query) | 16 | import Text.Pandoc.Walk (query, walkM) |
17 | import Text.Pandoc.Error | 17 | import Text.Pandoc.Error |
18 | import Control.Applicative (Alternative(..), Applicative(..)) | 18 | import Control.Applicative (Alternative(..), Applicative(..)) |
19 | 19 | ||
20 | import System.FilePath (takeBaseName, (</>), (<.>)) | ||
21 | |||
20 | import qualified Crypto.Hash.SHA256 as SHA256 (hash) | 22 | import qualified Crypto.Hash.SHA256 as SHA256 (hash) |
21 | import qualified Data.ByteString.Char8 as CBS | 23 | import qualified Data.ByteString.Char8 as CBS |
22 | import Data.Hex | 24 | import Data.Hex (hex) |
23 | import Data.Char (toLower) | 25 | import Data.Char (toLower) |
24 | 26 | ||
25 | import System.FilePath (takeBaseName, (</>), (<.>)) | ||
26 | |||
27 | import Math (compileMath) | 27 | import Math (compileMath) |
28 | import Text.Printf (printf) | ||
28 | 29 | ||
29 | main :: IO () | 30 | main :: IO () |
30 | main = hakyllWith config $ do | 31 | main = hakyllWith config $ do |
@@ -34,24 +35,24 @@ main = hakyllWith config $ do | |||
34 | route idRoute | 35 | route idRoute |
35 | compile copyFileCompiler | 36 | compile copyFileCompiler |
36 | 37 | ||
38 | math <- getMath "posts/*" mathTranslation' | ||
39 | forM_ math $ \(_, mathStr) -> create [mathTranslation' mathStr] $ do | ||
40 | route idRoute | ||
41 | compile $ do | ||
42 | item <- makeItem mathStr | ||
43 | >>= loadAndApplyTemplate "templates/math.tex" defaultContext | ||
44 | >>= withItemBody (unsafeCompiler . compileMath) | ||
45 | saveSnapshot "alignment" $ fmap snd item | ||
46 | return $ fmap fst item | ||
47 | |||
37 | match "posts/*" $ do | 48 | match "posts/*" $ do |
38 | route $ setExtension ".html" | 49 | route $ setExtension ".html" |
39 | compile $ do | 50 | compile $ do |
40 | getResourceBody >>= saveSnapshot "content" | 51 | getResourceBody >>= saveSnapshot "content" |
41 | pandocCompiler | 52 | pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions mathTransform |
42 | >>= loadAndApplyTemplate "templates/default.html" defaultContext | 53 | >>= loadAndApplyTemplate "templates/default.html" defaultContext |
43 | >>= relativizeUrls | 54 | >>= relativizeUrls |
44 | 55 | ||
45 | math <- getMath "posts/*" mathTranslation' | ||
46 | forM_ math $ \(deps, mathStr) -> | ||
47 | rulesExtraDependencies (map IdentifierDependency deps) $ | ||
48 | create [mathTranslation' mathStr] $ do | ||
49 | route idRoute | ||
50 | compile $ do | ||
51 | makeItem mathStr | ||
52 | >>= loadAndApplyTemplate "templates/math.tex" defaultContext | ||
53 | >>= withItemBody (unsafeCompiler . compileMath) | ||
54 | |||
55 | tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*" | 56 | tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*" |
56 | 57 | ||
57 | tagsRules tags $ \tag pattern -> do | 58 | tagsRules tags $ \tag pattern -> do |
@@ -143,14 +144,14 @@ tagTranslation = mapMaybe charTrans | |||
143 | | isAlphaNum c = Just $ toLower c | 144 | | isAlphaNum c = Just $ toLower c |
144 | | otherwise = Nothing | 145 | | otherwise = Nothing |
145 | 146 | ||
146 | mathTranslation' :: String -> Identifier | ||
147 | mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack | ||
148 | |||
149 | addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags | 147 | addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags |
150 | addTag name pattern tags = do | 148 | addTag name pattern tags = do |
151 | ids <- getMatches pattern | 149 | ids <- getMatches pattern |
152 | return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] } | 150 | return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] } |
153 | 151 | ||
152 | mathTranslation' :: String -> Identifier | ||
153 | mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack | ||
154 | |||
154 | getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)] | 155 | getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)] |
155 | getMath pattern makeId = do | 156 | getMath pattern makeId = do |
156 | ids <- getMatches pattern | 157 | ids <- getMatches pattern |
@@ -193,6 +194,22 @@ readPandoc' path = readFile path >>= either fail return . result' | |||
193 | 194 | ||
194 | addExt ro e = ro {readerExtensions = Set.insert e $ readerExtensions ro} | 195 | addExt ro e = ro {readerExtensions = Set.insert e $ readerExtensions ro} |
195 | 196 | ||
197 | mathTransform :: Pandoc -> Compiler Pandoc | ||
198 | mathTransform = walkM mathTransform' | ||
199 | where | ||
200 | mathTransform' :: Inline -> Compiler Inline | ||
201 | mathTransform' (Math mathType tex) = do | ||
202 | alignment <- loadSnapshotBody texId "alignment" | ||
203 | let | ||
204 | html = printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s\">%s</object>" | ||
205 | (toFilePath texId) (alignment :: String) tex | ||
206 | return $ Span ("", [classOf mathType], []) [RawInline (Format "html") html] | ||
207 | where | ||
208 | texId = mathTranslation' tex | ||
209 | classOf DisplayMath = "display-math" | ||
210 | classOf InlineMath = "inline-math" | ||
211 | mathTransform' x = return x | ||
212 | |||
196 | toFilePath' :: Identifier -> FilePath | 213 | toFilePath' :: Identifier -> FilePath |
197 | toFilePath' = (providerDirectory config </>) . toFilePath | 214 | toFilePath' = (providerDirectory config </>) . toFilePath |
198 | 215 | ||
diff --git a/tex/preamble.tex b/tex/preamble.tex index 531506a..b916cf1 100644 --- a/tex/preamble.tex +++ b/tex/preamble.tex | |||
@@ -2,5 +2,3 @@ | |||
2 | 2 | ||
3 | \usepackage{amssymb} | 3 | \usepackage{amssymb} |
4 | \usepackage{amsmath} | 4 | \usepackage{amsmath} |
5 | \usepackage{amsthm} | ||
6 | \usepackage{thmtools} | ||