diff --git a/BlogLiterately-diagrams.cabal b/BlogLiterately-diagrams.cabal --- a/BlogLiterately-diagrams.cabal +++ b/BlogLiterately-diagrams.cabal @@ -1,5 +1,5 @@ name: BlogLiterately-diagrams -version: 0.2.0.6 +version: 0.2.1 synopsis: Include images in blog posts with inline diagrams code description: A plugin for @BlogLiterately@ () which turns inline diagrams code into images. @@ -66,8 +66,10 @@ copyright: Copyright 2012-2015 Brent Yorgey category: Web build-type: Simple -cabal-version: >=1.10 +cabal-version: 1.18 +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + source-repository head type: git location: git://github.com/byorgey/BlogLiterately-diagrams.git @@ -75,17 +77,18 @@ library default-language: Haskell2010 exposed-modules: Text.BlogLiterately.Diagrams - build-depends: base >= 4.3 && < 4.11, + build-depends: base >= 4.3 && < 4.13, containers, filepath, directory, diagrams-lib >= 1.3 && < 1.5, diagrams-rasterific >= 1.3 && < 1.5, - JuicyPixels >= 3.2 && < 3.3, + JuicyPixels >= 3.2 && < 3.4, diagrams-builder >= 0.5 && < 0.9, BlogLiterately >= 0.6 && < 0.9, - pandoc >= 1.16 && < 2.2, - safe ==0.3.* + pandoc >= 1.16 && < 2.8, + safe ==0.3.*, + split >= 0.2 && < 0.3 hs-source-dirs: src executable BlogLiteratelyD diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,9 @@ +* 0.2.1 (5 March 2019) + + - allow `base-4.12`, `pandoc-2.7`, `JuicyPixels-3.3` + - Add extra options to allow specifying size and destination for + generated images + * 0.2.0.6 (18 February 2018) - allow `base-4.10` diff --git a/src/Text/BlogLiterately/Diagrams.hs b/src/Text/BlogLiterately/Diagrams.hs --- a/src/Text/BlogLiterately/Diagrams.hs +++ b/src/Text/BlogLiterately/Diagrams.hs @@ -26,6 +26,9 @@ import System.IO (hPutStrLn, stderr) import qualified Codec.Picture as J +import Data.List (find, isPrefixOf) +import Data.List.Split (splitOn) +import Data.Maybe (fromMaybe) import Diagrams.Backend.Rasterific import qualified Diagrams.Builder as DB import Diagrams.Prelude (SizeSpec, V2, centerXY, pad, zero, @@ -57,10 +60,20 @@ diagramsXF = ioTransform renderBlockDiagrams (const True) renderBlockDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc -renderBlockDiagrams _ p = bottomUpM (renderBlockDiagram defs) p +renderBlockDiagrams blOpts p = bottomUpM (renderBlockDiagram imgDir imgSize defs) p where defs = queryWith extractDiaDef p + imgDir :: Maybe FilePath + imgDir = field "imgdir" + imgSize :: Maybe (SizeSpec V2 Double) + imgSize = field "imgsize" >>= \s -> + case splitOn "x" s of + [w,h] -> Just $ mkSizeSpec2D (readMay w) (readMay h) + _ -> Nothing + + field f = drop (length f + 1) <$> find ((f++":") `isPrefixOf`) (_xtra blOpts) + -- | Transform a blog post by looking for /inline/ code snippets with -- class @dia@, and replacing them with images generated by -- evaluating the contents of each code snippet as a Haskell @@ -88,18 +101,16 @@ extractDiaDef _ = [] -diaDir :: FilePath -diaDir = "diagrams" -- XXX make this configurable - -- | Given some code with declarations, some attributes, and an -- expression to render, render it and return the filename of the -- generated image (or an error message). -renderDiagram :: Bool -- ^ Apply padding automatically? - -> [String] -- ^ Declarations - -> String -- ^ Expression to render - -> Attr -- ^ Code attributes +renderDiagram :: Bool -- ^ Apply padding automatically? + -> [String] -- ^ Declarations + -> String -- ^ Expression to render + -> SizeSpec V2 Double -- ^ Requested size + -> Maybe FilePath -- ^ Directory to save in ("diagrams" if unspecified) -> IO (Either String FilePath) -renderDiagram shouldPad decls expr (_ident, _cls, fields) = do +renderDiagram shouldPad decls expr sz mdir = do createDirectoryIfMissing True diaDir let bopts = DB.mkBuildOpts Rasterific zero (RasterificOptions sz) @@ -131,20 +142,23 @@ return (Right imgFile) where - sz :: SizeSpec V2 Double - sz = mkSizeSpec2D - (lookup "width" fields >>= readMay) - (lookup "height" fields >>= readMay) + diaDir = fromMaybe "diagrams" mdir mkFile base = diaDir base <.> "png" -renderBlockDiagram :: [String] -> Block -> IO Block -renderBlockDiagram defs c@(CodeBlock attr@(_, cls, _) s) +renderBlockDiagram :: Maybe FilePath -> Maybe (SizeSpec V2 Double) -> [String] -> Block -> IO Block +renderBlockDiagram ximgDir ximgSize defs c@(CodeBlock attr@(_, cls, fields) s) | "dia-def" `elem` classTags = return Null | "dia" `elem` classTags = do - res <- renderDiagram True (src : defs) "dia" attr + res <- renderDiagram True (src : defs) "dia" (attrToSize fields) Nothing case res of Left err -> return (CodeBlock attr (s ++ err)) - Right fileName -> return $ Para [Image nullAttr [] (fileName, "")] + Right fileName -> do + case (ximgDir, ximgSize) of + (Just _, Just sz) -> do + _ <- renderDiagram True (src : defs) "dia" sz ximgDir + return () + _ -> return () + return $ Para [Image nullAttr [] (fileName, "")] | otherwise = return c @@ -152,18 +166,26 @@ (tag, src) = unTag s classTags = (maybe id (:) tag) cls -renderBlockDiagram _ b = return b +renderBlockDiagram _ _ _ b = return b + renderInlineDiagram :: [String] -> Inline -> IO Inline -renderInlineDiagram defs c@(Code attr@(_, cls, _) expr) +renderInlineDiagram defs c@(Code attr@(_, cls, fields) expr) | "dia" `elem` cls = do - res <- renderDiagram False defs expr attr + res <- renderDiagram False defs expr (attrToSize fields) Nothing case res of Left err -> return (Code attr (expr ++ err)) Right fileName -> return $ Image nullAttr [] (fileName, "") | otherwise = return c renderInlineDiagram _ i = return i + +attrToSize :: [(String, String)] -> SizeSpec V2 Double +attrToSize fields + = mkSizeSpec2D + (lookup "width" fields >>= readMay) + (lookup "height" fields >>= readMay) + putErrLn :: String -> IO () putErrLn = hPutStrLn stderr