Extended tex & math support

8 files changed, 61 insertions, 49 deletions

diff --git a/default.nix b/default.nix
index 0770eb3..8d04076 100644
--- a/default.nix
+++ b/default.nix
@@ -11,7 +11,7 @@ rec {
             }
     );
   texEnv = with pkgs; texlive.combine {
-    inherit (texlive) scheme-small standalone dvisvgm amsmath tikz tikz-cd;
+    inherit (texlive) scheme-small standalone dvisvgm amsmath tikz-cd;
   };
   dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec {
     name = "dirty-haskell-wrapper";
diff --git a/provider/css/math.css b/provider/css/math.css
index e045853..b2a3644 100644
--- a/provider/css/math.css
+++ b/provider/css/math.css
@@ -18,6 +18,11 @@ div div {
     margin-left: 2em;
 }
 
+div.exercise > p:first-child:before {
+    content: "Exercise. ";
+    font-weight: bold;
+}
+
 div.theorem > p:first-child:before {
     content: "Theorem. ";
     font-weight: bold;
diff --git a/tex/preamble.tex b/provider/templates/preamble.tex
index 8ff41d1..129eba8 100644
--- a/tex/preamble.tex
+++ b/provider/templates/preamble.tex
@@ -1,7 +1,6 @@
 \usepackage[utf8]{inputenc}
 
 \usepackage{amssymb}
-\usepackage{xspace}
 \usepackage{amsmath}
 \usepackage{mathrsfs}
 
@@ -9,8 +8,11 @@
 
 \usetikzlibrary{cd}
 
-\newcommand*{\ca}[1]{\ensuremath{\mathbf{#1}}\xspace}
+\newcommand*{\ca}[1]{\ensuremath{\mathbf{#1}}}
 \newcommand*{\idarr}[1]{\ensuremath{\mathrm{id}_{#1}}}
 
 \newcommand{\id}{\ensuremath{\mathrm{id}}}
 \renewcommand{\implies}{\rightarrow}
+
+\newcommand{\N}{\ensuremath{\mathbb{N}}}
+\newcommand{\arr}[3]{\ensuremath{\begin{tikzcd}[ampersand replacement=\&]{#1} \rar{#2} \& {#3}\end{tikzcd}}}
diff --git a/provider/templates/math.tex b/provider/templates/preview.tex
index 23774bf..da3c585 100644
--- a/provider/templates/math.tex
+++ b/provider/templates/preview.tex
@@ -1,9 +1,7 @@
 \documentclass[14pt,preview,border=1pt,class=extarticle]{standalone}
-\include{preamble}
+$partial("templates/preamble.tex")$
 \begin{document}
 \begin{preview}
-\(
 $body$
-\)
 \end{preview}
 \end{document}
diff --git a/tex/preview.dtx b/provider/tex/preview.dtx
index 0675c27..0675c27 100644
--- a/tex/preview.dtx
+++ b/provider/tex/preview.dtx
diff --git a/tex/preview.ins b/provider/tex/preview.ins
index 1d4229d..1d4229d 100644
--- a/tex/preview.ins
+++ b/provider/tex/preview.ins
diff --git a/src/Site.hs b/src/Site.hs
index 5f5fbc0..d3ac76d 100644
--- a/src/Site.hs
+++ b/src/Site.hs
@@ -3,7 +3,7 @@
 import Hakyll
 
 import Data.Monoid (Monoid(..), mconcat, (<>))
-import Control.Monad (liftM, forM_)
+import Control.Monad (liftM, forM_, (<=<))
 import Data.Char (toLower, isSpace, isAlphaNum)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Map (Map)
@@ -27,7 +27,7 @@ import qualified Data.ByteString.Char8 as CBS
 import Data.Hex (hex)
 import Data.Char (toLower)
 
-import Math (compileMath)
+import Tex (compileTex)
 import Text.Printf (printf)
 
 main :: IO ()
@@ -38,13 +38,13 @@ main = hakyllWith config $ do
     route idRoute
     compile copyFileCompiler
 
-  math <- getMath "posts/**" mathTranslation'
-  forM_ math $ \(_, mathStr) -> create [mathTranslation' mathStr] $ do
+  tex <- getTex "posts/**" texTranslation'
+  forM_ tex $ \(_, texStr) -> create [texTranslation' texStr] $ do
       route idRoute
       compile $ do
-        item <- makeItem mathStr
-          >>= loadAndApplyTemplate "templates/math.tex" defaultContext
-          >>= withItemBody (unsafeCompiler . compileMath)
+        item <- makeItem texStr
+          >>= loadAndApplyTemplate "templates/preview.tex" defaultContext
+          >>= withItemBody (unsafeCompiler . compileTex)
         saveSnapshot "alignment" $ fmap snd item
         return $ fmap fst item
 
@@ -58,7 +58,7 @@ main = hakyllWith config $ do
                         , tagsFieldWith getTags (\tag _ -> Just . H.li $ H.a ! A.href (toValue . toUrl $ "tags" </> tagTranslation tag <.> "html") $ toHtml tag) (mconcat . intersperse "\n") "tagList" tags
                         ]
       getResourceBody >>= saveSnapshot "content"
-      pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions mathTransform
+      pandocCompilerWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions texTransform
         >>= loadAndApplyTemplate "templates/default.html" ctx
         >>= relativizeUrls
 
@@ -158,20 +158,24 @@ 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
+texTranslation' :: String -> Identifier
+texTranslation' = fromCapture "tex/*.svg" . map toLower . CBS.unpack . hex . SHA256.hash . CBS.pack
 
-getMath :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)]
-getMath pattern makeId = do
+getTex :: Pattern -> (String -> Identifier) -> Rules [([Identifier], String)]
+getTex pattern makeId = do
   ids <- getMatches pattern
-  mathStrs <- concat `liftM` mapM (\id -> map ((,) [id]) `liftM` getMath' (toFilePath' id)) ids
-  return $ mergeGroups $ groupBy ((==) `on` snd) $ mathStrs
+  texStrs <- concat `liftM` mapM (\id -> map ((,) [id]) `liftM` getTex' (toFilePath' id)) ids
+  return $ mergeGroups $ groupBy ((==) `on` snd) $ texStrs
     where
-      getMath' :: FilePath -> Rules [String]
-      getMath' path = preprocess (query extractMath `liftM` readPandoc' path)
-      extractMath :: Inline -> [String]
-      extractMath (Math _ str) = [str]
-      extractMath _ = []
+      getTex' :: FilePath -> Rules [String]
+      getTex' path = preprocess . fmap concat $ (\x -> [query extractTex, query extractTex'] <*> pure x) `liftM` readPandoc' path
+      extractTex :: Inline -> [String]
+      extractTex (Math _ str) = ["\\(" ++ str ++ "\\)"]
+      extractTex (RawInline "latex" str) = [str]
+      extractTex _ = []
+      extractTex' :: Block -> [String]
+      extractTex' (RawBlock "latex" str) = [str]
+      extractTex' _ = []
       mergeGroups :: [[([Identifier], String)]] -> [([Identifier], String)]
       mergeGroups = map mergeGroups' . filter (not . null)
       mergeGroups' :: [([Identifier], String)] -> ([Identifier], String)
@@ -203,21 +207,25 @@ 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'
+texTransform :: Pandoc -> Compiler Pandoc
+texTransform = walkM texTransformInline <=< walkM texTransformBlock
   where
-    mathTransform' :: Inline -> Compiler Inline
-    mathTransform' (Math mathType tex) = do
-      alignment <- loadSnapshotBody texId "alignment"
+    texTransformInline :: Inline -> Compiler Inline
+    texTransformInline (Math mathType tex) = (\html -> Span ("", [classOf mathType], []) [RawInline "html" html]) <$> texTransform' ("\\(" ++ tex ++ "\\)")
+    texTransformInline (RawInline "latex" tex) = (\html -> Span ("", [], []) [RawInline "html" html]) <$> texTransform' tex
+    texTransformInline x = return x
+    texTransformBlock :: Block -> Compiler Block
+    texTransformBlock (RawBlock "latex" tex) = (\html -> Div ("", [], []) [RawBlock "html" html]) <$> texTransform' tex
+    texTransformBlock x = return x
+    texTransform' :: String -> Compiler String
+    texTransform' tex = do
       let
-        html = printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s\">%s</object>"
+        texId = texTranslation' tex
+      alignment <- loadSnapshotBody texId "alignment"
+      return $ 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
+    classOf DisplayMath = "display-math"
+    classOf InlineMath  = "inline-math"
 
 toFilePath' :: Identifier -> FilePath
 toFilePath' = (providerDirectory config </>) . toFilePath
diff --git a/src/Math.hs b/src/Tex.hs
index db01f75..a247218 100644
--- a/src/Math.hs
+++ b/src/Tex.hs
@@ -1,5 +1,5 @@
-module Math
-       ( compileMath
+module Tex
+       ( compileTex
        ) where
 
 import System.IO (stdout, stderr, hPutStrLn, writeFile, readFile)
@@ -27,22 +27,21 @@ instance Monoid ExitCode where
   ExitSuccess `mappend` ExitSuccess = ExitSuccess
   
 
-compileMath :: String -> IO (String, String)
-compileMath = withSystemTempDirectory "math" . compileMath'
+compileTex :: String -> IO (String, String)
+compileTex = withSystemTempDirectory "tex" . compileTex'
 
-compileMath' :: String -> FilePath -> IO (String, String)
-compileMath' input tmpDir = do
-  mapM_ (copyToTmp . ("tex" </>)) [ "preamble.tex"
-                                  , "preview.dtx"
-                                  , "preview.ins"
-                                  ]
+compileTex' :: String -> FilePath -> IO (String, String)
+compileTex' input tmpDir = do
+  mapM_ (copyToTmp . ("provider/tex" </>)) [ "preview.dtx"
+                                           , "preview.ins"
+                                           ]
   (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 "latex" [ {- "-interaction=batchmode"
+                , -} "image.tex"
                 ] ""
     run "dvisvgm" [ "--exact"
                   , "--no-fonts"