diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -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") diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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` diff --git a/diagrams-pandoc.cabal b/diagrams-pandoc.cabal --- a/diagrams-pandoc.cabal +++ b/diagrams-pandoc.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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") diff --git a/src/Text/Pandoc/Diagrams.hs b/src/Text/Pandoc/Diagrams.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Diagrams.hs @@ -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