summaryrefslogtreecommitdiff
path: root/src/Site.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Site.hs')
-rw-r--r--src/Site.hs52
1 files changed, 33 insertions, 19 deletions
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