Pandoc filter for http://blockdiag.com diagrams

gistfile1.txt

Compile the Haskell code with ghc and put it somewhere convenient. Then call Pandoc as:

    pandoc -t json test.md | handleBlockdiag png | pandoc -f json -o test.html

handleBlockdiag.hs

-- Pandoc filter for Takeshi Komiya's Blockdiag (http://blockdiag.com)
--
-- Put your blockdiag source inside a code block and tag it with one of
-- the available diagram classes. You can pass extra options to the processor
-- by using an "options" attribute. If you want, you can set the name of the
-- generated image with the "name" attribute, else the name will be auto
-- generated. The images are saved in an "img" subdirectory which must exist.
--
-- Example:
--
-- ~~~~ {.blockdiag}
-- blockdiag {
--    A -> B -> C -> D;
--    A -> E -> F -> G;
-- }
-- ~~~~

import Text.Pandoc
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.List
import System.Directory(removeFile)
import System.Environment(getArgs)
import System.Exit(ExitCode(ExitSuccess))
import System.FilePath ((</>))
import System.IO
import System.Process(readProcessWithExitCode)

-- Available diagram classes, mapping directly to an executable.
diagrams = ["actdiag", "blockdiag", "nwdiag", "packetdiag", "rackdiag", "seqdiag"]


handleBlockdiag :: String -> Block -> IO Block
handleBlockdiag format (CodeBlock (_, classes, namevals) contents)
              | any (`elem` classes) diagrams = do
  let
    diag =
      case find (`elem` classes) diagrams of
        Just diag -> diag
        Nothing   -> error $ "blockdiag called with bad type. (This can't happen)"
    options =
      case lookup "options" namevals of
        Just opts -> opts
        Nothing -> ""
    imagesuffix =
      case format of
        -- Supposed to support eps too, but has unresolved dependencies
        "svg" -> ".svg"
        _     -> ".png"
    (name, outfile) =
      case lookup "name" namevals of
        Just name -> ([Str name], "img" </> name ++ imagesuffix)
        Nothing -> ([], "img" </> uniqueName contents ++ imagesuffix)

  (tempfile, temphd) <- openTempFile "." "diag"
  hPutStr temphd contents
  hClose temphd

  (ec, _out, err) <- readProcessWithExitCode
    diag
    (["-T", format, "-o", outfile] ++ words options ++ [tempfile])
    ""
  removeFile tempfile
  if ec == ExitSuccess
    then
      return $ Para [Image name (outfile, "")]
    else
      error $ "blockdiag returned an error status: " ++ err
handleBlockdiag _ x = return x


main :: IO ()
main = do
  args <- getArgs
  toJsonFilter
    $ handleBlockdiag
    $ case args of
        [f] -> f
        _   -> "" -- default


uniqueName :: String -> String
uniqueName = showDigest . sha1 . fromString

test.md

Testing block diagrams

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

Block diagram

blockdiag {
  // branching edges to multiple children
  A -> B, C;

  // branching edges from multiple parents
  D, E -> F;
}

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

Sequence diagram

seqdiag {
  // normal edge and doted edge
  A -> B [label = "normal edge"];
  B --> C [label = "dotted edge"];

  B <-- C [label = "return dotted edge"];
  A <- B [label = "return edge"];

  // asynchronus edge
  A ->> B [label = "asynchronus edge"];
  B -->> C [label = "asynchronus dotted edge"];

  B <<-- C [label = "return asynchronus dotted edge"];
  A <<- B [label = "return asynchronus edge"];

  // self referenced edge
  A -> A [label = "self reference edge"];
}

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

Rack diagram

rackdiag {
  // Change order of rack-number as ascending
  ascending;

  // define height of rack
  12U;

  // define description of rack
  description = "Tokyo/1234 East";

  // define rack units
  1: UPS [2U];   // define height of unit
  3: DB Server [5kg]  // define weight of unit
  4: Web Server [0.5A]  // define ampere of unit
  5: Web Server
  6: Web Server
  7: Load Balancer
  8: L3 Switch
}

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.