From 71950e5bd5f647f5edb6a214d04e020abf406b4f Mon Sep 17 00:00:00 2001 From: Roki Date: Wed, 11 Sep 2024 10:39:51 +0900 Subject: [PATCH] add centering to mermaid svg --- src/Media/SVG.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/Media/SVG.hs b/src/Media/SVG.hs index 139df148..735e41f8 100644 --- a/src/Media/SVG.hs +++ b/src/Media/SVG.hs @@ -13,7 +13,10 @@ import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Maybe (hoistMaybe, runMaybeT) import Data.Functor ((<&>)) import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Hakyll +import Lucid.Base (HtmlT, renderText, toHtmlRaw) +import Lucid.Html5 import System.Exit (ExitCode (..)) import System.Process (proc, readCreateProcessWithExitCode) import Text.Pandoc (Block (..), Format (..), @@ -24,10 +27,10 @@ optimizeSVGCompiler :: [String] -> Compiler (Item String) optimizeSVGCompiler opts = getResourceString >>= withItemBody (unixFilter "npx" $ ["svgo", "-i", "-", "-o", "-"] ++ opts) -execMmdc :: (MonadIO m, MonadThrow m) => T.Text -> m String +execMmdc :: (MonadIO m, Monad n, MonadThrow m) => T.Text -> m (HtmlT n ()) execMmdc = liftIO . readCreateProcessWithExitCode (proc "npx" args) . T.unpack >=> \case (ExitFailure _, _, err) -> throwString err - (ExitSuccess, out, _) -> pure out + (ExitSuccess, out, _) -> pure $ toHtmlRaw $ T.pack out where args = ["mmdc", "-i", "/dev/stdin", "-e", "svg", "-o", "-"] @@ -38,8 +41,10 @@ mermaidCodeBlock cb@(CodeBlock (_, _, t) contents) = maybe cb id <$> mermaidCodeBlock' = ifM ((/="mermaid") . T.toLower <$> hoistMaybe (lookup "lang" $ map (first $ T.unpack . T.toLower) t)) mzero $ - lift $ unsafeCompiler (execMmdc contents) - <&> Plain . (:[]) . RawInline (Format "html") . T.pack + lift $ unsafeCompiler (execMmdc contents) + <&> Plain . (:[]) . RawInline (Format "html") + . TL.toStrict . renderText + . div_ [class_ "has-text-centered"] mermaidCodeBlock x = pure x -- | When a code block starts in @```{lang=mermaid}@,