diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-12 16:06:32 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-02-12 16:06:32 +0100 |
commit | f832f6431aa0e9c96f9a72316be794a5503beecb (patch) | |
tree | 099891f387ab64397b6cb6861e6fc707657f686d | |
parent | 36244ed4d5d16aecf7c10f01c4fb1aa0323f909d (diff) | |
download | dirty-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.nix | 12 | ||||
-rw-r--r-- | shell.nix | 2 | ||||
-rw-r--r-- | src/Site.hs | 52 | ||||
-rw-r--r-- | 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 { | |||
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 | } |
@@ -4,7 +4,7 @@ | |||
4 | pkgs.stdenv.mkDerivation rec { | 4 | pkgs.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 | |||
5 | import Data.Monoid (Monoid(..), mconcat, (<>)) | 5 | import Data.Monoid (Monoid(..), mconcat, (<>)) |
6 | import Control.Monad (liftM, forM_, (<=<)) | 6 | import Control.Monad (liftM, forM_, (<=<)) |
7 | import Data.Char (toLower, isSpace, isAlphaNum) | 7 | import Data.Char (toLower, isSpace, isAlphaNum) |
8 | import Data.Maybe (mapMaybe, fromMaybe, listToMaybe) | 8 | import Data.Maybe (mapMaybe, fromMaybe, listToMaybe, catMaybes) |
9 | import Data.Map (Map) | 9 | import Data.Map (Map) |
10 | import qualified Data.Map as Map | 10 | import qualified Data.Map as Map |
11 | import qualified Data.Set as Set | 11 | import qualified Data.Set as Set |
@@ -19,9 +19,12 @@ import Control.Applicative (Alternative(..), Applicative(..)) | |||
19 | import Text.Blaze.Html (toHtml, toValue, (!)) | 19 | import Text.Blaze.Html (toHtml, toValue, (!)) |
20 | import qualified Text.Blaze.Html5 as H | 20 | import qualified Text.Blaze.Html5 as H |
21 | import qualified Text.Blaze.Html5.Attributes as A | 21 | import qualified Text.Blaze.Html5.Attributes as A |
22 | import Text.Blaze.Html.Renderer.String (renderHtml) | ||
22 | import Text.Read (readMaybe) | 23 | import Text.Read (readMaybe) |
23 | 24 | ||
24 | import System.FilePath (takeBaseName, (</>), (<.>)) | 25 | import System.FilePath (takeBaseName, (</>), (<.>), (-<.>)) |
26 | |||
27 | import System.Process.ByteString (readProcessWithExitCode) | ||
25 | 28 | ||
26 | import qualified Crypto.Hash.SHA256 as SHA256 (hash) | 29 | import qualified Crypto.Hash.SHA256 as SHA256 (hash) |
27 | import qualified Data.ByteString.Char8 as CBS | 30 | import 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 | ||
@@ -70,7 +70,7 @@ withCurrentDirectory dir action = | |||
70 | action | 70 | action |
71 | 71 | ||
72 | extractAlignment :: String -> String | 72 | extractAlignment :: String -> String |
73 | extractAlignment = fromMaybe "0pt" . extract . (=~ "depth=([^\\s]+)") | 73 | extractAlignment = 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 |