Started work on math compilation

2 files changed, 53 insertions, 2 deletions

diff --git a/src/Math.hs b/src/Math.hs
new file mode 100644
index 0000000..e927fdd
--- /dev/null
+++ b/src/Math.hs
@@ -0,0 +1,46 @@
+module Math
+       ( compileMath
+       ) where
+
+import System.IO.Temp (withSystemTempDirectory)
+import System.Process (callProcess)
+import System.Directory (copyFile, getCurrentDirectory, setCurrentDirectory)
+import System.FilePath (takeFileName, FilePath(..), (</>))
+
+import Control.Monad
+import Control.Exception (bracket)
+
+import Control.DeepSeq (($!!))
+
+compileMath :: String -> IO String
+compileMath = withSystemTempDirectory "math" . compileMath'
+
+compileMath' :: String -> FilePath -> IO 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")
+  where
+    copyToTmp fp = copyFile fp (tmpDir </> takeFileName fp)
+
+withCurrentDirectory :: FilePath  -- ^ Directory to execute in
+                     -> IO a      -- ^ Action to be executed
+                     -> IO a
+withCurrentDirectory dir action =
+  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
+    setCurrentDirectory dir
+    action
diff --git a/src/Site.hs b/src/Site.hs
index 1bda7ec..e821322 100644
--- a/src/Site.hs
+++ b/src/Site.hs
@@ -20,9 +20,12 @@ import Control.Applicative (Alternative(..), Applicative(..))
 import qualified Crypto.Hash.SHA256 as SHA256 (hash)
 import qualified Data.ByteString.Char8 as CBS
 import Data.Hex
+import Data.Char (toLower)
 
 import System.FilePath (takeBaseName, (</>), (<.>))
 
+import Math (compileMath)
+
 main :: IO ()
 main = hakyllWith config $ do
   match "templates/*" $ compile templateCompiler
@@ -45,7 +48,9 @@ main = hakyllWith config $ do
     create [mathTranslation' mathStr] $ do
       route idRoute
       compile $ do
-        makeItem $ mathStr
+        makeItem mathStr
+          >>= loadAndApplyTemplate "templates/math.tex" defaultContext
+          >>= withItemBody (unsafeCompiler . compileMath)
 
   tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*"
 
@@ -139,7 +144,7 @@ tagTranslation = mapMaybe charTrans
       | otherwise = Nothing
 
 mathTranslation' :: String -> Identifier
-mathTranslation' = fromCapture "math/*.svg" . CBS.unpack . hex . SHA256.hash . CBS.pack
+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