diagrams-pandoc 0.1 → 0.2
raw patch · 5 files changed
+172/−140 lines, 5 filesdep +diagrams-pandocdep ~lineardep ~optparse-applicative
Dependencies added: diagrams-pandoc
Dependency ranges changed: linear, optparse-applicative
Files
- Main.hs +0/−125
- README.md +2/−8
- diagrams-pandoc.cabal +18/−7
- src/Main.hs +27/−0
- src/Text/Pandoc/Diagrams.hs +125/−0
− Main.hs
@@ -1,125 +0,0 @@-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"--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")
README.md view
@@ -44,14 +44,7 @@ ## Installing -`diagrams-pandoc` is not yet on Hackage. To install, clone this-repository, and install with cabal.--``` shell- git clone https://github.com/bergey/diagrams-pandoc.git- cd diagrams-pandoc- cabal install-```+`diagrams-pandoc` is on Hackage. To install, run `cabal install diagrams-pandoc` ## TODO @@ -61,3 +54,4 @@ * provide command-line flags to override default behavior * add Backends besides Cairo * Support RST by handling `Div class=diagram [CodeBlock foo bar]` the same as `CodeBlock class=diagram bar`+* Alternate install directions using `stack`
diagrams-pandoc.cabal view
@@ -1,8 +1,5 @@--- Initial diagrams-pandoc.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/- name: diagrams-pandoc-version: 0.1+version: 0.2 synopsis: A pandoc filter to express diagrams inline using the haskell EDSL _diagrams_ -- description: license: BSD3@@ -18,19 +15,33 @@ type: git location: http://github.com/diagrams/diagrams-pandoc.git +library+ build-depends: base >= 4.6 && < 4.9,+ pandoc-types >= 1.12.4.5 && < 1.13,+ diagrams-lib >= 1.3 && < 1.4,+ 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+ exposed-modules: Text.Pandoc.Diagrams+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall executable diagrams-pandoc- main-is: Main.hs+ main-is: src/Main.hs -- other-modules: -- other-extensions: build-depends: base >= 4.6 && < 4.9, pandoc-types >= 1.12.4.5 && < 1.13, diagrams-lib >= 1.3 && < 1.4,- linear >= 1.10 && < 1.20,+ 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,- optparse-applicative >= 0.11 && < 0.12+ diagrams-pandoc >= 0.2 && < 0.3,+ optparse-applicative >= 0.11 && < 0.13 -- hs-source-dirs: default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,27 @@+module Main where++import Text.Pandoc.Diagrams++import Options.Applicative+import Text.Pandoc.JSON++main :: IO ()+main = do+ opts <- execParser withHelp+ toJSONFilter $ insertDiagrams opts++optsParser :: Parser Opts+optsParser = Opts+ <$> strArgument (help "target output format from pandoc" <> value "html")+ <*> 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 insert images in Pandoc output\nhttps://github.com/bergey/diagrams-pandoc"+ <> header "diagrams-pandoc - a Pandoc filter for inline Diagrams")
+ src/Text/Pandoc/Diagrams.hs view
@@ -0,0 +1,125 @@+-- | Convert appropriately annotated Code blocks to an image, with or+-- without display of the code. Interpret the Code blocks as Haskell+-- code using the Diagrams libraries.++module Text.Pandoc.Diagrams where++import Control.Monad (when)+import Data.Char (toLower)+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 System.Directory (createDirectory,+ doesDirectoryExist)+import System.FilePath ((<.>), (</>))+import System.IO+import Text.Pandoc.Definition++-- TODO choose output format based on pandoc target+backendExt :: String+backendExt = "png"++data Opts = Opts {+ _outFormat :: String, -- ^ Not currently used+ _outDir :: FilePath,+ _expression :: String+ }++data Echo = Above | Below++insertDiagrams :: Opts -> Block -> IO [Block]+insertDiagrams opts (CodeBlock (ident, classes, attrs) code)+ | "diagram-haskell" `elem` classes = do+ i <- img+ return $ case echo of+ Above -> [bl', i]+ Below -> [i, bl']+ | "diagram" `elem` classes = (:[]) <$> img+ where+ img = do+ d <- compileDiagram opts code+ return $ case d of+ Left _err -> Null -- TODO log an error here+ Right imgName -> Plain [Image [] (imgName,"")] -- no alt text, no title+ bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code+ echo = readEcho attrs+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++readEcho :: [(String, String)] -> Echo+readEcho attrs = case lookup "echo" attrs of+ Nothing -> Below+ Just v -> case map toLower v of+ "above" -> Above+ _ -> Below