From f832f6431aa0e9c96f9a72316be794a5503beecb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 12 Feb 2016 16:06:32 +0100 Subject: Minor code cleanup --- default.nix | 12 ++++++------ shell.nix | 2 +- src/Site.hs | 52 +++++++++++++++++++++++++++++++++------------------- src/Tex.hs | 2 +- 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 "%s" - (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 -- cgit v1.2.3