BlogLiterately-diagrams 0.2.0.6 → 0.2.1
raw patch · 3 files changed
+57/−26 lines, 3 filesdep +splitdep ~JuicyPixelsdep ~basedep ~pandocPVP ok
version bump matches the API change (PVP)
Dependencies added: split
Dependency ranges changed: JuicyPixels, base, pandoc
API changes (from Hackage documentation)
Files
- BlogLiterately-diagrams.cabal +9/−6
- CHANGES +6/−0
- src/Text/BlogLiterately/Diagrams.hs +42/−20
BlogLiterately-diagrams.cabal view
@@ -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@ (<http://hackage.haskell.org/package/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
CHANGES view
@@ -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`
src/Text/BlogLiterately/Diagrams.hs view
@@ -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