BlogLiterately-diagrams 0.2.1 → 0.3
raw patch · 3 files changed
+40/−27 lines, 3 filesdep +textdep ~BlogLiteratelydep ~basedep ~pandocPVP ok
version bump matches the API change (PVP)
Dependencies added: text
Dependency ranges changed: BlogLiterately, base, pandoc
API changes (from Hackage documentation)
Files
- BlogLiterately-diagrams.cabal +8/−8
- CHANGES +6/−0
- src/Text/BlogLiterately/Diagrams.hs +26/−19
BlogLiterately-diagrams.cabal view
@@ -1,5 +1,5 @@ name: BlogLiterately-diagrams-version: 0.2.1+version: 0.3 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.@@ -63,12 +63,11 @@ author: Brent Yorgey maintainer: byorgey@gmail.com bug-reports: http://github.com/byorgey/BlogLiterately-diagrams/issues-copyright: Copyright 2012-2015 Brent Yorgey+copyright: Copyright 2012-2022 Brent Yorgey category: Web build-type: Simple cabal-version: 1.18-tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3-+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.1 source-repository head type: git@@ -77,7 +76,7 @@ library default-language: Haskell2010 exposed-modules: Text.BlogLiterately.Diagrams- build-depends: base >= 4.3 && < 4.13,+ build-depends: base >= 4.3 && < 4.17, containers, filepath, directory,@@ -85,10 +84,11 @@ diagrams-rasterific >= 1.3 && < 1.5, JuicyPixels >= 3.2 && < 3.4, diagrams-builder >= 0.5 && < 0.9,- BlogLiterately >= 0.6 && < 0.9,- pandoc >= 1.16 && < 2.8,+ BlogLiterately >= 0.8.7 && < 0.9,+ pandoc >= 2.8 && < 2.19, safe ==0.3.*,- split >= 0.2 && < 0.3+ split >= 0.2 && < 0.3,+ text >= 1.2 && < 2.1 hs-source-dirs: src executable BlogLiteratelyD
CHANGES view
@@ -1,3 +1,9 @@+* 0.3 (24 May 2022)++ - allow `base-4.16`+ - Update to work with `pandoc` versions 2.8 through 2.18+ - Update to work with latest `BlogLiterately`+ * 0.2.1 (5 March 2019) - allow `base-4.12`, `pandoc-2.7`, `JuicyPixels-3.3`
src/Text/BlogLiterately/Diagrams.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+ ----------------------------------------------------------------------------- -- | -- Module : Text.BlogLiterately.Diagrams@@ -29,6 +32,10 @@ import Data.List (find, isPrefixOf) import Data.List.Split (splitOn) import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+ import Diagrams.Backend.Rasterific import qualified Diagrams.Builder as DB import Diagrams.Prelude (SizeSpec, V2, centerXY, pad, zero,@@ -93,7 +100,7 @@ where defs = queryWith extractDiaDef p -extractDiaDef :: Block -> [String]+extractDiaDef :: Block -> [Text] extractDiaDef (CodeBlock (_, as, _) s) = [src | "dia-def" `elem` (maybe id (:) tag) as] where@@ -105,18 +112,18 @@ -- 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+ -> [Text] -- ^ Declarations+ -> Text -- ^ Expression to render -> SizeSpec V2 Double -- ^ Requested size -> Maybe FilePath -- ^ Directory to save in ("diagrams" if unspecified)- -> IO (Either String FilePath)+ -> IO (Either Text FilePath) renderDiagram shouldPad decls expr sz mdir = do createDirectoryIfMissing True diaDir let bopts = DB.mkBuildOpts Rasterific zero (RasterificOptions sz)- & DB.snippets .~ decls+ & DB.snippets .~ map T.unpack decls & DB.imports .~ ["Diagrams.Backend.Rasterific"]- & DB.diaExpr .~ expr+ & DB.diaExpr .~ T.unpack expr & DB.postProcess .~ (if shouldPad then pad 1.1 . centerXY else id) & DB.decideRegen .~ (DB.hashedRegenerate@@ -128,11 +135,11 @@ case res of DB.ParseErr err -> do- let errStr = "\nParse error:\n" ++ err+ let errStr = T.append "\nParse error:\n" (T.pack err) putErrLn errStr return (Left errStr) DB.InterpErr ierr -> do- let errStr = "\nInterpreter error:\n" ++ DB.ppInterpError ierr+ let errStr = T.append "\nInterpreter error:\n" (T.pack (DB.ppInterpError ierr)) putErrLn errStr return (Left errStr) DB.Skipped hash -> return (Right $ mkFile (DB.hashToHexStr hash))@@ -145,20 +152,20 @@ diaDir = fromMaybe "diagrams" mdir mkFile base = diaDir </> base <.> "png" -renderBlockDiagram :: Maybe FilePath -> Maybe (SizeSpec V2 Double) -> [String] -> Block -> IO Block+renderBlockDiagram :: Maybe FilePath -> Maybe (SizeSpec V2 Double) -> [Text] -> 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" (attrToSize fields) Nothing case res of- Left err -> return (CodeBlock attr (s ++ err))+ Left err -> return (CodeBlock attr (T.append s err)) 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, "")]+ return $ Para [Image nullAttr [] (T.pack fileName, "")] | otherwise = return c @@ -169,23 +176,23 @@ renderBlockDiagram _ _ _ b = return b -renderInlineDiagram :: [String] -> Inline -> IO Inline+renderInlineDiagram :: [Text] -> Inline -> IO Inline renderInlineDiagram defs c@(Code attr@(_, cls, fields) expr) | "dia" `elem` cls = do res <- renderDiagram False defs expr (attrToSize fields) Nothing case res of- Left err -> return (Code attr (expr ++ err))- Right fileName -> return $ Image nullAttr [] (fileName, "")+ Left err -> return (Code attr (T.append expr err))+ Right fileName -> return $ Image nullAttr [] (T.pack fileName, "") | otherwise = return c renderInlineDiagram _ i = return i -attrToSize :: [(String, String)] -> SizeSpec V2 Double+attrToSize :: [(Text, Text)] -> SizeSpec V2 Double attrToSize fields = mkSizeSpec2D- (lookup "width" fields >>= readMay)- (lookup "height" fields >>= readMay)+ (lookup "width" fields >>= (readMay . T.unpack))+ (lookup "height" fields >>= (readMay . T.unpack)) -putErrLn :: String -> IO ()-putErrLn = hPutStrLn stderr+putErrLn :: Text -> IO ()+putErrLn = T.hPutStrLn stderr