1 files changed, 35 insertions, 18 deletions

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 "<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
+
 toFilePath' :: Identifier -> FilePath
 toFilePath' = (providerDirectory config </>) . toFilePath