Dot.hs 1.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  1. module Dot (plugin) where
  2. -- This plugin allows you to include a graphviz dot diagram
  3. -- in a page like this:
  4. --
  5. -- ~~~ {.dot name="diagram1"}
  6. -- digraph G {Hello->World}
  7. -- ~~~
  8. --
  9. -- The "dot" executable must be in the path.
  10. -- The generated png file will be saved in the static img directory.
  11. -- If no name is specified, a unique name will be generated from a hash
  12. -- of the file contents.
  13. import Network.Gitit.Interface
  14. import System.Process (readProcessWithExitCode)
  15. import System.Exit (ExitCode(ExitSuccess))
  16. -- from the utf8-string package on HackageDB:
  17. import Data.ByteString.Lazy.UTF8 (fromString)
  18. -- from the SHA package on HackageDB:
  19. import Data.Digest.Pure.SHA (sha1, showDigest)
  20. import System.FilePath ((</>))
  21. plugin :: Plugin
  22. plugin = mkPageTransformM transformBlock
  23. transformBlock :: Block -> PluginM Block
  24. transformBlock (CodeBlock (_, classes, namevals) contents) | "dot" `elem` classes = do
  25. cfg <- askConfig
  26. let (name, outfile) = case lookup "name" namevals of
  27. Just fn -> ([Str fn], fn ++ ".png")
  28. Nothing -> ([], uniqueName contents ++ ".png")
  29. liftIO $ do
  30. (ec, _out, err) <- readProcessWithExitCode "dot" ["-Tpng", "-o",
  31. staticDir cfg </> "img" </> outfile] contents
  32. let attr = ("image", [], [])
  33. if ec == ExitSuccess
  34. then return $ Para [Image attr name ("/img" </> outfile, "")]
  35. else error $ "dot returned an error status: " ++ err
  36. transformBlock x = return x
  37. -- | Generate a unique filename given the file's contents.
  38. uniqueName :: String -> String
  39. uniqueName = showDigest . sha1 . fromString