diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/diagrams-pandoc.cabal b/diagrams-pandoc.cabal --- a/diagrams-pandoc.cabal +++ b/diagrams-pandoc.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Text/Pandoc/Diagrams.hs b/src/Text/Pandoc/Diagrams.hs --- a/src/Text/Pandoc/Diagrams.hs +++ b/src/Text/Pandoc/Diagrams.hs @@ -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 +