Minor code cleanup

4 files changed, 41 insertions, 27 deletions

diff --git a/default.nix b/default.nix
index 8d04076..d9d3c52 100644
--- a/default.nix
+++ b/default.nix
@@ -5,13 +5,13 @@ rec {
   dirty-haskell = pkgs.stdenv.lib.overrideDerivation (pkgs.haskellPackages.callPackage ./blog.nix {})
     (attrs :
       { src = ./.;
-              shellHook = ''
-                export PROMPT_INFO=${attrs.name}
-              '';
-            }
+        shellHook = ''
+          export PROMPT_INFO=${attrs.name}
+        '';
+      }
     );
   texEnv = with pkgs; texlive.combine {
-    inherit (texlive) scheme-small standalone dvisvgm amsmath tikz-cd;
+    inherit (texlive) scheme-small standalone dvisvgm amsmath tikz-cd rsfs;
   };
   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 \
-        --suffix PATH : ${texEnv}/bin
+        --prefix PATH : ${texEnv}/bin
     '';
   };
 }
diff --git a/shell.nix b/shell.nix
index 9e363eb..88f254c 100644
--- a/shell.nix
+++ b/shell.nix
@@ -4,7 +4,7 @@
 pkgs.stdenv.mkDerivation rec {
   name = "dirty-haskell";
   buildInputs = with (import ./default.nix {}); [ dirty-haskell-wrapper
-                                                  (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ]))
+                                                  # (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ]))
                                                 ];
   shellHook = ''
     export PROMPT_INFO=${name}
diff --git a/src/Site.hs b/src/Site.hs
index 9b08316..6aa50c9 100644
--- a/src/Site.hs
+++ b/src/Site.hs
@@ -5,7 +5,7 @@ import Hakyll
 import Data.Monoid (Monoid(..), mconcat, (<>))
 import Control.Monad (liftM, forM_, (<=<))
 import Data.Char (toLower, isSpace, isAlphaNum)
-import Data.Maybe (mapMaybe, fromMaybe, listToMaybe)
+import Data.Maybe (mapMaybe, fromMaybe, listToMaybe, catMaybes)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -19,9 +19,12 @@ import Control.Applicative (Alternative(..), Applicative(..))
 import           Text.Blaze.Html                 (toHtml, toValue, (!))
 import qualified Text.Blaze.Html5                as H
 import qualified Text.Blaze.Html5.Attributes     as A
+import           Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Read (readMaybe)
 
-import System.FilePath (takeBaseName, (</>), (<.>))
+import System.FilePath (takeBaseName, (</>), (<.>), (-<.>))
+
+import System.Process.ByteString (readProcessWithExitCode)
 
 import qualified Crypto.Hash.SHA256 as SHA256 (hash)
 import qualified Data.ByteString.Char8 as CBS
@@ -43,13 +46,18 @@ main = hakyllWith config $ do
 
   tex <- getTex "posts/**" texTranslation'
   forM_ tex $ \(_, texStr) -> create [texTranslation' texStr] $ do
-      route idRoute
-      compile $ do
-        item <- makeItem texStr
-          >>= loadAndApplyTemplate "templates/preview.tex" defaultContext
-          >>= withItemBody (unsafeCompiler . compileTex)
-        saveSnapshot "alignment" $ fmap snd item
-        return $ fmap fst item
+    route idRoute
+    compile $ do
+      item <- makeItem texStr
+              >>= loadAndApplyTemplate "templates/preview.tex" defaultContext
+              >>= withItemBody (unsafeCompiler . compileTex)
+      saveSnapshot "alignment" $ fmap snd item
+      let
+        match = (=~) :: String -> String -> (String, String, String, [String])
+        xs = (\(_, _, _, xs) -> xs) . flip match "height='([-0-9\\.]+)pt' .* width='([-0-9\\.]+)pt'" . fst <$> item
+      saveSnapshot "height" $ (!! 0) <$> xs
+      saveSnapshot "width"  $ (!! 1) <$> xs
+      return $ fmap fst item
 
   tags <- buildTags "posts/**" tagTranslation' >>= addTag "All Posts" "posts/**"
 
@@ -227,18 +235,24 @@ texTransform = walkM texTransformInline <=< walkM texTransformBlock
     texTransform' texT tex = do
       let
         texId = texTranslation' $ texT tex
-      alignment <- loadSnapshotBody texId "alignment"
-      content <- loadBody texId
-      let
+        svgPath = toUrl $ toFilePath texId
         latexFontSize :: Double
         latexFontSize = 12 / 1.25
-        match = (=~) :: String -> String -> (String, String, String, [String])
-        size = case match content "height='([-0-9\\.]+)pt' .* width='([-0-9\\.]+)pt'" of
-          (_, _, _, xs@[_, _]) -> (\[y, x] -> (x / latexFontSize, y / latexFontSize)) <$> mapM (readMaybe :: String -> Maybe Double) xs
-          _ -> Nothing
-        size' = maybe "" (\(a, b) -> printf " width:%.2fem; height:%.2fem;" a b) size
-      return $ printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s;%s\">%s</object>"
-               (toFilePath texId) (alignment :: String) (size' :: String) tex
+        size :: String -> Maybe Double
+        size = fmap (/ latexFontSize) . (readMaybe :: String -> Maybe Double)
+      alignment <- size <$> (loadSnapshotBody texId "alignment" :: Compiler String)
+      width <- size <$> (loadSnapshotBody texId "width" :: Compiler String)
+      height <- size <$> (loadSnapshotBody texId "height" :: Compiler String)
+      let
+        style :: [Maybe String]
+        style = [ printf "vertical-align:-%.2fem;" <$> alignment
+                , printf "width:%.2fem;" <$> width
+                , printf "height:%.2fem;" <$> height
+                ]
+      return . renderHtml $ H.img
+          ! A.src (toValue svgPath)
+          ! A.alt (toValue tex)
+          ! A.style (toValue . concat $ catMaybes style)
     classOf DisplayMath = "display-math"
     classOf InlineMath  = "inline-math"
 
diff --git a/src/Tex.hs b/src/Tex.hs
index 5d347b9..264c1c1 100644
--- a/src/Tex.hs
+++ b/src/Tex.hs
@@ -70,7 +70,7 @@ withCurrentDirectory dir action =
     action
 
 extractAlignment :: String -> String
-extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)")
+extractAlignment = fromMaybe "0" . extract . (=~ "depth=([^\\s]+)pt")
   where
     extract :: (String, String, String, [String]) -> Maybe String
     extract (_, _, _, xs) = listToMaybe xs