summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-02-03 18:23:10 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-02-03 18:23:10 +0100
commit5c4377102f442208d844a3d42aa23a0d074b7257 (patch)
treef2e6441d5858154a82c63f6daf0febf00345a3b0
parent9d3ff4605d30b434cdc0f302bb565606f1bcf722 (diff)
downloaddirty-haskell.org-5c4377102f442208d844a3d42aa23a0d074b7257.tar
dirty-haskell.org-5c4377102f442208d844a3d42aa23a0d074b7257.tar.gz
dirty-haskell.org-5c4377102f442208d844a3d42aa23a0d074b7257.tar.bz2
dirty-haskell.org-5c4377102f442208d844a3d42aa23a0d074b7257.tar.xz
dirty-haskell.org-5c4377102f442208d844a3d42aa23a0d074b7257.zip
Fixed tex \end fuckup
-rw-r--r--provider/templates/preamble.tex11
-rw-r--r--src/Site.hs7
-rw-r--r--src/Tex.hs10
3 files changed, 18 insertions, 10 deletions
diff --git a/provider/templates/preamble.tex b/provider/templates/preamble.tex
index 0d76503..1f2c1e4 100644
--- a/provider/templates/preamble.tex
+++ b/provider/templates/preamble.tex
@@ -11,11 +11,12 @@
11\newcommand*{\ca}[1]{\ensuremath{\mathbf{#1}}} 11\newcommand*{\ca}[1]{\ensuremath{\mathbf{#1}}}
12\newcommand*{\idarr}[1]{\ensuremath{\mathrm{id}_{#1}}} 12\newcommand*{\idarr}[1]{\ensuremath{\mathrm{id}_{#1}}}
13 13
14\newcommand{\id}{\ensuremath{\mathrm{id}}} 14\newcommand*{\id}{\ensuremath{\mathrm{id}}}
15\renewcommand{\implies}{\ensuremath{\rightarrow}} 15\renewcommand{\implies}{\ensuremath{\rightarrow}}
16 16
17\newcommand{\N}{\ensuremath{\mathbb{N}}} 17\newcommand*{\N}{\ensuremath{\mathbb{N}}}
18\newcommand{\arr}[3]{\begin{tikzcd}[ampersand replacement=\&]{#1} \rar{#2} \& {#3}\end{tikzcd}} 18\newcommand*{\arr}[3]{\begin{tikzcd}[ampersand replacement=\&]{#1} \rar{#2} \& {#3}\end{tikzcd}}
19\renewcommand{\hom}[3]{\ensuremath{\mathrm{hom}_{#1} \left [ #2, #3 \right ]}} 19\newcommand*{\Hom}[3]{\ensuremath{\mathrm{Hom}_{#1} \left [ #2, #3 \right ]}}
20\newcommand*{\End}[2]{\ensuremath{\mathrm{End}_{#1} \left [ #2 \right ]}}
20 21
21\newcommand{\powerset}{\raisebox{.15\baselineskip}{\Large\ensuremath{\wp}}} 22\newcommand*{\powerset}{\raisebox{.15\baselineskip}{\Large\ensuremath{\wp}}}
diff --git a/src/Site.hs b/src/Site.hs
index d3ac76d..03b6e16 100644
--- a/src/Site.hs
+++ b/src/Site.hs
@@ -170,7 +170,7 @@ getTex pattern makeId = do
170 getTex' :: FilePath -> Rules [String] 170 getTex' :: FilePath -> Rules [String]
171 getTex' path = preprocess . fmap concat $ (\x -> [query extractTex, query extractTex'] <*> pure x) `liftM` readPandoc' path 171 getTex' path = preprocess . fmap concat $ (\x -> [query extractTex, query extractTex'] <*> pure x) `liftM` readPandoc' path
172 extractTex :: Inline -> [String] 172 extractTex :: Inline -> [String]
173 extractTex (Math _ str) = ["\\(" ++ str ++ "\\)"] 173 extractTex (Math _ str) = [wrapMath str]
174 extractTex (RawInline "latex" str) = [str] 174 extractTex (RawInline "latex" str) = [str]
175 extractTex _ = [] 175 extractTex _ = []
176 extractTex' :: Block -> [String] 176 extractTex' :: Block -> [String]
@@ -181,6 +181,9 @@ getTex pattern makeId = do
181 mergeGroups' :: [([Identifier], String)] -> ([Identifier], String) 181 mergeGroups' :: [([Identifier], String)] -> ([Identifier], String)
182 mergeGroups' xs@((_, str):_) = (concatMap fst xs, str) 182 mergeGroups' xs@((_, str):_) = (concatMap fst xs, str)
183 183
184wrapMath :: String -> String
185wrapMath str = "\\(" ++ str ++ "\\)"
186
184readPandoc' :: FilePath -> IO Pandoc 187readPandoc' :: FilePath -> IO Pandoc
185readPandoc' path = readFile path >>= either fail return . result' 188readPandoc' path = readFile path >>= either fail return . result'
186 where 189 where
@@ -211,7 +214,7 @@ texTransform :: Pandoc -> Compiler Pandoc
211texTransform = walkM texTransformInline <=< walkM texTransformBlock 214texTransform = walkM texTransformInline <=< walkM texTransformBlock
212 where 215 where
213 texTransformInline :: Inline -> Compiler Inline 216 texTransformInline :: Inline -> Compiler Inline
214 texTransformInline (Math mathType tex) = (\html -> Span ("", [classOf mathType], []) [RawInline "html" html]) <$> texTransform' ("\\(" ++ tex ++ "\\)") 217 texTransformInline (Math mathType tex) = (\html -> Span ("", [classOf mathType], []) [RawInline "html" html]) <$> texTransform' (wrapMath tex)
215 texTransformInline (RawInline "latex" tex) = (\html -> Span ("", [], []) [RawInline "html" html]) <$> texTransform' tex 218 texTransformInline (RawInline "latex" tex) = (\html -> Span ("", [], []) [RawInline "html" html]) <$> texTransform' tex
216 texTransformInline x = return x 219 texTransformInline x = return x
217 texTransformBlock :: Block -> Compiler Block 220 texTransformBlock :: Block -> Compiler Block
diff --git a/src/Tex.hs b/src/Tex.hs
index a247218..5d347b9 100644
--- a/src/Tex.hs
+++ b/src/Tex.hs
@@ -2,10 +2,10 @@ module Tex
2 ( compileTex 2 ( compileTex
3 ) where 3 ) where
4 4
5import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile) 5import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile, hClose)
6import System.IO.Temp (withSystemTempDirectory) 6import System.IO.Temp (withSystemTempDirectory, openTempFile)
7import System.Process (callProcess, readProcessWithExitCode) 7import System.Process (callProcess, readProcessWithExitCode)
8import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory) 8import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory, getTemporaryDirectory)
9import System.FilePath (takeFileName, FilePath(..), (</>)) 9import System.FilePath (takeFileName, FilePath(..), (</>))
10import System.Exit (ExitCode(..)) 10import System.Exit (ExitCode(..))
11 11
@@ -50,6 +50,10 @@ compileTex' input tmpDir = do
50 when (exitCode /= ExitSuccess) $ do 50 when (exitCode /= ExitSuccess) $ do
51 hPutStrLn stdout out 51 hPutStrLn stdout out
52 hPutStrLn stderr err 52 hPutStrLn stderr err
53 (srcF, srcH) <- flip openTempFile "source.tex" =<< getTemporaryDirectory
54 hPutStrLn srcH input
55 hClose srcH
56 hPutStrLn stdout $ "Tex source saved to " ++ srcF
53 throwIO exitCode 57 throwIO exitCode
54 (\x -> return $!! (x, extractAlignment err)) =<< (readFile $ tmpDir </> "image.svg") 58 (\x -> return $!! (x, extractAlignment err)) =<< (readFile $ tmpDir </> "image.svg")
55 where 59 where