diagrams-pandoc 0.3 → 0.3.1
raw patch · 4 files changed
+161/−103 lines, 4 filesdep +diagrams-coredep +diagrams-svgdep +hashabledep ~basedep ~diagrams-builderdep ~diagrams-caironew-uploader
Dependencies added: diagrams-core, diagrams-svg, hashable, svg-builder, text
Dependency ranges changed: base, diagrams-builder, diagrams-cairo, diagrams-lib, diagrams-pandoc, directory, optparse-applicative, pandoc-types
Files
- CHANGELOG.md +7/−0
- diagrams-pandoc.cabal +24/−20
- src/Main.hs +9/−0
- src/Text/Pandoc/Diagrams.hs +121/−83
CHANGELOG.md view
@@ -1,3 +1,10 @@+## v0.3.1 (2020-06-11)++ - New `-a` option for outputting an absolute path+ - New `-b` option for choosing backend, and add SVG support+ - Relax many upper bounds+ - Update to pandoc-types-1.20+ ## v0.3 (2016-02-23) - Choose output type based on Pandoc output format
diagrams-pandoc.cabal view
@@ -1,5 +1,5 @@ name: diagrams-pandoc-version: 0.3+version: 0.3.1 synopsis: A Pandoc filter to express diagrams inline using the Haskell EDSL _Diagrams_ description: 'diagrams-pandoc' replaces appropriately marked code blocks in pandoc input with images. The code blocks are compiled@@ -16,20 +16,25 @@ Bug-reports: http://github.com/diagrams/diagrams-pandoc/issues Extra-source-files: README.md, CHANGELOG.md cabal-version: >=1.10-Tested-with: GHC == 7.8.4, GHC == 7.10.2+Tested-with: GHC ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.3 || ==8.10.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-pandoc.git library- build-depends: base >= 4.6 && < 4.9,- pandoc-types >= 1.16 && < 1.17,- diagrams-lib >= 1.3 && < 1.4,+ build-depends: base >= 4.6 && < 4.15,+ text >= 1.2 && < 1.3,+ pandoc-types >= 1.20 && < 1.21,+ diagrams-lib >= 1.3 && < 1.5, linear >= 1.10 && < 1.21,- diagrams-builder >= 0.7 && < 0.8,- diagrams-cairo >= 1.3 && < 1.4,- directory >= 1.2 && < 1.3,- filepath >= 1.3 && < 1.5+ diagrams-builder >= 0.7 && < 0.9,+ diagrams-cairo >= 1.3 && < 1.5,+ directory >= 1.2 && < 1.4,+ filepath >= 1.3 && < 1.5,+ diagrams-svg >= 1.4 && < 1.5,+ diagrams-core >= 1.4 && < 1.5,+ hashable >= 1.2 && < 1.4,+ svg-builder >= 0.1 && < 0.2 exposed-modules: Text.Pandoc.Diagrams default-language: Haskell2010 hs-source-dirs: src@@ -37,17 +42,16 @@ executable diagrams-pandoc main-is: src/Main.hs- -- other-modules: - -- other-extensions: - build-depends: base >= 4.6 && < 4.9,- pandoc-types >= 1.16 && < 1.17,- diagrams-lib >= 1.3 && < 1.4,+ other-extensions: CPP+ build-depends: base >= 4.6 && < 4.15,+ text >= 1.2 && < 1.3,+ pandoc-types >= 1.20 && < 1.21,+ diagrams-lib >= 1.3 && < 1.5, linear >= 1.10 && < 1.21,- diagrams-builder >= 0.7 && < 0.8,- diagrams-cairo >= 1.3 && < 1.4,- directory >= 1.2 && < 1.3,+ diagrams-builder >= 0.7 && < 0.9,+ diagrams-cairo >= 1.3 && < 1.5,+ directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5,- diagrams-pandoc >= 0.2 && < 0.3,- optparse-applicative >= 0.11 && < 0.13- -- hs-source-dirs: + diagrams-pandoc,+ optparse-applicative >= 0.11 && < 0.16 default-language: Haskell2010
src/Main.hs view
@@ -1,7 +1,13 @@+{-# LANGUAGE CPP #-}+ module Main where import Text.Pandoc.Diagrams +#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+ import Options.Applicative import Text.Pandoc.JSON @@ -19,6 +25,9 @@ metavar "NAME" <> help "name of Diagram value in Haskell snippet" <> value "example")+ <*> switch (long "absolute" <> short 'a' <>+ help "output the name of Diagram in Haskell snippet as absolute path")+ <*> option auto (long "backend" <> short 'b' <> metavar "BACKEND" <> value Cairo) withHelp :: ParserInfo Opts withHelp = info
src/Text/Pandoc/Diagrams.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} -- | Convert appropriately annotated Code blocks to an image, with or -- without display of the code. Interpret the Code blocks as Haskell@@ -6,45 +10,51 @@ module Text.Pandoc.Diagrams where -import Control.Monad (when)-import Data.Char (toLower)+import Data.Hashable (Hashable) import Data.List (delete)-import Diagrams.Backend.Cairo-import Diagrams.Backend.Cairo.Internal+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable (Typeable)+import qualified Diagrams.Backend.Cairo.Internal as BCairo+import qualified Diagrams.Backend.SVG as BSvg import qualified Diagrams.Builder as DB+import qualified Diagrams.Core as DC import Diagrams.Prelude (centerXY, pad, (&), (.~)) import Diagrams.Size (dims)+import qualified Graphics.Svg as Svg import Linear (V2 (..), zero) import System.Directory (createDirectoryIfMissing)-import System.FilePath ((<.>), (</>))+import System.FilePath (pathSeparator, (<.>), (</>)) import System.IO import Text.Pandoc.Definition -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif--backendExt :: String -> String-backendExt "beamer" = "pdf"-backendExt "latex" = "pdf"-backendExt _ = "png"+backendExt :: Opts -> String+backendExt Opts {_backend = SVG, ..} = "svg"+backendExt Opts {_backend = Cairo, ..} = case _outFormat of+ "beamer" -> "pdf"+ "latex" -> "pdf"+ _ -> "png" -- Return output type for a string-findOutputType :: String -> OutputType-findOutputType "beamer" = PDF-findOutputType "latex" = PDF-findOutputType _ = PNG+findCairoOutputType :: String -> BCairo.OutputType+findCairoOutputType "beamer" = BCairo.PDF+findCairoOutputType "latex" = BCairo.PDF+findCairoOutputType _ = BCairo.PNG data Opts = Opts {- _outFormat :: String,- _outDir :: FilePath,- _expression :: String+ _outFormat :: String,+ _outDir :: FilePath,+ _expression :: String,+ _absolutePath :: Bool,+ _backend :: Backend } +data Backend = Cairo | SVG deriving (Read)+ data Echo = Above | Below insertDiagrams :: Opts -> Block -> IO [Block]-insertDiagrams opts (CodeBlock (ident, classes, attrs) code)+insertDiagrams opts@Opts{..} (CodeBlock (ident, classes, attrs) code) | "diagram-haskell" `elem` classes = do i <- img return $ case echo of@@ -56,7 +66,10 @@ d <- compileDiagram opts attrs code return $ case d of Left _err -> Null -- TODO log an error here- Right imgName -> Plain [Image ("",[],[]) [] (imgName,"")] -- no alt text, no title+ Right imgName -> Plain+ [Image ("",[],[]) []+ (if _absolutePath then T.cons pathSeparator imgName else imgName,"")+ ] -- no alt text, no title bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code echo = readEcho attrs insertDiagrams _ block = return [block]@@ -66,87 +79,112 @@ -- TODO clean this up, move it into -builder somehow -- | Compile the literate source code of a diagram to a .png/.pdf file with -- a file name given by a hash of the source code contents-compileDiagram :: Opts -> [(String,String)] -> String -> IO (Either String String)+compileDiagram :: Opts -> [(Text,Text)] -> Text -> IO (Either String Text) compileDiagram opts attrs src = do ensureDir $ _outDir opts-- let- bopts :: DB.BuildOpts Cairo V2 Double- bopts = DB.mkBuildOpts+ case mkBuildOpts opts attrs src of+ SomeBuildOpts bo -> do+ res <- DB.buildDiagram bo+ case res of+ DB.ParseErr err -> do+ hPutStrLn stderr ("\nError while parsing\n" ++ T.unpack src)+ hPutStrLn stderr err+ return $ Left "Error while parsing" - Cairo+ DB.InterpErr ierr -> do+ hPutStrLn stderr ("\nError while interpreting\n" ++ T.unpack src)+ hPutStrLn stderr (DB.ppInterpError ierr)+ return $ Left "Error while interpreting" - zero+ DB.Skipped hash -> do+ hPutStr stderr "."+ hFlush stderr+ return $ Right (T.pack $ mkFile opts (DB.hashToHexStr hash)) - ( CairoOptions "default.png"- (dims $ V2 (widthAttribute attrs) (heightAttribute attrs))- (findOutputType $ _outFormat opts)- False- )+ DB.OK hash out -> do+ hPutStr stderr "O"+ hFlush stderr+ let path = mkFile opts (DB.hashToHexStr hash)+ handleResult path $ SomeResult out+ return $ Right (T.pack path)+ where+ ensureDir = createDirectoryIfMissing True+ handleResult path (SomeResult a) = mkImage path a - & 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)- )+mkFile :: Opts -> FilePath -> FilePath+mkFile opts base = _outDir opts </> base <.> backendExt opts - res <- DB.buildDiagram bopts+data SomeResult = forall r. (MkImage r) => SomeResult r - case res of- DB.ParseErr err -> do- hPutStrLn stderr ("\nError while parsing\n" ++ src)- hPutStrLn stderr err- return $ Left "Error while parsing"+data SomeBuildOpts v n =+ forall a. (Typeable a, DC.Backend a v n, Hashable (DC.Options a v n), MkImage (DC.Result a v n))+ => SomeBuildOpts (DB.BuildOpts a v n) - DB.InterpErr ierr -> do- hPutStrLn stderr ("\nError while interpreting\n" ++ src)- hPutStrLn stderr (DB.ppInterpError ierr)- return $ Left "Error while interpreting"+class MkImage a where+ mkImage :: FilePath -> a -> IO () - DB.Skipped hash -> do- hPutStr stderr "."- hFlush stderr- return $ Right (mkFile (DB.hashToHexStr hash))+instance MkImage (IO (), r) where+ mkImage _ = fst - DB.OK hash out -> do- hPutStr stderr "O"- hFlush stderr- fst out- return $ Right (mkFile (DB.hashToHexStr hash))+instance MkImage Svg.Element where+ mkImage path e = writeFile path $ show e - where- mkFile base = _outDir opts </> base <.> (backendExt $ _outFormat opts)- ensureDir dir = do- createDirectoryIfMissing True dir+mkBuildOpts :: Opts -> [(Text, Text)] -> Text -> SomeBuildOpts V2 Double+mkBuildOpts opts attrs src = case _backend opts of+ Cairo -> SomeBuildOpts $ DB.mkBuildOpts BCairo.Cairo zero+ ( BCairo.CairoOptions "default.png"+ (dims $ V2 (widthAttribute attrs) (heightAttribute attrs))+ (findCairoOutputType $ _outFormat opts)+ False+ )+ & DB.snippets .~ [T.unpack 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 .~ postProcess+ & DB.decideRegen .~+ DB.hashedRegenerate+ (\hash opts' -> opts' { BCairo._cairoFileName = mkFile opts hash })+ (_outDir opts)+ SVG -> SomeBuildOpts $ DB.mkBuildOpts BSvg.SVG zero+ (BSvg.SVGOptions (dims $ V2 (widthAttribute attrs) (heightAttribute attrs)) Nothing "" [] True)+ & DB.snippets .~ [T.unpack src]+ & DB.imports .~+ [ "Diagrams.TwoD.Types"+ , "Diagrams.Core.Points"+ , "Diagrams.Backend.SVG"+ , "Graphics.SVGFonts"+ , "Data.Typeable"+ ]+ & DB.pragmas .~ ["DeriveDataTypeable"]+ & DB.diaExpr .~ _expression opts+ & DB.postProcess .~ postProcess+ where+ postProcess = pad 1.1 . centerXY -widthAttribute :: [(String,String)] -> Double+widthAttribute :: [(Text,Text)] -> Double widthAttribute attrs = case lookup "width" attrs of Nothing -> 500- Just v -> read v :: Double+ Just v -> read (T.unpack v) :: Double -heightAttribute :: [(String,String)] -> Double+heightAttribute :: [(Text,Text)] -> Double heightAttribute attrs = case lookup "height" attrs of Nothing -> 200- Just v -> read v :: Double+ Just v -> read (T.unpack v) :: Double -readEcho :: [(String, String)] -> Echo+readEcho :: [(Text, Text)] -> Echo readEcho attrs = case lookup "echo" attrs of Nothing -> Below- Just v -> case map toLower v of+ Just v -> case T.toLower v of "above" -> Above- _ -> Below+ _ -> Below+