summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-02-12 16:06:32 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-02-12 16:06:32 +0100
commitf832f6431aa0e9c96f9a72316be794a5503beecb (patch)
tree099891f387ab64397b6cb6861e6fc707657f686d
parent36244ed4d5d16aecf7c10f01c4fb1aa0323f909d (diff)
downloaddirty-haskell.org-f832f6431aa0e9c96f9a72316be794a5503beecb.tar
dirty-haskell.org-f832f6431aa0e9c96f9a72316be794a5503beecb.tar.gz
dirty-haskell.org-f832f6431aa0e9c96f9a72316be794a5503beecb.tar.bz2
dirty-haskell.org-f832f6431aa0e9c96f9a72316be794a5503beecb.tar.xz
dirty-haskell.org-f832f6431aa0e9c96f9a72316be794a5503beecb.zip
Minor code cleanup
-rw-r--r--default.nix12
-rw-r--r--shell.nix2
-rw-r--r--src/Site.hs52
-rw-r--r--src/Tex.hs2
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 {
5 dirty-haskell = pkgs.stdenv.lib.overrideDerivation (pkgs.haskellPackages.callPackage ./blog.nix {}) 5 dirty-haskell = pkgs.stdenv.lib.overrideDerivation (pkgs.haskellPackages.callPackage ./blog.nix {})
6 (attrs : 6 (attrs :
7 { src = ./.; 7 { src = ./.;
8 shellHook = '' 8 shellHook = ''
9 export PROMPT_INFO=${attrs.name} 9 export PROMPT_INFO=${attrs.name}
10 ''; 10 '';
11 } 11 }
12 ); 12 );
13 texEnv = with pkgs; texlive.combine { 13 texEnv = with pkgs; texlive.combine {
14 inherit (texlive) scheme-small standalone dvisvgm amsmath tikz-cd; 14 inherit (texlive) scheme-small standalone dvisvgm amsmath tikz-cd rsfs;
15 }; 15 };
16 dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec { 16 dirty-haskell-wrapper = pkgs.stdenv.mkDerivation rec {
17 name = "dirty-haskell-wrapper"; 17 name = "dirty-haskell-wrapper";
@@ -19,7 +19,7 @@ rec {
19 buildCommand = '' 19 buildCommand = ''
20 mkdir -p $out/bin 20 mkdir -p $out/bin
21 makeWrapper ${dirty-haskell}/bin/site $out/bin/dirty-haskell \ 21 makeWrapper ${dirty-haskell}/bin/site $out/bin/dirty-haskell \
22 --suffix PATH : ${texEnv}/bin 22 --prefix PATH : ${texEnv}/bin
23 ''; 23 '';
24 }; 24 };
25} 25}
diff --git a/shell.nix b/shell.nix
index 9e363eb..88f254c 100644
--- a/shell.nix
+++ b/shell.nix
@@ -4,7 +4,7 @@
4pkgs.stdenv.mkDerivation rec { 4pkgs.stdenv.mkDerivation rec {
5 name = "dirty-haskell"; 5 name = "dirty-haskell";
6 buildInputs = with (import ./default.nix {}); [ dirty-haskell-wrapper 6 buildInputs = with (import ./default.nix {}); [ dirty-haskell-wrapper
7 (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ])) 7 # (pkgs.haskellPackages.ghcWithPackages (p: with p; [ regex-tdfa ]))
8 ]; 8 ];
9 shellHook = '' 9 shellHook = ''
10 export PROMPT_INFO=${name} 10 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
5import Data.Monoid (Monoid(..), mconcat, (<>)) 5import Data.Monoid (Monoid(..), mconcat, (<>))
6import Control.Monad (liftM, forM_, (<=<)) 6import Control.Monad (liftM, forM_, (<=<))
7import Data.Char (toLower, isSpace, isAlphaNum) 7import Data.Char (toLower, isSpace, isAlphaNum)
8import Data.Maybe (mapMaybe, fromMaybe, listToMaybe) 8import Data.Maybe (mapMaybe, fromMaybe, listToMaybe, catMaybes)
9import Data.Map (Map) 9import Data.Map (Map)
10import qualified Data.Map as Map 10import qualified Data.Map as Map
11import qualified Data.Set as Set 11import qualified Data.Set as Set
@@ -19,9 +19,12 @@ import Control.Applicative (Alternative(..), Applicative(..))
19import Text.Blaze.Html (toHtml, toValue, (!)) 19import Text.Blaze.Html (toHtml, toValue, (!))
20import qualified Text.Blaze.Html5 as H 20import qualified Text.Blaze.Html5 as H
21import qualified Text.Blaze.Html5.Attributes as A 21import qualified Text.Blaze.Html5.Attributes as A
22import Text.Blaze.Html.Renderer.String (renderHtml)
22import Text.Read (readMaybe) 23import Text.Read (readMaybe)
23 24
24import System.FilePath (takeBaseName, (</>), (<.>)) 25import System.FilePath (takeBaseName, (</>), (<.>), (-<.>))
26
27import System.Process.ByteString (readProcessWithExitCode)
25 28
26import qualified Crypto.Hash.SHA256 as SHA256 (hash) 29import qualified Crypto.Hash.SHA256 as SHA256 (hash)
27import qualified Data.ByteString.Char8 as CBS 30import qualified Data.ByteString.Char8 as CBS
@@ -43,13 +46,18 @@ main = hakyllWith config $ do
43 46
44 tex <- getTex "posts/**" texTranslation' 47 tex <- getTex "posts/**" texTranslation'
45 forM_ tex $ \(_, texStr) -> create [texTranslation' texStr] $ do 48 forM_ tex $ \(_, texStr) -> create [texTranslation' texStr] $ do
46 route idRoute 49 route idRoute
47 compile $ do 50 compile $ do
48 item <- makeItem texStr 51 item <- makeItem texStr
49 >>= loadAndApplyTemplate "templates/preview.tex" defaultContext 52 >>= loadAndApplyTemplate "templates/preview.tex" defaultContext
50 >>= withItemBody (unsafeCompiler . compileTex) 53 >>= withItemBody (unsafeCompiler . compileTex)
51 saveSnapshot "alignment" $ fmap snd item 54 saveSnapshot "alignment" $ fmap snd item
52 return $ fmap fst item 55 let
56 match = (=~) :: String -> String -> (String, String, String, [String])
57 xs = (\(_, _, _, xs) -> xs) . flip match "height='([-0-9\\.]+)pt' .* width='([-0-9\\.]+)pt'" . fst <$> item
58 saveSnapshot "height" $ (!! 0) <$> xs
59 saveSnapshot "width" $ (!! 1) <$> xs
60 return $ fmap fst item
53 61
54 tags <- buildTags "posts/**" tagTranslation' >>= addTag "All Posts" "posts/**" 62 tags <- buildTags "posts/**" tagTranslation' >>= addTag "All Posts" "posts/**"
55 63
@@ -227,18 +235,24 @@ texTransform = walkM texTransformInline <=< walkM texTransformBlock
227 texTransform' texT tex = do 235 texTransform' texT tex = do
228 let 236 let
229 texId = texTranslation' $ texT tex 237 texId = texTranslation' $ texT tex
230 alignment <- loadSnapshotBody texId "alignment" 238 svgPath = toUrl $ toFilePath texId
231 content <- loadBody texId
232 let
233 latexFontSize :: Double 239 latexFontSize :: Double
234 latexFontSize = 12 / 1.25 240 latexFontSize = 12 / 1.25
235 match = (=~) :: String -> String -> (String, String, String, [String]) 241 size :: String -> Maybe Double
236 size = case match content "height='([-0-9\\.]+)pt' .* width='([-0-9\\.]+)pt'" of 242 size = fmap (/ latexFontSize) . (readMaybe :: String -> Maybe Double)
237 (_, _, _, xs@[_, _]) -> (\[y, x] -> (x / latexFontSize, y / latexFontSize)) <$> mapM (readMaybe :: String -> Maybe Double) xs 243 alignment <- size <$> (loadSnapshotBody texId "alignment" :: Compiler String)
238 _ -> Nothing 244 width <- size <$> (loadSnapshotBody texId "width" :: Compiler String)
239 size' = maybe "" (\(a, b) -> printf " width:%.2fem; height:%.2fem;" a b) size 245 height <- size <$> (loadSnapshotBody texId "height" :: Compiler String)
240 return $ printf "<object data=\"/%s\" type=\"image/svg+xml\" style=\"vertical-align:-%s;%s\">%s</object>" 246 let
241 (toFilePath texId) (alignment :: String) (size' :: String) tex 247 style :: [Maybe String]
248 style = [ printf "vertical-align:-%.2fem;" <$> alignment
249 , printf "width:%.2fem;" <$> width
250 , printf "height:%.2fem;" <$> height
251 ]
252 return . renderHtml $ H.img
253 ! A.src (toValue svgPath)
254 ! A.alt (toValue tex)
255 ! A.style (toValue . concat $ catMaybes style)
242 classOf DisplayMath = "display-math" 256 classOf DisplayMath = "display-math"
243 classOf InlineMath = "inline-math" 257 classOf InlineMath = "inline-math"
244 258
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 =
70 action 70 action
71 71
72extractAlignment :: String -> String 72extractAlignment :: String -> String
73extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") 73extractAlignment = fromMaybe "0" . extract . (=~ "depth=([^\\s]+)pt")
74 where 74 where
75 extract :: (String, String, String, [String]) -> Maybe String 75 extract :: (String, String, String, [String]) -> Maybe String
76 extract (_, _, _, xs) = listToMaybe xs 76 extract (_, _, _, xs) = listToMaybe xs