From bb296bb319a1d9a0050577dfed96e30298390db7 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 7 Nov 2015 19:24:34 +0000 Subject: Working math support --- blog.cabal | 2 + blog.nix | 6 +- default.nix | 6 +- provider/css/default.css | 2 +- provider/css/math.css | 49 +++++++++ provider/posts/tex-support.md | 235 +++++++++++++++++++++++++++++++++++++++- provider/templates/default.html | 1 + provider/templates/math.tex | 2 +- shell.nix | 5 +- src/Math.hs | 63 ++++++++--- src/Site.hs | 53 ++++++--- tex/preamble.tex | 2 - 12 files changed, 376 insertions(+), 50 deletions(-) create mode 100644 provider/css/math.css diff --git a/blog.cabal b/blog.cabal index 7f79183..e6aba5f 100644 --- a/blog.cabal +++ b/blog.cabal @@ -34,3 +34,5 @@ executable site , process >=1.2 && <2 , directory >=1.2 && <2 , deepseq >=1.4 && <2 + , regex-tdfa >=1.2 && <2 + , mtl >=2.2 && <3 diff --git a/blog.nix b/blog.nix index 1ef9585..ca9a83f 100644 --- a/blog.nix +++ b/blog.nix @@ -1,7 +1,8 @@ # This file was auto-generated by cabal2nix. Please do NOT edit manually! { mkDerivation, stdenv -, hakyll, containers, pandoc, data-default, filepath, hex, cryptohash, process, temporary, directory, deepseq +, hakyll, containers, pandoc, data-default, filepath, hex, cryptohash +, process, temporary, directory, deepseq, regex-tdfa, mtl }: mkDerivation { @@ -11,7 +12,8 @@ mkDerivation { isExecutable = true; isLibrary = false; buildDepends = [ - hakyll containers pandoc data-default filepath hex cryptohash process temporary directory deepseq + hakyll containers pandoc data-default filepath hex cryptohash + process temporary directory deepseq regex-tdfa mtl ]; license = stdenv.lib.licenses.publicDomain; } diff --git a/default.nix b/default.nix index 73581f5..d6e481e 100644 --- a/default.nix +++ b/default.nix @@ -10,8 +10,8 @@ rec { ''; } ); - texEnv = with pkgs; texLiveAggregationFun { - paths = [ texLive texLiveExtra lmodern libertine tipa texLiveContext texLiveCMSuper ]; + texEnv = with pkgs; texlive.combine { + inherit (texlive) scheme-small standalone dvisvgm amsmath; }; dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec { name = "dirty-haskell-wrapper"; @@ -19,7 +19,7 @@ rec { buildCommand = '' mkdir -p $out/bin makeWrapper ${dirty-haskell}/bin/site $out/bin/dirty-haskell \ - --append PATH : ${texEnv}/bin + --suffix PATH : ${texEnv}/bin ''; }; } 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 { } p code { - font-style:italic; + font-style:italic; } \ 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 @@ +span.inline-math { + display:inline; +} + +span.display-math { + display:block; + text-align:center; + margin-top:0.2em; + margin-bottom:0.2em; +} + +div.theorem, div.lemma, div.definition, div.corollary, div.proof { + margin-left: 2em; + margin-top: 1em; + margin-bottom: 1em; +} + +div.theorem > p:first-child:before { + content: "Theorem. "; + font-weight: bold; +} + +div.lemma > p:first-child:before { + content: "Lemma. "; + font-weight: bold; +} + +div.definition > p:first-child:before { + content: "Definition. "; + font-weight: bold; +} + +div.corollary > p:first-child:before { + content: "Corollary. "; + font-weight: bold; +} + +div.proof > p:first-child:before { + content: "Proof. "; + font-style: italic; +} + +div.proof > p:last-child:after { + content: " ∎"; +} + +div.theorem + div.proof { + margin-top: -1em; +} \ 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 @@ --- -title: Cursory LaTeX-Support +title: Cursory Math-Support published: 2015-11-05 tags: Blog Software --- -I added some cursory support for LaTeX as shown below: +## 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 .numberLines}
-$$\text{tan}(\phi) = \frac{\text{sin}(\phi)}{\text{cos}(\phi)}$$ + +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 .numberLines} +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 .numberLines} +… + +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/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 @@ + $if(rss)$$endif$ 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 @@ \documentclass[14pt,preview,border=1pt,class=extarticle]{standalone} -\include{preamble.tex} +\include{preamble} \begin{document} \begin{preview} \( diff --git a/shell.nix b/shell.nix index e17c3e6..9e363eb 100644 --- a/shell.nix +++ b/shell.nix @@ -3,8 +3,9 @@ pkgs.stdenv.mkDerivation rec { name = "dirty-haskell"; - buildInputs = [ (import ./default.nix {}).dirty-haskell-wrapper - ]; + buildInputs = with (import ./default.nix {}); [ dirty-haskell-wrapper + (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ])) + ]; shellHook = '' export PROMPT_INFO=${name} ''; 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 ( compileMath ) where +import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile) import System.IO.Temp (withSystemTempDirectory) -import System.Process (callProcess) +import System.Process (callProcess, readProcessWithExitCode) import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory) import System.FilePath (takeFileName, FilePath(..), ()) +import System.Exit (ExitCode(..)) -import Control.Monad -import Control.Exception (bracket) +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 (($!!)) -compileMath :: String -> IO String +import Text.Regex.TDFA ((=~)) + +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' -compileMath' :: String -> FilePath -> IO String +compileMath' :: String -> FilePath -> IO (String, String) compileMath' input tmpDir = do mapM_ (copyToTmp . ("tex" )) [ "preamble.tex" , "preview.dtx" , "preview.ins" ] - withCurrentDirectory tmpDir $ do - callProcess "latex" [ "-interaction=batchmode" - , "preview.ins" - ] - writeFile (tmpDir "image.tex") input - callProcess "latex" [ "-interaction=batchmode" - , "image.tex" - ] - callProcess "dvisvgm" [ "--exact" - , "--no-fonts" - , tmpDir "image.dvi" - ] - (\x -> return $!! x) =<< (readFile $ tmpDir "image.svg") + (exitCode, out, err) <- withCurrentDirectory tmpDir $ execWriterT $ do + 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 + hPutStrLn stdout out + hPutStrLn stderr err + throwIO exitCode + (\x -> return $!! (x, extractAlignment err)) =<< (readFile $ tmpDir "image.svg") 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 @@ -44,3 +65,9 @@ withCurrentDirectory dir action = bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do setCurrentDirectory dir action + +extractAlignment :: String -> String +extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") + where + extract :: (String, String, String, [String]) -> Maybe String + 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) import Data.Function (on) import Data.Default import Text.Pandoc -import Text.Pandoc.Walk (query) +import Text.Pandoc.Walk (query, walkM) import Text.Pandoc.Error import Control.Applicative (Alternative(..), Applicative(..)) +import System.FilePath (takeBaseName, (), (<.>)) + import qualified Crypto.Hash.SHA256 as SHA256 (hash) import qualified Data.ByteString.Char8 as CBS -import Data.Hex +import Data.Hex (hex) import Data.Char (toLower) -import System.FilePath (takeBaseName, (), (<.>)) - import Math (compileMath) +import Text.Printf (printf) main :: IO () main = hakyllWith config $ do @@ -34,24 +35,24 @@ main = hakyllWith config $ do route idRoute compile copyFileCompiler + 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) + saveSnapshot "alignment" $ fmap snd item + return $ fmap fst item + match "posts/*" $ do route $ setExtension ".html" compile $ do getResourceBody >>= saveSnapshot "content" - pandocCompiler + pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions mathTransform >>= loadAndApplyTemplate "templates/default.html" defaultContext >>= relativizeUrls - math <- getMath "posts/*" mathTranslation' - forM_ math $ \(deps, mathStr) -> - rulesExtraDependencies (map IdentifierDependency deps) $ - create [mathTranslation' mathStr] $ do - route idRoute - compile $ do - makeItem mathStr - >>= loadAndApplyTemplate "templates/math.tex" defaultContext - >>= withItemBody (unsafeCompiler . compileMath) - tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*" tagsRules tags $ \tag pattern -> do @@ -143,14 +144,14 @@ tagTranslation = mapMaybe charTrans | isAlphaNum c = Just $ toLower c | otherwise = Nothing -mathTranslation' :: String -> Identifier -mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack - addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags addTag name pattern tags = do ids <- getMatches pattern return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] } +mathTranslation' :: String -> Identifier +mathTranslation' = fromCapture "math/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack + getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)] getMath pattern makeId = do ids <- getMatches pattern @@ -193,6 +194,22 @@ readPandoc' path = readFile path >>= either fail return . result' addExt ro e = ro {readerExtensions = Set.insert e $ readerExtensions ro} +mathTransform :: Pandoc -> Compiler Pandoc +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 + toFilePath' :: Identifier -> FilePath toFilePath' = (providerDirectory config ) . toFilePath 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 @@ \usepackage{amssymb} \usepackage{amsmath} -\usepackage{amsthm} -\usepackage{thmtools} -- cgit v1.2.3