From 7bab414905a5ad07876e7601b1a46592a4ca0669 Mon Sep 17 00:00:00 2001 From: Christopher Chalmers Date: Fri, 19 Dec 2014 04:03:20 +0000 Subject: [PATCH 1/5] Make a start on Diagrams.Pandoc module. --- Main.hs | 171 ++++++++++++----------------------------- diagrams-pandoc.cabal | 71 +++++++++++++---- src/Diagrams/Pandoc.hs | 130 +++++++++++++++++++++++++++++++ 3 files changed, 237 insertions(+), 135 deletions(-) create mode 100644 src/Diagrams/Pandoc.hs diff --git a/Main.hs b/Main.hs index 0da12d2..be49ebb 100644 --- a/Main.hs +++ b/Main.hs @@ -1,125 +1,52 @@ -import Control.Applicative -import Control.Monad (when) -import Data.List (delete) -import Diagrams.Backend.Cairo -import Diagrams.Backend.Cairo.Internal -import qualified Diagrams.Builder as DB -import Diagrams.Prelude (centerXY, pad, (&), (.~)) -import Diagrams.Size (dims) -import Linear (V2(..), zero) -import Options.Applicative -import System.Directory (createDirectory, - doesDirectoryExist) -import System.FilePath ((<.>), ()) -import System.IO +-- import Control.Applicative +-- import Control.Monad (when) +-- import Data.List (delete) +-- import Diagrams.Backend.Cairo +-- import Diagrams.Backend.Cairo.Internal +-- import qualified Diagrams.Builder as DB +-- import Diagrams.Prelude (centerXY, pad, (&), (.~)) +-- import Diagrams.Size (dims) +-- import Linear (V2(..), zero) +-- import Options.Applicative +-- import System.Directory (createDirectory, +-- doesDirectoryExist) +-- import System.FilePath ((<.>), ()) +-- import System.IO import Text.Pandoc.JSON - --- TODO choose output format based on pandoc target -backendExt :: String -backendExt = "png" +import Diagrams.Pandoc main :: IO () -main = do - opts <- execParser withHelp - toJSONFilter $ insertDiagrams opts - -insertDiagrams :: Opts -> Block -> IO [Block] -insertDiagrams opts (CodeBlock (ident, classes, attrs) code) - | "diagram-haskell" `elem` classes = (++ [bl']) <$> img - | "diagram" `elem` classes = img - where - img = do - d <- compileDiagram opts code - return $ case d of - Left _err -> [] - Right imgName -> [Plain [Image [] (imgName,"")]] -- no alt text, no title - bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code -insertDiagrams _ block = return [block] - --- Copied from https://github.com/diagrams/diagrams-doc/blob/master/doc/Xml2Html.hs --- With the CPP removed, thereby requiring Cairo --- TODO clean this up, move it into -builder somehow --- | Compile the literate source code of a diagram to a .png file with --- a file name given by a hash of the source code contents -compileDiagram :: Opts -> String -> IO (Either String String) -compileDiagram opts src = do - ensureDir $ _outDir opts - - let - bopts :: DB.BuildOpts Cairo V2 Double - bopts = DB.mkBuildOpts - - Cairo - - zero - - (CairoOptions "default.png" (dims $ V2 500 200) PNG False) - - & DB.snippets .~ [src] - & DB.imports .~ - [ "Diagrams.TwoD.Types" -- WHY IS THIS NECESSARY =( - , "Diagrams.Core.Points" - -- GHC 7.2 bug? need V (Point R2) = R2 (see #65) - , "Diagrams.Backend.Cairo" - , "Diagrams.Backend.Cairo.Internal" - , "Graphics.SVGFonts" - , "Data.Typeable" - ] - & DB.pragmas .~ ["DeriveDataTypeable"] - & DB.diaExpr .~ _expression opts - & DB.postProcess .~ (pad 1.1 . centerXY) - & DB.decideRegen .~ - (DB.hashedRegenerate - (\hash opts' -> opts' { _cairoFileName = mkFile hash }) - (_outDir opts) - ) - - res <- DB.buildDiagram bopts - - case res of - DB.ParseErr err -> do - hPutStrLn stderr ("\nError while parsing\n" ++ src) - hPutStrLn stderr err - return $ Left "Error while parsing" - - DB.InterpErr ierr -> do - hPutStrLn stderr ("\nError while interpreting\n" ++ src) - hPutStrLn stderr (DB.ppInterpError ierr) - return $ Left "Error while interpreting" - - DB.Skipped hash -> do - hPutStr stderr "." - hFlush stderr - return $ Right (mkFile (DB.hashToHexStr hash)) - - DB.OK hash out -> do - hPutStr stderr "O" - hFlush stderr - fst out - return $ Right (mkFile (DB.hashToHexStr hash)) - - where - mkFile base = _outDir opts base <.> backendExt - ensureDir dir = do - b <- doesDirectoryExist dir - when (not b) $ createDirectory dir - -data Opts = Opts { - _outDir :: FilePath, - _expression :: String - } - -optsParser :: Parser Opts -optsParser = Opts - <$> strOption (long "out" <> short 'o' <> metavar "DIR" - <> help "Directory for image files" <> value "images") - <*> strOption (long "expression" <> long "expr" <> short 'e' <> - metavar "NAME" <> - help "name of Diagram value in Haskell snippet" <> - value "example") - -withHelp :: ParserInfo Opts -withHelp = info - (helper <*> optsParser) - (fullDesc <> progDesc "interpret inline Haskell code to images in Pandoc output\nhttps://github.com/bergey/diagrams-pandoc" - <> header "diagrams-pandoc - a Pandoc filter for inline Diagrams") +main = toJSONFilter addDiagrams + +-- insertDiagrams :: Opts -> Block -> IO [Block] +-- insertDiagrams opts (CodeBlock (ident, classes, attrs) code) +-- | "diagram-haskell" `elem` classes = (++ [bl']) <$> img +-- | "diagram" `elem` classes = img +-- where +-- img = do +-- d <- compileDiagram opts code +-- return $ case d of +-- Left _err -> [] +-- Right imgName -> [Plain [Image [] (imgName,"")]] -- no alt text, no title +-- bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code +-- insertDiagrams _ block = return [block] + +-- data Opts = Opts { +-- _outDir :: FilePath, +-- _expression :: String +-- } + +-- optsParser :: Parser Opts +-- optsParser = Opts +-- <$> strOption (long "out" <> short 'o' <> metavar "DIR" +-- <> help "Directory for image files" <> value "images") +-- <*> strOption (long "expression" <> long "expr" <> short 'e' <> +-- metavar "NAME" <> +-- help "name of Diagram value in Haskell snippet" <> +-- value "example") + +-- withHelp :: ParserInfo Opts +-- withHelp = info +-- (helper <*> optsParser) +-- (fullDesc <> progDesc "interpret inline Haskell code to images in Pandoc output\nhttps://github.com/bergey/diagrams-pandoc" +-- <> header "diagrams-pandoc - a Pandoc filter for inline Diagrams") diff --git a/diagrams-pandoc.cabal b/diagrams-pandoc.cabal index 9429177..f970110 100644 --- a/diagrams-pandoc.cabal +++ b/diagrams-pandoc.cabal @@ -15,18 +15,63 @@ build-type: Simple -- extra-source-files: cabal-version: >=1.10 +library + exposed-modules: Diagrams.Pandoc + + build-depends: base >=4.2 && < 4.8, + mtl >= 2.1 && < 2.3, + diagrams-lib >= 1.2 && < 1.3, + hint >= 0.4 && < 0.5, + directory, + filepath, + transformers >= 0.3 && < 0.5, + split >= 0.2 && < 0.3, + haskell-src-exts >= 1.16 && < 1.17, + cmdargs >= 0.6 && < 0.11, + lens >= 4.0 && < 4.7, + hashable >= 1.1 && < 1.3, + exceptions >= 0.3 && < 0.7, + temporary >= 1.2 && < 1.3, + diagrams-pgf, + diagrams-svg, + diagrams-rasterific, + linear, + diagrams-builder, + optparse-applicative, + pandoc-types, + semigroups, + bytestring + + hs-source-dirs: src + default-language: Haskell2010 + executable diagrams-pandoc main-is: Main.hs - -- other-modules: - -- other-extensions: - build-depends: base >= 4.6 && < 4.8, - pandoc-types >= 1.12 && < 1.13, - diagrams-lib >= 1.0 && < 1.3, - linear >= 1.10 && < 1.16, - diagrams-builder >= 0.5 && < 0.7, - diagrams-cairo >= 1.0 && < 1.3, - directory >= 1.2 && < 1.3, - filepath >= 1.3 && < 1.4, - optparse-applicative >= 0.11 && < 0.12 - -- hs-source-dirs: - default-language: Haskell2010 \ No newline at end of file +-- other-modules: +-- other-extensions: + build-depends: base >=4.2 && < 4.8, + mtl >= 2.1 && < 2.3, + diagrams-lib >= 1.2 && < 1.3, + hint >= 0.4 && < 0.5, + directory, + filepath, + transformers >= 0.3 && < 0.5, + split >= 0.2 && < 0.3, + haskell-src-exts >= 1.16 && < 1.17, + cmdargs >= 0.6 && < 0.11, + lens >= 4.0 && < 4.7, + hashable >= 1.1 && < 1.3, + exceptions >= 0.3 && < 0.7, + temporary >= 1.2 && < 1.3, + diagrams-pgf, + diagrams-svg, + diagrams-rasterific, + linear, + diagrams-builder, + pandoc-types, + bytestring, + optparse-applicative, + semigroups, + diagrams-pandoc +-- -- hs-source-dirs: + default-language: Haskell2010 diff --git a/src/Diagrams/Pandoc.hs b/src/Diagrams/Pandoc.hs new file mode 100644 index 0000000..b9366aa --- /dev/null +++ b/src/Diagrams/Pandoc.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +module Diagrams.Pandoc where + +import Control.Lens hiding ((<.>)) +import Diagrams.Backend.Build +import Diagrams.Builder as DB +import Diagrams.Builder.Opts as DB +import Diagrams.Prelude hiding (block) +import System.FilePath +import System.IO +import Text.Pandoc.JSON + +import Diagrams.Backend.PGF +import Diagrams.Backend.Rasterific +import Diagrams.Backend.SVG + +defaultBackend :: Maybe Format -> Attr -> String -> IO Block +defaultBackend mf = + case mf of + Just (Format "latex") -> addDiagramPGF pgfBuildOpts mf + Just (Format "html") -> addDiagramSVG svgBuildOpts mf + _ -> addDiagramRasterific rasterificBuildOpts mf + +addDiagrams :: Maybe Format -> Block -> IO [Block] +addDiagrams mf (CodeBlock attrs@(_ident, classes, _ats) code) + | "diagram" `elem` classes = fmap pure dia + | "raster" `elem` classes = fmap pure rasterDia + -- TODO: cases for including code + where + dia = defaultBackend mf attrs code + rasterDia = addDiagramRasterific rasterificBuildOpts mf attrs code + +addDiagrams _ block = pure [block] + +-- | Alter build options from args including: +-- +-- * change size spec via \"width=10\", \"height=20\" or +-- \".absolute\" +-- +-- * no post-processing with \".nopostprocess\" +-- +-- * no hashing with ".nohash" +-- +-- alterOptions :: BackendBuild b v n => BuildOpts b v n -> Attr -> BuildOpts b v n +-- alterOptions b (_ident, classes, _attrs) = + +------------------------------------------------------------------------ +-- PGF +------------------------------------------------------------------------ + +pgfBuildOpts :: BuildOpts PGF V2 Double +pgfBuildOpts = mkBuildOpts PGF zero with + & diaExpr .~ "example" + & hashCache ?~ "diagrams" + & backendOpts . outputSize .~ dims2D 180 120 + & imports .~ [ "Diagrams.Backend.PGF" + , "Diagrams.Prelude" + ] + +addDiagramPGF :: BuildOpts PGF V2 Double -> Maybe Format -> Attr -> String -> IO Block +addDiagramPGF opts mf _ats code = do + d <- compileDiagram opts code "tex" + case d of + Left err -> hPutStrLn stderr "An error occured! See output for detail." + >> return (CodeBlock nullAttr ("Error!\n" ++ err)) + Right file -> case mf of + Just (Format "latex") + -> return $ RawBlock "latex" ("\\input{" ++ file ++ "}") + -- Just (Format "html") + -- -> do Image [] "" + _ -> return $ CodeBlock nullAttr ("Error!\n" ++ show mf) + +------------------------------------------------------------------------ +-- SVG +------------------------------------------------------------------------ + +svgBuildOpts :: BuildOpts SVG V2 Double +svgBuildOpts = mkBuildOpts SVG zero (SVGOptions (dims2D 180 120) Nothing) + & diaExpr .~ "example" + & hashCache ?~ "diagrams" + & backendOpts . outputSize .~ dims2D 220 180 + & imports .~ [ "Diagrams.Backend.SVG" + , "Diagrams.Prelude" + ] + +addDiagramSVG :: BuildOpts SVG V2 Double -> Maybe Format -> Attr -> String -> IO Block +addDiagramSVG opts _mf ats code = do + d <- compileDiagram opts code "svg" + case d of + Left err -> hPutStrLn stderr "An error occured! See output for detail." + >> return (CodeBlock nullAttr ("Error!\n" ++ err)) + Right file -> return $ Para [Image [Str $ ats^._1] (file,"diagram")] + +------------------------------------------------------------------------ +-- Rasterific +------------------------------------------------------------------------ +type Raster = Rasterific + +rasterificBuildOpts :: BuildOpts Raster V2 Float +rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions (dims2D 180 120)) + & diaExpr .~ "example" + & hashCache ?~ "diagrams" + & backendOpts . outputSize .~ dims2D 180 120 + & imports .~ [ "Diagrams.Backend.Rasterific" + , "Diagrams.Prelude" + ] + +addDiagramRasterific :: BuildOpts Rasterific V2 Float -> Maybe Format -> Attr -> String -> IO Block +addDiagramRasterific opts _mf ats code = do + d <- compileDiagram opts code "png" + case d of + Left err -> hPutStrLn stderr "An error occured! See output for detail." + >> return (CodeBlock nullAttr ("Error!\n" ++ err)) + Right file -> return $ Para [Image [Str $ ats^._1] (file,"diagram")] + +-- | Compile the literate source code of a diagram to a .png file with +-- a file name given by a hash of the source code contents +compileDiagram :: BuildBackend b v n => BuildOpts b v n -> String -> String -> IO (Either String FilePath) +compileDiagram opts src ext = do + r <- buildToHash (opts & snippets %~ (++ [src])) ext + let mkPath h = (opts ^. hashCache . _Just) showHash h <.> ext + return $ case r of + OK h () -> Right $ mkPath h + Skipped h -> Right $ mkPath h + InterpError e -> Left $ ppInterpError e + ParseError e -> Left e + From 3da1632ab5e5d8412505b3d7b92c9eebfa4a42a2 Mon Sep 17 00:00:00 2001 From: Christopher Chalmers Date: Fri, 19 Dec 2014 15:49:51 +0000 Subject: [PATCH 2/5] Add options to adjust. --- src/Diagrams/Pandoc.hs | 72 ++++++++++++++++++++++++++++-------------- 1 file changed, 49 insertions(+), 23 deletions(-) diff --git a/src/Diagrams/Pandoc.hs b/src/Diagrams/Pandoc.hs index b9366aa..c8aa3ff 100644 --- a/src/Diagrams/Pandoc.hs +++ b/src/Diagrams/Pandoc.hs @@ -1,10 +1,12 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module Diagrams.Pandoc where import Control.Lens hiding ((<.>)) +import Control.Monad import Diagrams.Backend.Build import Diagrams.Builder as DB import Diagrams.Builder.Opts as DB @@ -12,26 +14,29 @@ import Diagrams.Prelude hiding (block) import System.FilePath import System.IO import Text.Pandoc.JSON +import Text.Read import Diagrams.Backend.PGF import Diagrams.Backend.Rasterific import Diagrams.Backend.SVG defaultBackend :: Maybe Format -> Attr -> String -> IO Block -defaultBackend mf = +defaultBackend mf ats = case mf of - Just (Format "latex") -> addDiagramPGF pgfBuildOpts mf - Just (Format "html") -> addDiagramSVG svgBuildOpts mf - _ -> addDiagramRasterific rasterificBuildOpts mf + Just (Format "latex") -> addDiagramPGF (alter pgfBuildOpts) mf ats + Just (Format "context") -> addDiagramPGF (alter pgfBuildOpts) mf ats + Just (Format "html") -> addDiagramSVG (alter svgBuildOpts) mf ats + _ -> addDiagramRasterific (alter rasterificBuildOpts) mf ats + where alter = alterOptions ats addDiagrams :: Maybe Format -> Block -> IO [Block] addDiagrams mf (CodeBlock attrs@(_ident, classes, _ats) code) | "diagram" `elem` classes = fmap pure dia - | "raster" `elem` classes = fmap pure rasterDia + | "raster" `elem` classes = fmap pure diaRaster -- TODO: cases for including code where dia = defaultBackend mf attrs code - rasterDia = addDiagramRasterific rasterificBuildOpts mf attrs code + diaRaster = addDiagramRasterific rasterificBuildOpts mf attrs code addDiagrams _ block = pure [block] @@ -42,10 +47,25 @@ addDiagrams _ block = pure [block] -- -- * no post-processing with \".nopostprocess\" -- --- * no hashing with ".nohash" --- --- alterOptions :: BackendBuild b v n => BuildOpts b v n -> Attr -> BuildOpts b v n --- alterOptions b (_ident, classes, _attrs) = +alterOptions :: (Read n, Num n) => BackendBuild b v n => Attr -> BuildOpts b v n -> BuildOpts b v n +alterOptions (_ident, classes, attrs) b = + b & case (lookupRead "width" attrs, lookupRead "height" attrs) of + (Just w, Just h) -> buildSize .~ dims2D w h + (Just w, Nothing) -> buildSize .~ mkWidth w + (Nothing, Just h) -> buildSize .~ mkHeight h + _ -> id + & whenever ("absolute" `elem` classes) (buildSize .~ absolute) + & whenever ("nopp" `elem` classes) (postProcess .~ id) + & maybe id (set diaExpr) (lookup "expr" attrs) + +lookupRead :: (Eq a, Read b) => a -> [(a, String)] -> Maybe b +lookupRead a = lookup a >=> readMaybe + +whenever :: Bool -> (a -> a) -> a -> a +whenever b f = if b then f else id + +buildSize :: BackendBuild b v n => Lens' (BuildOpts b v n) (SizeSpec V2 n) +buildSize = backendOpts . outputSize ------------------------------------------------------------------------ -- PGF @@ -61,17 +81,23 @@ pgfBuildOpts = mkBuildOpts PGF zero with ] addDiagramPGF :: BuildOpts PGF V2 Double -> Maybe Format -> Attr -> String -> IO Block -addDiagramPGF opts mf _ats code = do - d <- compileDiagram opts code "tex" - case d of - Left err -> hPutStrLn stderr "An error occured! See output for detail." - >> return (CodeBlock nullAttr ("Error!\n" ++ err)) - Right file -> case mf of - Just (Format "latex") - -> return $ RawBlock "latex" ("\\input{" ++ file ++ "}") - -- Just (Format "html") - -- -> do Image [] "" - _ -> return $ CodeBlock nullAttr ("Error!\n" ++ show mf) +addDiagramPGF opts mf ats code = do + case mf of + Just (Format "latex") -> do + d <- compileDiagram opts code "tex" + handleError d $ \file -> RawBlock "latex" ("\\input{" ++ file ++ "}") + + Just (Format "context") -> do + d <- compileDiagram (opts & backendOpts . surface .~ contextSurface) code "tex" + handleError d $ \file -> RawBlock "context" ("\\input{" ++ file ++ "}") + + _ -> do d <- compileDiagram opts code "pdf" + handleError d $ \file -> Para [Image [Str $ ats^._1] (file,"diagram")] + where + handleError d b = case d of + Left err -> hPutStrLn stderr "An error occured! See output for detail." + >> return (CodeBlock nullAttr ("Error!\n" ++ err)) + Right file -> return $ b file ------------------------------------------------------------------------ -- SVG @@ -81,7 +107,7 @@ svgBuildOpts :: BuildOpts SVG V2 Double svgBuildOpts = mkBuildOpts SVG zero (SVGOptions (dims2D 180 120) Nothing) & diaExpr .~ "example" & hashCache ?~ "diagrams" - & backendOpts . outputSize .~ dims2D 220 180 + & buildSize .~ dims2D 220 180 & imports .~ [ "Diagrams.Backend.SVG" , "Diagrams.Prelude" ] @@ -103,7 +129,7 @@ rasterificBuildOpts :: BuildOpts Raster V2 Float rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions (dims2D 180 120)) & diaExpr .~ "example" & hashCache ?~ "diagrams" - & backendOpts . outputSize .~ dims2D 180 120 + & buildSize .~ dims2D 180 120 & imports .~ [ "Diagrams.Backend.Rasterific" , "Diagrams.Prelude" ] From edcce0e63e4eef29cfaac9fdb907bcb012a63561 Mon Sep 17 00:00:00 2001 From: Christopher Chalmers Date: Mon, 19 Jan 2015 08:18:00 +0000 Subject: [PATCH 3/5] Cleanup. --- diagrams-pandoc.cabal | 3 - src/Diagrams/Pandoc.hs | 128 ++++++++++++++++++++++++++--------------- 2 files changed, 81 insertions(+), 50 deletions(-) diff --git a/diagrams-pandoc.cabal b/diagrams-pandoc.cabal index f970110..c85957d 100644 --- a/diagrams-pandoc.cabal +++ b/diagrams-pandoc.cabal @@ -1,6 +1,3 @@ --- Initial diagrams-pandoc.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: diagrams-pandoc version: 0.1 synopsis: A pandoc filter to express diagrams inline using the haskell EDSL _diagrams_ diff --git a/src/Diagrams/Pandoc.hs b/src/Diagrams/Pandoc.hs index c8aa3ff..7fc2099 100644 --- a/src/Diagrams/Pandoc.hs +++ b/src/Diagrams/Pandoc.hs @@ -1,18 +1,19 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} module Diagrams.Pandoc where import Control.Lens hiding ((<.>)) import Control.Monad +import Data.List (delete) import Diagrams.Backend.Build import Diagrams.Builder as DB -import Diagrams.Builder.Opts as DB import Diagrams.Prelude hiding (block) import System.FilePath import System.IO +import Text.Pandoc.Generic import Text.Pandoc.JSON import Text.Read @@ -20,22 +21,38 @@ import Diagrams.Backend.PGF import Diagrams.Backend.Rasterific import Diagrams.Backend.SVG +-- | Default size to use when nothing else is given. +defaultSize :: Num n => SizeSpec V2 n +defaultSize = dims2D 260 120 + +-- | Default filter to use for turning diagrams code blocks in to +-- diagrams. +diaPandocFilter :: Maybe Format -> Pandoc -> IO Pandoc +diaPandocFilter mf (Pandoc m bs) = Pandoc m <$> walk' (addDiagrams mf) bs + where + -- backend = lookupMeta "backend" m + -- extraImports = lookupMeta "extra-imports" m + -- expression = lookupMeta "diagram-expression" m + walk' f = bottomUpM (liftM concat . mapM f) + defaultBackend :: Maybe Format -> Attr -> String -> IO Block defaultBackend mf ats = case mf of Just (Format "latex") -> addDiagramPGF (alter pgfBuildOpts) mf ats Just (Format "context") -> addDiagramPGF (alter pgfBuildOpts) mf ats - Just (Format "html") -> addDiagramSVG (alter svgBuildOpts) mf ats - _ -> addDiagramRasterific (alter rasterificBuildOpts) mf ats + Just (Format "html") -> addDiagramSVG (alter svgBuildOpts) mf ats + _ -> addDiagramRasterific (alter rasterificBuildOpts) mf ats where alter = alterOptions ats addDiagrams :: Maybe Format -> Block -> IO [Block] addDiagrams mf (CodeBlock attrs@(_ident, classes, _ats) code) | "diagram" `elem` classes = fmap pure dia | "raster" `elem` classes = fmap pure diaRaster - -- TODO: cases for including code + | "diagram-code" `elem` classes = do + d <- dia + pure [d, CodeBlock (attrs & _2 %~ delete "diagram-code") code] where - dia = defaultBackend mf attrs code + dia = defaultBackend mf attrs code diaRaster = addDiagramRasterific rasterificBuildOpts mf attrs code addDiagrams _ block = pure [block] @@ -67,6 +84,28 @@ whenever b f = if b then f else id buildSize :: BackendBuild b v n => Lens' (BuildOpts b v n) (SizeSpec V2 n) buildSize = backendOpts . outputSize +------------------------------------------------------------------------ +-- Pandoc building +------------------------------------------------------------------------ + +image_ :: String -> String -> FilePath -> Block +image_ inline title path = Para [Image [Str inline] (path, title)] + +latexInput_ :: String -> Block +latexInput_ path = RawBlock "latex" ("\\input{" ++ path ++ "}") + +contextInput_ :: String -> Block +contextInput_ path = RawBlock "context" ("\\input{" ++ path ++ "}") + +code_ :: String -> Block +code_ = CodeBlock nullAttr + +handleError :: Either String FilePath -> (FilePath -> Block) -> IO Block +handleError d b = case d of + Left err -> hPutStrLn stderr "An error occurred! See output for detail." + >> return (code_ $ "Error!\n" ++ err) + Right file -> return (b file) + ------------------------------------------------------------------------ -- PGF ------------------------------------------------------------------------ @@ -75,78 +114,73 @@ pgfBuildOpts :: BuildOpts PGF V2 Double pgfBuildOpts = mkBuildOpts PGF zero with & diaExpr .~ "example" & hashCache ?~ "diagrams" - & backendOpts . outputSize .~ dims2D 180 120 - & imports .~ [ "Diagrams.Backend.PGF" - , "Diagrams.Prelude" - ] + & buildSize .~ defaultSize + & imports .~ [ "Diagrams.Backend.PGF" + , "Diagrams.Prelude" + ] addDiagramPGF :: BuildOpts PGF V2 Double -> Maybe Format -> Attr -> String -> IO Block -addDiagramPGF opts mf ats code = do +addDiagramPGF opts mf ats code = case mf of Just (Format "latex") -> do d <- compileDiagram opts code "tex" - handleError d $ \file -> RawBlock "latex" ("\\input{" ++ file ++ "}") + handleError d latexInput_ Just (Format "context") -> do d <- compileDiagram (opts & backendOpts . surface .~ contextSurface) code "tex" - handleError d $ \file -> RawBlock "context" ("\\input{" ++ file ++ "}") + handleError d latexInput_ - _ -> do d <- compileDiagram opts code "pdf" - handleError d $ \file -> Para [Image [Str $ ats^._1] (file,"diagram")] - where - handleError d b = case d of - Left err -> hPutStrLn stderr "An error occured! See output for detail." - >> return (CodeBlock nullAttr ("Error!\n" ++ err)) - Right file -> return $ b file + _ -> do + d <- compileDiagram opts code "pdf" + handleError d $ image_ (ats^._1) "diagram" ------------------------------------------------------------------------ -- SVG ------------------------------------------------------------------------ svgBuildOpts :: BuildOpts SVG V2 Double -svgBuildOpts = mkBuildOpts SVG zero (SVGOptions (dims2D 180 120) Nothing) +svgBuildOpts = mkBuildOpts SVG zero (SVGOptions defaultSize Nothing) & diaExpr .~ "example" & hashCache ?~ "diagrams" - & buildSize .~ dims2D 220 180 - & imports .~ [ "Diagrams.Backend.SVG" - , "Diagrams.Prelude" - ] + & imports .~ [ "Diagrams.Backend.SVG" + , "Diagrams.Prelude" + ] addDiagramSVG :: BuildOpts SVG V2 Double -> Maybe Format -> Attr -> String -> IO Block addDiagramSVG opts _mf ats code = do d <- compileDiagram opts code "svg" - case d of - Left err -> hPutStrLn stderr "An error occured! See output for detail." - >> return (CodeBlock nullAttr ("Error!\n" ++ err)) - Right file -> return $ Para [Image [Str $ ats^._1] (file,"diagram")] + handleError d $ image_ (ats^._1) "diagram" ------------------------------------------------------------------------ -- Rasterific ------------------------------------------------------------------------ + type Raster = Rasterific rasterificBuildOpts :: BuildOpts Raster V2 Float -rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions (dims2D 180 120)) +rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions defaultSize) & diaExpr .~ "example" & hashCache ?~ "diagrams" - & buildSize .~ dims2D 180 120 - & imports .~ [ "Diagrams.Backend.Rasterific" - , "Diagrams.Prelude" - ] + & imports .~ [ "Diagrams.Backend.Rasterific" + , "Diagrams.Prelude" + ] addDiagramRasterific :: BuildOpts Rasterific V2 Float -> Maybe Format -> Attr -> String -> IO Block addDiagramRasterific opts _mf ats code = do d <- compileDiagram opts code "png" - case d of - Left err -> hPutStrLn stderr "An error occured! See output for detail." - >> return (CodeBlock nullAttr ("Error!\n" ++ err)) - Right file -> return $ Para [Image [Str $ ats^._1] (file,"diagram")] - --- | Compile the literate source code of a diagram to a .png file with --- a file name given by a hash of the source code contents -compileDiagram :: BuildBackend b v n => BuildOpts b v n -> String -> String -> IO (Either String FilePath) + handleError d $ image_ (ats^._1) "diagram" + +------------------------------------------------------------------------ +-- Compiling +------------------------------------------------------------------------ + +-- | @compileDiagram opts src ext@ compiles the literate source code of +-- a diagram to a file with a file name given by a hash of the source +-- code contents. Returns the path to the result or an interpretor / +-- compiler error. +compileDiagram :: BackendBuild' b v n => BuildOpts b v n -> String -> String -> IO (Either String FilePath) compileDiagram opts src ext = do - r <- buildToHash (opts & snippets %~ (++ [src])) ext + r <- buildDiaToHash (opts & snippets %~ (++ [src])) ext let mkPath h = (opts ^. hashCache . _Just) showHash h <.> ext return $ case r of OK h () -> Right $ mkPath h From 8c2c77e21cb336e8b4d6af568537ba0b37ffb266 Mon Sep 17 00:00:00 2001 From: Christopher Chalmers Date: Sun, 25 Jan 2015 19:46:36 +0000 Subject: [PATCH 4/5] Add more general filters. --- Main.hs | 51 +-------- src/Diagrams/Pandoc.hs | 244 ++++++++++++++++++++++++++++++++--------- 2 files changed, 194 insertions(+), 101 deletions(-) diff --git a/Main.hs b/Main.hs index be49ebb..3f44088 100644 --- a/Main.hs +++ b/Main.hs @@ -1,52 +1,9 @@ --- import Control.Applicative --- import Control.Monad (when) --- import Data.List (delete) --- import Diagrams.Backend.Cairo --- import Diagrams.Backend.Cairo.Internal --- import qualified Diagrams.Builder as DB --- import Diagrams.Prelude (centerXY, pad, (&), (.~)) --- import Diagrams.Size (dims) --- import Linear (V2(..), zero) --- import Options.Applicative --- import System.Directory (createDirectory, --- doesDirectoryExist) --- import System.FilePath ((<.>), ()) --- import System.IO -import Text.Pandoc.JSON +import Text.Pandoc.JSON import Diagrams.Pandoc main :: IO () -main = toJSONFilter addDiagrams +main = toJSONFilter defFilter --- insertDiagrams :: Opts -> Block -> IO [Block] --- insertDiagrams opts (CodeBlock (ident, classes, attrs) code) --- | "diagram-haskell" `elem` classes = (++ [bl']) <$> img --- | "diagram" `elem` classes = img --- where --- img = do --- d <- compileDiagram opts code --- return $ case d of --- Left _err -> [] --- Right imgName -> [Plain [Image [] (imgName,"")]] -- no alt text, no title --- bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code --- insertDiagrams _ block = return [block] +defFilter :: Maybe Format -> Pandoc -> IO Pandoc +defFilter = pandocFilter (backendFilter id defaultFilters) --- data Opts = Opts { --- _outDir :: FilePath, --- _expression :: String --- } - --- optsParser :: Parser Opts --- optsParser = Opts --- <$> strOption (long "out" <> short 'o' <> metavar "DIR" --- <> help "Directory for image files" <> value "images") --- <*> strOption (long "expression" <> long "expr" <> short 'e' <> --- metavar "NAME" <> --- help "name of Diagram value in Haskell snippet" <> --- value "example") - --- withHelp :: ParserInfo Opts --- withHelp = info --- (helper <*> optsParser) --- (fullDesc <> progDesc "interpret inline Haskell code to images in Pandoc output\nhttps://github.com/bergey/diagrams-pandoc" --- <> header "diagrams-pandoc - a Pandoc filter for inline Diagrams") diff --git a/src/Diagrams/Pandoc.hs b/src/Diagrams/Pandoc.hs index 7fc2099..2551d15 100644 --- a/src/Diagrams/Pandoc.hs +++ b/src/Diagrams/Pandoc.hs @@ -1,13 +1,21 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} module Diagrams.Pandoc where +import Control.Applicative import Control.Lens hiding ((<.>)) import Control.Monad +import Control.Monad.IO.Class +import Data.Char (toLower) +import Data.Data.Lens +import Data.Foldable (foldMap) import Data.List (delete) +import Data.Maybe import Diagrams.Backend.Build import Diagrams.Builder as DB import Diagrams.Prelude hiding (block) @@ -25,64 +33,154 @@ import Diagrams.Backend.SVG defaultSize :: Num n => SizeSpec V2 n defaultSize = dims2D 260 120 --- | Default filter to use for turning diagrams code blocks in to --- diagrams. -diaPandocFilter :: Maybe Format -> Pandoc -> IO Pandoc -diaPandocFilter mf (Pandoc m bs) = Pandoc m <$> walk' (addDiagrams mf) bs +-- | General walk over the blocks in a Pandoc document with access to +-- the Meta and Format. +-- +-- A common way to use this is with Pandoc's JSON filter: +-- +-- @ +-- toJSONFilter $ pandocFilter (backendFilter defaultFilters) +-- @ +pandocFilter :: Monad m => (Meta -> Maybe Format -> Block -> m [Block]) + -> Maybe Format -> Pandoc -> m Pandoc +pandocFilter f mf (Pandoc m bs) = Pandoc m `liftM` walkM' (f m mf) bs where - -- backend = lookupMeta "backend" m - -- extraImports = lookupMeta "extra-imports" m - -- expression = lookupMeta "diagram-expression" m - walk' f = bottomUpM (liftM concat . mapM f) - -defaultBackend :: Maybe Format -> Attr -> String -> IO Block -defaultBackend mf ats = - case mf of - Just (Format "latex") -> addDiagramPGF (alter pgfBuildOpts) mf ats - Just (Format "context") -> addDiagramPGF (alter pgfBuildOpts) mf ats - Just (Format "html") -> addDiagramSVG (alter svgBuildOpts) mf ats - _ -> addDiagramRasterific (alter rasterificBuildOpts) mf ats - where alter = alterOptions ats - -addDiagrams :: Maybe Format -> Block -> IO [Block] -addDiagrams mf (CodeBlock attrs@(_ident, classes, _ats) code) - | "diagram" `elem` classes = fmap pure dia - | "raster" `elem` classes = fmap pure diaRaster - | "diagram-code" `elem` classes = do - d <- dia - pure [d, CodeBlock (attrs & _2 %~ delete "diagram-code") code] + -- (Block -> m [Block]) -> [Block] -> m [Block] + walkM' g = bottomUpM (liftM concat . mapM g) + +-- | An ad-hoc filter to build a diagram from a block. Putting them in a +-- hetrogeneous container like this allows multiple backends to be used +-- in a single document. +data BackendFilter = forall b v n. (BackendBuild b v n, Read n, Num n) => BackendFilter + { nameMatch :: String -> Bool -- matches name of backend + , formatMatch :: Format -> Bool -- matches format + , defaultOpts :: Options b v n -- default options to use + , filterBuild :: Maybe Format -> BuildOpts b v n -> Attr -> String -> IO Block + -- Function to build diagram + } + +type OptsAdjust = forall b v n. BackendBuild b v n + => BuildOpts b v n -> BuildOpts b v n + +-- | Filters for 'Rasterific', 'SVG' and 'PGF' backends. Any other +-- modules included by CPP will also be in this list. Rasterific is the +-- first in the list so it will be used as fallback if no backend or +-- 'Format' is found. +defaultFilters :: [BackendFilter] +defaultFilters = [rasterificFilter, svgFilter, pgfFilter] + +-- | Filter for turning 'CodeBlock's into diagrams using a list of +-- 'BackendFilter's. If no filters are given the pandoc output will +-- show a message saying so. A message will also been shown in the +-- document if there is an error in interpreting or compiling the +-- diagram. +-- +-- Currently implemented as follows: +-- +-- * Diagrams are specified with the @.diagram@ class. There are also +-- @.code-diagram@ and @.diagram-code@ classes for including code +-- before/after respectively. +-- +-- @@ +-- ``` diagram-code +-- diagram = circle 3 +-- ``` +-- @@ +-- +-- * Backends are specified by the @default-backend@ 'Meta' value or +-- the @backend@ key of the code block (case insensitive). +-- +-- @@ +-- --- +-- title: My SVG diagrams +-- default-backend: svg +-- ... +-- @@ +-- @@ +-- ``` {.diagram backend=pgf} +-- diagram = square 3 # fc blue # lw thick +-- ``` +-- @@ +-- @@ +-- ``` {.diagram backend=Rasterific width=300} +-- diagram = triangle 2 # fc yellow +-- @@ +backendFilter :: MonadIO m => OptsAdjust -> [BackendFilter] -> Meta -> Maybe Format -> Block -> m [Block] +backendFilter optsAdjust filters meta@(Meta m) mf (CodeBlock attrs@(bId, classes, keys) code) + | "diagram" `elem` classes = mkDiagram + | "diagram-code" `elem` classes = (++ codeBlock) `liftM` mkDiagram + | "code-diagram" `elem` classes = (codeBlock ++) `liftM` mkDiagram where - dia = defaultBackend mf attrs code - diaRaster = addDiagramRasterific rasterificBuildOpts mf attrs code - -addDiagrams _ block = pure [block] - --- | Alter build options from args including: + mkDiagram = liftIO $ case backend of + Just (BackendFilter _ _ opts f) -> + let bOpts = mkBuildOpts undefined undefined opts + & keysOptsAlter meta attrs + & optsAdjust + in pure `liftM` f mf bOpts attrs code + Nothing -> return [code_ "A diagram should be here but no backend filters where found."] + + codeBlock = [CodeBlock (bId, rmCode classes, keys) code] + rmCode = cons "haskell" . delete "diagram-code" . delete "code-diagram" + backend = test nameMatch bName <|> test formatMatch mf <|> listToMaybe filters + -- try to match names or formats, use head as fallback + bName = map toLower + <$> lookup "backend" keys + <|> m ^? foldMap ix ["default-backend", "diagrams-backend", "backend"] . template + -- query filters for the first match + test :: (BackendFilter -> a -> Bool) -> Maybe a -> Maybe BackendFilter + test f ma = ma >>= \a -> listToMaybe $ filter (`f` a) filters +backendFilter _ _ _ _ b = return [b] + +-- | Alter the 'BuildOpts' using the document's 'Meta' and the code +-- block's 'Attr'. Current supported adjustments are: +-- +-- * Change size with @width=@ and @size=@ keys or @.absolute@ class: +-- +-- @@ +-- ``` {.diagram width=300 height=200} +-- -- Or +-- ``` {.diagram .absolute} +-- example = pentagon 100 # fc orange +-- ``` +-- @@ +-- +-- * Don't post-process the diagram with @.no-post-process@ class. +-- +-- * Change the expression with @diagram-expression@ 'Meta' value or +-- @'diagram-expression=@ key. -- --- * change size spec via \"width=10\", \"height=20\" or --- \".absolute\" +-- * Include extra modules with @extra-diagrams-modules@ or +-- @extra-modules@ types in the document 'Meta'. For example, in a +-- markdown header: -- --- * no post-processing with \".nopostprocess\" +-- @@ +-- --- +-- title: Pretty diagrams +-- extra-diagrams-modules: +-- - Diagrams.TwoD.Sunburst +-- - Diagrams.TwoD.Factorization +-- ... -- -alterOptions :: (Read n, Num n) => BackendBuild b v n => Attr -> BuildOpts b v n -> BuildOpts b v n -alterOptions (_ident, classes, attrs) b = - b & case (lookupRead "width" attrs, lookupRead "height" attrs) of +-- Rest of markdown document. +-- @@ +-- +keysOptsAlter :: (Read n, Num n, BackendBuild b v n) + => Meta -> Attr -> BuildOpts b v n -> BuildOpts b v n +keysOptsAlter (Meta m) (_ident, classes, keys) b = + b & case (lookupRead "width" keys, lookupRead "height" keys) of (Just w, Just h) -> buildSize .~ dims2D w h (Just w, Nothing) -> buildSize .~ mkWidth w (Nothing, Just h) -> buildSize .~ mkHeight h _ -> id & whenever ("absolute" `elem` classes) (buildSize .~ absolute) - & whenever ("nopp" `elem` classes) (postProcess .~ id) - & maybe id (set diaExpr) (lookup "expr" attrs) - -lookupRead :: (Eq a, Read b) => a -> [(a, String)] -> Maybe b -lookupRead a = lookup a >=> readMaybe - -whenever :: Bool -> (a -> a) -> a -> a -whenever b f = if b then f else id + & whenever ("no-post-process" `elem` classes) (postProcess .~ id) + & maybe id (set diaExpr) expr + & imports <>~ extraMods + where + extraMods = m ^.. (ix "extra-diagrams-modules" <> ix "extra-modules") . template -buildSize :: BackendBuild b v n => Lens' (BuildOpts b v n) (SizeSpec V2 n) -buildSize = backendOpts . outputSize + expr = lookup "diagram-expression" keys + <|> m ^? ix "diagram-expression" . template ------------------------------------------------------------------------ -- Pandoc building @@ -110,6 +208,14 @@ handleError d b = case d of -- PGF ------------------------------------------------------------------------ +pgfFilter :: BackendFilter +pgfFilter = BackendFilter + { nameMatch = (`elem` ["pgf", "portable-graphics-format"]) + , formatMatch = (`elem` ["latex", "context", "pdf"]) + , defaultOpts = with & outputSize .~ defaultSize + , filterBuild = addDiagramPgf + } + pgfBuildOpts :: BuildOpts PGF V2 Double pgfBuildOpts = mkBuildOpts PGF zero with & diaExpr .~ "example" @@ -119,8 +225,8 @@ pgfBuildOpts = mkBuildOpts PGF zero with , "Diagrams.Prelude" ] -addDiagramPGF :: BuildOpts PGF V2 Double -> Maybe Format -> Attr -> String -> IO Block -addDiagramPGF opts mf ats code = +addDiagramPgf :: Maybe Format -> BuildOpts PGF V2 Double -> Attr -> String -> IO Block +addDiagramPgf mf opts_ ats code = case mf of Just (Format "latex") -> do d <- compileDiagram opts code "tex" @@ -133,11 +239,21 @@ addDiagramPGF opts mf ats code = _ -> do d <- compileDiagram opts code "pdf" handleError d $ image_ (ats^._1) "diagram" + where + opts = opts_ & imports <>~ ["Diagrams.Backend.PGF"] ------------------------------------------------------------------------ -- SVG ------------------------------------------------------------------------ +svgFilter :: BackendFilter +svgFilter = BackendFilter + { nameMatch = (`elem` ["svg"]) + , formatMatch = (`elem` ["html", "md", "markdown"]) + , defaultOpts = SVGOptions defaultSize Nothing + , filterBuild = addDiagramSVG + } + svgBuildOpts :: BuildOpts SVG V2 Double svgBuildOpts = mkBuildOpts SVG zero (SVGOptions defaultSize Nothing) & diaExpr .~ "example" @@ -146,10 +262,12 @@ svgBuildOpts = mkBuildOpts SVG zero (SVGOptions defaultSize Nothing) , "Diagrams.Prelude" ] -addDiagramSVG :: BuildOpts SVG V2 Double -> Maybe Format -> Attr -> String -> IO Block -addDiagramSVG opts _mf ats code = do +addDiagramSVG :: Maybe Format -> BuildOpts SVG V2 Double -> Attr -> String -> IO Block +addDiagramSVG _ opts_ ats code = do d <- compileDiagram opts code "svg" handleError d $ image_ (ats^._1) "diagram" + where + opts = opts_ & imports <>~ ["Diagrams.Backend.SVG"] ------------------------------------------------------------------------ -- Rasterific @@ -157,6 +275,14 @@ addDiagramSVG opts _mf ats code = do type Raster = Rasterific +rasterificFilter :: BackendFilter +rasterificFilter = BackendFilter + { nameMatch = (`elem` ["rasterific", "raster"]) + , formatMatch = const False -- Rasterific is the fallback (so first in list) + , defaultOpts = RasterificOptions defaultSize + , filterBuild = addDiagramRasterific + } + rasterificBuildOpts :: BuildOpts Raster V2 Float rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions defaultSize) & diaExpr .~ "example" @@ -165,13 +291,15 @@ rasterificBuildOpts = mkBuildOpts Rasterific zero (RasterificOptions defaultSize , "Diagrams.Prelude" ] -addDiagramRasterific :: BuildOpts Rasterific V2 Float -> Maybe Format -> Attr -> String -> IO Block -addDiagramRasterific opts _mf ats code = do +addDiagramRasterific :: Maybe Format -> BuildOpts Rasterific V2 Float -> Attr -> String -> IO Block +addDiagramRasterific _ opts_ ats code = do d <- compileDiagram opts code "png" handleError d $ image_ (ats^._1) "diagram" + where + opts = opts_ & imports <>~ ["Diagrams.Backend.Rasterific"] ------------------------------------------------------------------------ --- Compiling +-- Utilities ------------------------------------------------------------------------ -- | @compileDiagram opts src ext@ compiles the literate source code of @@ -188,3 +316,11 @@ compileDiagram opts src ext = do InterpError e -> Left $ ppInterpError e ParseError e -> Left e +lookupRead :: (Eq a, Read b) => a -> [(a, String)] -> Maybe b +lookupRead a = lookup a >=> readMaybe + +whenever :: Bool -> (a -> a) -> a -> a +whenever b f = if b then f else id + +buildSize :: BackendBuild b v n => Lens' (BuildOpts b v n) (SizeSpec V2 n) +buildSize = backendOpts . outputSize From f93f95e09c5244488a91a1df3f6fbd1fe2d8fdc1 Mon Sep 17 00:00:00 2001 From: Christopher Chalmers Date: Wed, 28 Jan 2015 23:38:25 +0000 Subject: [PATCH 5/5] Added support for lucid-svg svg-diagrams. --- diagrams-pandoc.cabal | 5 +++-- src/Diagrams/Pandoc.hs | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/diagrams-pandoc.cabal b/diagrams-pandoc.cabal index c85957d..4bfc8de 100644 --- a/diagrams-pandoc.cabal +++ b/diagrams-pandoc.cabal @@ -34,10 +34,11 @@ library diagrams-rasterific, linear, diagrams-builder, + semigroups, + bytestring, optparse-applicative, pandoc-types, - semigroups, - bytestring + pandoc hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Diagrams/Pandoc.hs b/src/Diagrams/Pandoc.hs index 2551d15..e8d883d 100644 --- a/src/Diagrams/Pandoc.hs +++ b/src/Diagrams/Pandoc.hs @@ -250,12 +250,12 @@ svgFilter :: BackendFilter svgFilter = BackendFilter { nameMatch = (`elem` ["svg"]) , formatMatch = (`elem` ["html", "md", "markdown"]) - , defaultOpts = SVGOptions defaultSize Nothing + , defaultOpts = SVGOptions defaultSize [] , filterBuild = addDiagramSVG } svgBuildOpts :: BuildOpts SVG V2 Double -svgBuildOpts = mkBuildOpts SVG zero (SVGOptions defaultSize Nothing) +svgBuildOpts = mkBuildOpts SVG zero (SVGOptions defaultSize []) & diaExpr .~ "example" & hashCache ?~ "diagrams" & imports .~ [ "Diagrams.Backend.SVG"