diff --git a/BlogLiterately-diagrams.cabal b/BlogLiterately-diagrams.cabal new file mode 100644 --- /dev/null +++ b/BlogLiterately-diagrams.cabal @@ -0,0 +1,87 @@ +name: BlogLiterately-diagrams +version: 0.1.0.0 +synopsis: Include images in blog posts with inline diagrams code +description: A plugin for @BlogLiterately@ () which turns inline diagrams + code into images. + This library also provides an executable, + @BlogLiteratelyD@, providing a standard instance + of @BlogLiterately@ extended with support for + inline diagrams code (and also including a pass + to center block-level images). For most users it + should suffice to simply use @BlogLiteratelyD@ in + place of @BlogLiterately@. + . + To use it, include code blocks with the @dia@ or + @dia-def@ class (using pandoc's special extended + Markdown syntax + (), + or BlogLiterately's extended syntax for tagged + code blocks + ()), + like so: + . + > [dia-def] + > -- This block produces no output but its + > -- declarations will be in scope in all the + > -- rest of the diagram blocks. + > + > gSq = square 1 # fc green + > + > NOTE: Square brackets below should be replaced + > by curly braces. Haddock chokes on curly + > braces. + > + > Here is a green square: + > + > ```[.dia width='200'] + > dia = gSq + > ``` + > + > Green squares like `gSq`[.dia height='16'] + > and blue circles like `circle 1 # fc blue`[.dia height='16'] + > are extremely important. + . + Note that attributes like width and height can + also be specified, but be sure to put the numbers + in quotes or else they will not parse properly. + . + Running this through @BlogLiteratelyD@ (after + replacing square brackets with curly braces) + should result in HTML that looks something like + this: + . + <> +license: BSD3 +license-file: LICENSE +author: Brent Yorgey +maintainer: byorgey@cis.upenn.edu +copyright: Copyright 2012 Brent Yorgey +category: Web +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: darcs + location: http://code.haskell.org/~byorgey/code/BlogLiterately-diagrams + +library + default-language: Haskell2010 + exposed-modules: Text.BlogLiterately.Diagrams + build-depends: base >= 4.3 && < 4.6, + containers, + filepath, + diagrams-cairo >= 0.5 && < 0.6, + diagrams-builder ==0.2.*, + diagrams-lib ==0.5.*, + BlogLiterately ==0.5.*, + pandoc ==1.9.*, + safe ==0.3.* + hs-source-dirs: src + +executable BlogLiteratelyD + build-depends: base, + BlogLiterately >= 0.5.2 && < 0.6, + BlogLiterately-diagrams + main-is: BlogLiteratelyD.hs + hs-source-dirs: src/tools + default-language: Haskell2010 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Brent Yorgey + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Brent Yorgey nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Text/BlogLiterately/Diagrams.hs b/src/Text/BlogLiterately/Diagrams.hs new file mode 100644 --- /dev/null +++ b/src/Text/BlogLiterately/Diagrams.hs @@ -0,0 +1,164 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.BlogLiterately.Diagrams +-- Copyright : (c) Brent Yorgey 2012 +-- License : BSD-style (see LICENSE) +-- Maintainer : Brent Yorgey +-- +-- Custom transformation passes for the @BlogLiterately@ blog-writing +-- tool (), +-- allowing inclusion of inline code using the @diagrams@ framework +-- () which are compiled into +-- images. See "Text.BlogLiterately.Run" for more information. +-- +-- Note that this package provides an executable, @BlogLiteratelyD@, +-- which uses the transformation pipeline +-- +-- > (diagramsInlineXF : diagramsXF : centerImagesXF : standardTransforms) +----------------------------------------------------------------------------- + +module Text.BlogLiterately.Diagrams + ( diagramsXF, diagramsInlineXF + ) where + +import Control.Arrow +import Data.List (isPrefixOf) +import qualified Data.Map as M +import Safe (readMay, headDef) +import System.FilePath +import System.IO (stderr, hPutStrLn) + +import Diagrams.Backend.Cairo +import Diagrams.Backend.Cairo.Internal +import Diagrams.Builder +import Diagrams.Prelude (R2, zeroV) +import Diagrams.TwoD.Size ( SizeSpec2D(Dims), mkSizeSpec ) +import Text.BlogLiterately +import Text.Pandoc + +-- | Transform a blog post by looking for code blocks with class +-- @dia@, and replacing them with images generated by evaluating the +-- identifier @dia@ and rendering the resulting diagram. In +-- addition, blocks with class @dia-def@ are collected (and deleted +-- from the output) and provided as additional definitions that will +-- be in scope during evaluation of all @dia@ blocks. +-- +-- Be sure to use this transform /before/ the standard +-- 'Text.BlogLiterately.Transform.highlightXF' transform, /i.e./ +-- with the 'Text.BlogLiterately.Run.blogLiteratelyCustom' function. +-- For example, +-- +-- > main = blogLiteratelyCustom (diagramsXF : standardTransforms) +-- +-- It also works well in conjunction with +-- 'Text.BlogLiterately.Transform.centerImagesXF' (which, of course, +-- should be placed after @diagramsXF@ in the pipeline). This +-- package provides an executable @BlogLiteratelyD@ which +-- includes @diagramsInlineXF@, @diagramsXF@, and @centerImagesXF@. +diagramsXF :: Transform +diagramsXF = Transform (\bl -> Kleisli $ renderBlockDiagrams bl) (const True) + +renderBlockDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc +renderBlockDiagrams _ p = bottomUpM (renderBlockDiagram defs) p + where + defs = queryWith extractDiaDef p + +-- | Transform a blog post by looking for /inline/ code snippets with +-- class @dia@, and replacing them with images generated by +-- evaluating the contents of each code snippet as a Haskell +-- expression representing a diagram. Any code blocks with class +-- @dia-def@ will be in scope for the evaluation of these +-- expressions (such code blocks are unaffected). +-- +-- Because @diagramsXF@ and @diagramsInlineXF@ both use blocks with +-- class @dia-def@, but @diagramsInlineXF@ leaves them alone whereas +-- @diagramsXF@ deletes them, @diagramsInlineXF@ must be placed +-- before @diagramsXF@ in the pipeline. +diagramsInlineXF :: Transform +diagramsInlineXF = Transform (\bl -> Kleisli $ renderInlineDiagrams bl) (const True) + +renderInlineDiagrams :: BlogLiterately -> Pandoc -> IO Pandoc +renderInlineDiagrams _ p = bottomUpM (renderInlineDiagram defs) p + where + defs = queryWith extractDiaDef p + +extractDiaDef :: Block -> [String] +extractDiaDef (CodeBlock (_, as, _) s) + = [src | "dia-def" `elem` (maybe id (:) tag) as] + where + (tag, src) = unTag s + +extractDiaDef b = [] + +diaDir = "diagrams" -- XXX make this configurable + +-- | Given some code with declarations, some attributes, and an +-- expression to render, render it and return the filename of the +-- generated image (or an error message). +renderDiagram :: [String] -- ^ Declarations + -> String -- ^ Expression to render + -> Attr -- ^ Code attributes + -> IO (Either String FilePath) +renderDiagram decls expr attr@(ident, cls, fields) = do + res <- buildDiagram + Cairo + (zeroV :: R2) + (CairoOptions "default.png" size PNG) + decls + (expr ++ " {- " ++ show attr ++ " -}") + -- the above hack is to make sure that changing + -- attributes results in the diagram being recompiled. + [] + ["Diagrams.Backend.Cairo"] + (hashedRegenerate + (\hash opts -> opts { cairoFileName = mkFile hash }) + diaDir + ) + case res of + ParseErr err -> do + let errStr = "\nParse error:\n" ++ err + putErrLn errStr + return (Left errStr) + InterpErr ierr -> do + let errStr = "\nInterpreter error:\n" ++ ppInterpError ierr + putErrLn errStr + return (Left errStr) + Skipped hash -> return (Right $ mkFile hash) + OK hash (act,_) -> act >> return (Right $ mkFile hash) + + where + size = mkSizeSpec + (lookup "width" fields >>= readMay) + (lookup "height" fields >>= readMay) + mkFile base = diaDir base <.> "png" + +renderBlockDiagram :: [String] -> Block -> IO Block +renderBlockDiagram defs c@(CodeBlock attr@(_, cls, _) s) + | "dia-def" `elem` tags = return Null + | "dia" `elem` tags = do + res <- renderDiagram (src : defs) "pad 1.1 dia" attr + case res of + Left err -> return (CodeBlock attr (s ++ err)) + Right file -> return $ Para [Image [] (file, "")] + + | otherwise = return c + + where + (tag, src) = unTag s + tags = (maybe id (:) tag) cls + +renderBlockDiagram _ b = return b + +renderInlineDiagram :: [String] -> Inline -> IO Inline +renderInlineDiagram defs c@(Code attr@(_, cls, _) expr) + | "dia" `elem` cls = do + res <- renderDiagram defs expr attr + case res of + Left err -> return (Code attr (expr ++ err)) + Right file -> return $ Image [] (file, "") + | otherwise = return c + +renderInlineDiagram _ i = return i + +putErrLn :: String -> IO () +putErrLn = hPutStrLn stderr diff --git a/src/tools/BlogLiteratelyD.hs b/src/tools/BlogLiteratelyD.hs new file mode 100644 --- /dev/null +++ b/src/tools/BlogLiteratelyD.hs @@ -0,0 +1,5 @@ +import Text.BlogLiterately +import Text.BlogLiterately.Diagrams + +main = blogLiteratelyCustom + (diagramsInlineXF : diagramsXF : centerImagesXF : standardTransforms)