diagrams-builder (empty) → 0.2.0.0
raw patch · 8 files changed
+790/−0 lines, 8 filesdep +basedep +base16-bytestringdep +bytestringsetup-changed
Dependencies added: base, base16-bytestring, bytestring, cmdargs, cryptohash, diagrams-builder, diagrams-cairo, diagrams-lib, directory, filepath, haskell-src-exts, hint
Files
- CHANGES +3/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- diagrams-builder.cabal +88/−0
- latex/diagrams-latex.sty +224/−0
- src/Diagrams/Builder.hs +249/−0
- src/Diagrams/Builder/Modules.hs +117/−0
- src/tools/diagrams-builder-cairo.hs +77/−0
+ CHANGES view
@@ -0,0 +1,3 @@+* 0.2.0.0: 26 August 2012++ Initial release
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ diagrams-builder.cabal view
@@ -0,0 +1,88 @@+name: diagrams-builder+version: 0.2.0.0+synopsis: hint-based build service for the diagrams graphics EDSL.++description: @diagrams-builder@ provides backend-agnostic tools for+ dynamically turning code into rendered diagrams,+ using the @hint@ wrapper to the GHC API. It+ supports conditional recompilation using hashing+ of diagrams source code, to avoid recompiling+ code that has not changed. It is useful for+ creating tools which compile diagrams code+ embedded in other documents. For example, it is+ used by the @BlogLiterately-diagrams@ package (a+ plugin for @BlogLiterately@) to compile diagrams+ embedded in Markdown-formatted blog posts.+ .+ An executable specific to the cairo backend is+ included (more executables specific to other+ backends will be included in the future). It+ takes an input file and an expression to render+ and outputs an image file, using the cairo+ backend. If you want it you must explicitly+ enable the cairo flag with @-fcairo@.+ .+ A LaTeX package, @diagrams-latex.sty@, is also+ provided in the @latex/@ directory of the source+ distribution, which renders diagrams code found+ within @diagram@ environments. It makes use of+ the @diagrams-builder-cairo@ executable, so if+ you want to use @diagrams-latex.sty@ you should+ install @diagrams-builder@ with the @-fcairo@+ option. Note that @diagrams-latex.sty@ is+ licensed under the GPL.+homepage: http://projects.haskell.org/diagrams+license: BSD3+license-file: LICENSE+extra-source-files: CHANGES, latex/diagrams-latex.sty+author: Brent Yorgey+maintainer: diagrams-discuss@googlegroups.com+category: Graphics+build-type: Simple+cabal-version: >=1.10+bug-reports: https://github.com/diagrams/diagrams-builder/issues+Source-repository head+ type: git+ location: https://github.com/diagrams/diagrams-builder++library+ exposed-modules: Diagrams.Builder+ Diagrams.Builder.Modules+ build-depends: base >=4.2 && < 4.7,+ diagrams-lib >=0.3 && < 0.6,+ hint ==0.3.*,+ directory,+ filepath,+ haskell-src-exts >= 1.13.1 && < 1.14,+ cryptohash >= 0.7.4 && < 0.8,+ bytestring >= 0.9.2 && < 0.10,+ base16-bytestring >= 0.1.1 && < 0.2+ hs-source-dirs: src+ default-language: Haskell2010+ other-extensions: StandaloneDeriving,+ DeriveDataTypeable,+ ScopedTypeVariables,+ FlexibleContexts++flag cairo+ description: install cairo-specific builder tool+ default: False++executable diagrams-builder-cairo+ main-is: diagrams-builder-cairo.hs+ hs-source-dirs: src/tools+ default-language: Haskell2010+ other-extensions: StandaloneDeriving,+ DeriveDataTypeable++ if !flag(cairo)+ buildable: False++ if flag(cairo)+ build-depends: base >= 4 && < 5,+ filepath,+ directory,+ diagrams-builder,+ diagrams-lib >= 0.5 && < 0.6,+ diagrams-cairo >= 0.5 && < 0.6,+ cmdargs >= 0.6 && < 0.11
+ latex/diagrams-latex.sty view
@@ -0,0 +1,224 @@+%% To use, simply create diagram environments with code, being sure to+%% declare something named 'dia' in each, which will be rendered. For example:+%%+%% \begin{diagram}[width=200]+%% import Data.List+%% dia = hcat . map circle . sort $ [4,8,9,2,3,6]+%% \end{diagram}+++%% diagrams-latex.sty+%% Copyright (c) 2011-2012, Ryan Yates+%% +%% Large portions copied from dot2texi.sty+%%+%% Copyright (c) 2007-2008, Kjell Magne Fauske+%%+%% Author: Kjell Magne Fauske <km@fauskes.net>+%% http://www.fauskes.net+%%++%% Copyright (c) 2005, Lars Kotthoff <metalhead@metalhead.ws>+%%+%% Large portions copied from pdftex,+%% Copyright (c) 2001-3, Radhakrishnan CV <cvr@river-valley.com>+%% Rajagopal CV <cvr3@river-valley.com>+%% http://www.river-valley.com+%%+%% River Valley Technologies, Floor III, SJP Buildings, Cotton Hills+%% Trivandrum, India 695014+%%+%% Tel: +91 471 233 7501+%%+%% Antoine Chambert-Loir+%% <chambert@math.polytechnique.fr>+%% http://www.math.polytechnique.fr/\protect \unhbox \voidb@x \penalty \@M \ {}chambert+%%+%% Ecole polytechnique, Palaiseau Cedex, France+%%+%% This program is free software; you can redistribute it and/or+%% modify it under the terms of the GNU General Public License+%% as published by the Free Software Foundation; either version 2+%% of the License, or (at your option) any later version.+%%+%% This program is distributed in the hope that it will be useful,+%% but WITHOUT ANY WARRANTY; without even the implied warranty of+%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+%% GNU General Public License for more details.+%%+%% You should have received a copy of the GNU General Public License+%% along with this program (gpl.txt); if not, write to the Free+%% Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,+%% MA 02111-1307, USA.+%%++%% Copyright (C) 2007 by Will Robertson & Johannes Große++\NeedsTeXFormat{LaTeX2e}[1999/12/01]+\ProvidesPackage{diagrams-latex}[2012/04/07 v0.1 Generate diagrams embedded within LaTeX]+\RequirePackage{moreverb}+\RequirePackage{xkeyval}[2005/02/22]++\newif\ifdtt@ShellEscape+%\newif\ifmiktex \miktexfalse+\newif\ifdtt@ForceShellEscape \dtt@ForceShellEscapefalse+\newif\ifdtt@debug \dtt@debugfalse+\newif\ifdtt@autosize \dtt@autosizefalse+% Options related to shell escape+\DeclareOptionX{shell}{\dtt@ShellEscapetrue}+\DeclareOptionX{noshell}{\dtt@ShellEscapefalse}+\DeclareOptionX{forceshell}{\dtt@ForceShellEscapetrue\dtt@ShellEscapetrue}+\DeclareOptionX{miktex}{} % dummy (for backwards compatability)++% Options for setting output size+\DeclareOptionX{width}[]{\def\dtt@width{-w #1}}+\def\dtt@width{} % default output width+\DeclareOptionX{height}[]{\def\dtt@height{-h #1}}+\def\dtt@height{} % default output height++% Option for setting an output directory+\DeclareOptionX{outputdir}[]{\def\dtt@outputdir{#1}}+\def\dtt@outputdir{}+\DeclareOptionX{debug}{\dtt@debugtrue}++\newcommand\setoutputdir[1]{\def\dtt@outputdir{#1}}++\ExecuteOptionsX{shell}++\ProcessOptionsX\relax+++%% The platform detection code is copied from the ifplatform package+%% avaialable from: http://tug.ctan.org/tex-archive/macros/latex/contrib/ifplatform/+%% Copyright (C) 2007 by Will Robertson & Johannes Große+\newif\ifdtt@ShellEscapeEnabled+\newif\ifwindows+\edef\ip@file{\jobname.w18}+\edef\ip@sig{write18-test-\the\year\the\month\the\day\the\time}+\edef\ip@win{'\ip@sig'}+\def\ip@read@file{%+ \newread\instream+ \openin\instream=\ip@file+ \@tempcnta=\endlinechar+ \endlinechar=-1+ \read\instream to\@tempa+ \endlinechar=\@tempcnta+ \closein\instream}+\immediate\write18{echo \ip@win >"\ip@file"}+\IfFileExists{\ip@file}{\dtt@ShellEscapeEnabledtrue}{\dtt@ShellEscapeEnabledfalse}+\ifdtt@ShellEscapeEnabled+ \ip@read@file+ \ifx\@tempa\ip@sig+ \windowsfalse+ \else+ \ifx\@tempa\ip@win+ \windowstrue+ \fi+ \fi+ \immediate\write18{\ifwindows del \else rm -- \fi "\ip@file"}+\fi++\ifdtt@ForceShellEscape+ \PackageInfo{diagrams-latex}+ {ForceShellEscape enabled}+\fi++\ifdtt@ShellEscapeEnabled+ \PackageInfo{diagrams-latex}+ {XXX}+\else+ \PackageWarningNoLine{diagrams-latex}+ {Shell escape not enabled.\MessageBreak+ You'll need to compile the diagrams yourself.}+\fi+\newcounter{dtt@fignum}+\def\dtt@figname{\dtt@outputdir\jobname-diagrams-latex-fig\thedtt@fignum}+++%%%%%%%%%%%%%%%%% diagrams-latex code+% Most of the code is from dot2texi.sty++% Options+\define@key{dtt}{width}[]{%+ \def\dtt@width{-w #1}+}+\define@key{dtt}{height}[]{%+ \def\dtt@height{-h #1}+}++\define@key{dtt}{outputdir}[]{%+ \def\dtt@outputdir{#1}+}+\define@key{dtt}{file}[]{%+ \def\dtt@figname{\dtt@outputdir#1}+}++\define@key{dtt}{shell}[]{\dtt@ShellEscapetrue}+\define@key{dtt}{noshell}[]{\dtt@ShellEscapefalse}++\newif\ifdtt@writetofile \dtt@writetofiletrue++\newwrite\verbatim@out+\def\diagramslatexverbatimwrite#1{%+ \def\BeforeStream{+ \message{Opening diagrams-latex stream #1}%+ }%+ \@bsphack+ \immediate\openout \verbatim@out #1+ \BeforeStream%+ \let\do\@makeother\dospecials+ \catcode`\^^M\active+ \def\verbatim@processline{%+ \immediate\write\verbatim@out+ {\the\verbatim@line}}%+ \verbatim@start%+}++\def\enddiagramslatexverbatimwrite{%+ \immediate\closeout\verbatim@out+ \@esphack+ \catcode`\\0+ \catcode`\{1+ \catcode`\}2+ \catcode`\$3+ \catcode`\&4+ \catcode`\^^M5+ \catcode`\#6+ \catcode`\^7+ \catcode`\_8+ \catcode`\~9% Added this one+ \catcode`\ 10+ \catcode`\%14}++\newenvironment{diagram}[1][]{\stepcounter{dtt@fignum}%+ \setkeys{dtt}{#1}+ \ifdtt@ForceShellEscape+ \dtt@ShellEscapetrue+ \fi+ \xdef\diagramslatexCutFile{\dtt@figname.txt}+ \diagramslatexverbatimwrite{\diagramslatexCutFile}}+ {\enddiagramslatexverbatimwrite%+ \diagramslatexgraphicsinclude}++\long\gdef\diagramslatexgraphicsprocess{%+ \ifdtt@ShellEscape+ \IfFileExists{\dtt@figname.txt}{%+ \immediate\write18{diagrams-builder-cairo -o \dtt@figname.pdf\space+ \dtt@width\space+ \dtt@height\space+ \dtt@figname.txt\space }%+ \IfFileExists{\dtt@figname.pdf}{%+ \PackageInfo{diagrams-latex}{\dtt@figname.txt converted}+ }+ {\PackageWarningNoLine{diagrams-latex}+ {Conversion of \dtt@figname.txt failed}}}{}+ \fi+}++\long\gdef\diagramslatexgraphicsinclude{\diagramslatexgraphicsprocess%+ \IfFileExists{\dtt@figname.pdf}{{\includegraphics{\dtt@figname.pdf}}}+ {\PackageWarningNoLine{diagrams-latex}+ {Please convert \dtt@figname.txt manually}}+}++\endinput
+ src/Diagrams/Builder.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE StandaloneDeriving+ , DeriveDataTypeable+ , ScopedTypeVariables+ , FlexibleContexts+ #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Builder+-- Copyright : (c) 2012 diagrams-lib team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Tools for dynamically building diagrams, for /e.g./ creating+-- preprocessors to interpret diagrams code embedded in documents.+--+-----------------------------------------------------------------------------+module Diagrams.Builder+ ( -- * Building diagrams++ buildDiagram, BuildResult(..)+ , ppInterpError++ -- ** Regeneration decision functions+ , alwaysRegenerate, hashedRegenerate++ -- * Interpreting diagrams+ -- $interp+ , setDiagramImports+ , interpretDiagram++ ) where++import Diagrams.Builder.Modules++import Diagrams.Prelude hiding ((<.>), e)++import Language.Haskell.Exts (prettyPrint)+import Language.Haskell.Interpreter hiding (ModuleName)++import System.IO+import System.FilePath+import System.Directory++import Crypto.Hash.MD5++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Base16+import Data.List (nub)+import Data.Typeable+deriving instance Typeable Any++------------------------------------------------------------+-- Interpreting diagrams+------------------------------------------------------------++-- $interp+-- These functions constitute the internals of diagrams-builder. End+-- users should not usually need to call them directly; use+-- 'buildDiagram' instead.++-- | Set up the module to be interpreted, in the context of the+-- necessary imports.+setDiagramImports :: MonadInterpreter m+ => String -- ^ Filename of the module containing the diagrams+ -> [String] -- ^ Additional necessary+ -- imports. @Prelude@,+ -- @Diagrams.Prelude@,+ -- @Graphics.Rendering.Diagrams.Core@,+ -- and @Data.Monoid@ are included+ -- by default.+ -> m ()+setDiagramImports m imps = do+ loadModules [m]+ setTopLevelModules [takeBaseName m]+ setImports $ [ "Prelude"+ , "Diagrams.Prelude"+ , "Graphics.Rendering.Diagrams.Core"+ , "Data.Monoid"+ ]+ ++ imps++-- | Interpret a diagram expression based on the contents of a given+-- source file, using some backend to produce a result.+interpretDiagram :: forall b v.+ ( Typeable b, Typeable v+ , InnerSpace v, OrderedField (Scalar v), Backend b v+ )+ => b -- ^ Backend token+ -> v -- ^ Dummy vector to identify the vector space+ -> Options b v -- ^ Rendering options+ -> FilePath -- ^ Filename of the module containing the example+ -> [String] -- ^ Additional imports needed+ -> String -- ^ Expression of type @Diagram b v@ to be compiled+ -> IO (Either InterpreterError (Result b v))+interpretDiagram b _ opts m imps dexp =+ runInterpreter $ do+ setDiagramImports m imps+ d <- interpret dexp (as :: Diagram b v)+ return (renderDia b opts d)++-- | Pretty-print an @InterpreterError@.+ppInterpError :: InterpreterError -> String+ppInterpError (UnknownError err) = "UnknownError: " ++ err+ppInterpError (WontCompile es) = unlines . nub . map errMsg $ es+ppInterpError (NotAllowed err) = "NotAllowed: " ++ err+ppInterpError (GhcException err) = "GhcException: " ++ err++------------------------------------------------------------+-- Build a diagram using a temporary file+------------------------------------------------------------++-- | Potential results of a dynamic diagram building operation.+data BuildResult b v x =+ ParseErr String -- ^ Parsing of the code failed.+ | InterpErr InterpreterError -- ^ Interpreting the code+ -- failed. See 'ppInterpError'.+ | Skipped x -- ^ This diagram did not need to be+ -- regenerated.+ | OK x (Result b v) -- ^ A successful build, yielding a+ -- backend-specific result and+ -- some extra information.++-- | Build a diagram by writing the given source code to a temporary+-- module and interpreting the given expression. Can return either+-- a parse error if the source does not parse, an interpreter error,+-- or the final result.+buildDiagram :: ( Typeable b, Typeable v+ , InnerSpace v, OrderedField (Scalar v), Backend b v+ )+ => b -- ^ Backend token+ -> v -- ^ Dummy vector to fix the vector type+ -> Options b v -- ^ Backend-specific options to use+ -> [String] -- ^ Source code snippets. Each should+ -- be a syntactically valid Haskell+ -- module. They will be combined+ -- intelligently, /i.e./ not just+ -- pasted together textually but+ -- combining pragmas, imports,+ -- /etc./ separately.+ -> String -- ^ Diagram expression to interpret+ -> [String] -- ^ Extra @LANGUAGE@ pragmas to use+ -- (@NoMonomorphismRestriction@ is used+ -- by default.)+ -> [String] -- ^ Additional imports+ -- ("Diagrams.Prelude" is imported by+ -- default).+ -> (String -> IO (x, Maybe (Options b v -> Options b v)))+ -- ^ A function to decide whether a+ -- particular diagram needs to be+ -- regenerated. It will be passed+ -- the final assembled source for the+ -- diagram (but with the module name+ -- set to @Main@ instead of something+ -- auto-generated, so that hashing+ -- the source will produce consistent+ -- results across runs). It can+ -- return some information (such as a+ -- hash of the source) via the @x@+ -- result, which will be passed+ -- through to the result of+ -- 'buildDiagram'. More importantly,+ -- it decides whether the diagram+ -- should be built: a result of+ -- 'Just' means the diagram /should/+ -- be built; 'Nothing' means it+ -- should not. In the case that it+ -- should be built, it returns a+ -- function for updating the+ -- rendering options. This could be+ -- used, /e.g./, to request a+ -- filename based on a hash of the+ -- source.+ --+ -- Two standard decision functions+ -- are provided for convenience:+ -- 'alwaysRegenerate' returns no+ -- extra information and always+ -- decides to regenerate the diagram;+ -- 'hashedRegenerate' creates a hash+ -- of the diagram source and looks+ -- for a file with that name in a+ -- given directory.+ -> IO (BuildResult b v x)+buildDiagram b v opts source dexp langs imps shouldRegen = do+ let source' = map unLit source+ case createModule+ Nothing+ ("NoMonomorphismRestriction" : langs)+ ("Diagrams.Prelude" : imps)+ source' of+ Left err -> return (ParseErr err)+ Right m -> do+ regen <- shouldRegen (prettyPrint m ++ dexp)+ case regen of+ (info, Nothing) -> return $ Skipped info+ (info, Just upd) -> do+ tmpDir <- getTemporaryDirectory+ (tmp, h) <- openTempFile tmpDir ("Diagram.hs")+ let m' = replaceModuleName (takeBaseName tmp) m+ hPutStr h (prettyPrint m')+ hClose h++ compilation <- interpretDiagram b v (upd opts) tmp imps dexp+ removeFile tmp+ return $ either InterpErr (OK info) compilation++-- | Convenience function suitable to be given as the final argument+-- to 'buildDiagram'. It implements the simple policy of always+-- rebuilding every diagram.+alwaysRegenerate :: String -> IO ((), Maybe (a -> a))+alwaysRegenerate _ = return ((), Just id)++-- | Convenience function suitable to be given as the final argument+-- to 'buildDiagram'. It works by hashing the given diagram source,+-- and looking in the specified directory for any file whose base+-- name is equal to the hash. If there is such a file, it specifies+-- that the diagram should not be rebuilt. Otherwise, it specifies+-- that the diagram should be rebuilt, and uses the provided+-- function to update the rendering options based on the generated+-- hash. (Most likely, one would want to set the requested output+-- file to the hash followed by some extension.) It also returns+-- the generated hash.+hashedRegenerate :: (String -> a -> a) -- ^ A function for computing+ -- an update to rendering+ -- options, given a new base+ -- filename computed from a+ -- hash of the diagram+ -- source.+ -> FilePath -- ^ The directory in which to+ -- look for generated files+ -> String -- ^ The \"source\" to+ -- hash. Note that this does+ -- not actually have to be+ -- valid source code. A+ -- common trick is to+ -- concatenate the actual+ -- source code with String+ -- representations of any+ -- other information on which+ -- the diagram depends.+ -> IO (String, Maybe (a -> a))+hashedRegenerate upd dir src = do+ let fileBase = B.unpack . encode . hash . B.pack $ src+ files <- getDirectoryContents dir+ case any ((fileBase==) . takeBaseName) files of+ True -> return (fileBase, Nothing)+ False -> return (fileBase, Just (upd fileBase))
+ src/Diagrams/Builder/Modules.hs view
@@ -0,0 +1,117 @@+-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Builder.Modules+-- Copyright : (c) 2012 diagrams-lib team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Tools used by diagrams-builder for manipulating Haskell modules.+--+-----------------------------------------------------------------------------++module Diagrams.Builder.Modules where++import Data.Function (on)+import Data.List (foldl1', isPrefixOf, groupBy, sortBy, nub)+import Data.Ord (comparing)++import Language.Haskell.Exts+import Language.Haskell.Exts.SrcLoc (noLoc)++------------------------------------------------------------+-- Manipulating modules+------------------------------------------------------------++-- | Extend some snippets of source code into a proper module, by+-- combining them intelligently (preserving imports, pragmas, /etc./),+-- (possibly) giving it a different name, and adding @LANGUAGE@ pragmas+-- and imports if necessary. Only those pragmas and imports which+-- are not already included in the code will be added.+--+-- Returns the updated module, or an error message if parsing+-- failed.+createModule :: Maybe String -- ^ Module name to use+ -> [String] -- ^ @LANGUAGE@ pragmas to add+ -> [String] -- ^ Imports to add+ -> [String] -- ^ Source code+ -> Either String Module+createModule _ _ _ [] = Left "createModule: no source code given"+createModule nm langs imps srcs = do+ ms <- mapM doModuleParse srcs+ return+ . deleteExports+ . maybe id replaceModuleName nm+ . addPragmas langs+ . addImports imps+ . foldl1' combineModules+ $ ms++-- | Run the haskell-src-exts parser on a @String@ representing some+-- Haskell code, producing a @Module@ or an error message.+doModuleParse :: String -> Either String Module+doModuleParse src =+ case parseFileContents src of+ ParseFailed _ err -> Left err+ ParseOk m -> return m++-- | Remove all the literate comments and bird tracks from a literate+-- Haskell file. Has no effect on non-literate source.+unLit :: String -> String+unLit src+ | any ("> " `isPrefixOf`) ls = unlines . map (drop 2) . filter ("> " `isPrefixOf`) $ ls+ | otherwise = src+ where ls = lines src++-- | Replace the name of a module.+replaceModuleName :: String -> Module -> Module+replaceModuleName m (Module l _ p w e i d) = Module l (ModuleName m) p w e i d++-- | Delete module exports.+deleteExports :: Module -> Module+deleteExports (Module l n p w _ i d) = Module l n p w Nothing i d++-- | Add some @LANGUAGE@ pragmas to a module if necessary.+addPragmas :: [String] -> Module -> Module+addPragmas langs (Module l n p w e i d) = Module l n (f p) w e i d+ where f [] = [LanguagePragma noLoc (map Ident langs)]+ f (LanguagePragma loc ps : rest) = LanguagePragma loc (ps ++ map Ident langs) : rest+ f (x : rest) = x : f rest++-- | Add some imports to a module if necessary.+addImports :: [String] -> Module -> Module+addImports imps (Module l n p w e i d) = Module l n p w e (foldr addImport i imps) d+ where addImport imp is+ | any ((==imp) . getModuleName . importModule) is = is+ | otherwise = ImportDecl noLoc (ModuleName imp) False False Nothing Nothing Nothing : is++-- | Combine two modules into one, with a left bias in the case of+-- things that can't be sensibly combined (/e.g./ the module name).+-- Note that combining multiple imports of the same module with+-- different import specifications (qualification, hiding, explicit+-- import) is unlikely to work sensibly.+combineModules :: Module -> Module -> Module+combineModules (Module l1 n1 ps1 w1 e1 i1 d1)+ (Module _ _ ps2 _ _ i2 d2) =+ Module l1 n1 combinedPragmas w1 e1 combinedImports (d1 ++ d2)+ where+ combinedPragmas = combinedLangPragmas ++ otherPragmas ps1 ++ otherPragmas ps2+ combinedImports = map head+ . groupBy ((==) `on` importModule)+ . sortBy (comparing importModule)+ $ i1 ++ i2++ combinedLangPragmas+ = [LanguagePragma noLoc (nub (getLangPragmas ps1 ++ getLangPragmas ps2))]++ getLangPragmas = concatMap getLangPragma+ getLangPragma (LanguagePragma _ ns) = ns+ getLangPragma _ = []++ otherPragmas = filter (not . isLangPragma)+ isLangPragma (LanguagePragma {}) = True+ isLangPragma _ = False++-- | Convert a @ModuleName@ to a @String@.+getModuleName :: ModuleName -> String+getModuleName (ModuleName n) = n+
+ src/tools/diagrams-builder-cairo.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import Diagrams.Prelude hiding (width, height)+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal -- due to GHC export bug in 7.4++import Diagrams.Builder++import System.Directory (copyFile)+import qualified System.FilePath as FP++import System.Console.CmdArgs++compileExample :: Build -> IO ()+compileExample (Build{..}) = do+ let fmt = case FP.takeExtension outFile of+ ".png" -> PNG+ ".svg" -> SVG+ ".ps" -> PS+ ".pdf" -> PDF+ _ -> PNG++ f <- readFile srcFile++ res <- buildDiagram+ Cairo+ zeroV+ (CairoOptions outFile (mkSizeSpec width height) fmt)+ [f]+ expr+ []+ [ "Diagrams.Backend.Cairo" ]+ (hashedRegenerate+ (\hash opts -> opts { cairoFileName = mkFile hash })+ dir+ )+ case res of+ ParseErr err -> putStrLn ("Parse error in " ++ srcFile) >> putStrLn err+ InterpErr ierr -> putStrLn ("Error while compiling " ++ srcFile) >>+ putStrLn (ppInterpError ierr)+ Skipped hash -> copyFile (mkFile hash) outFile+ OK hash (act,_) -> act >> copyFile (mkFile hash) outFile+ where+ mkFile base = dir FP.</> base FP.<.> "png"++data Build = Build { width :: Maybe Double+ , height :: Maybe Double+ , srcFile :: String+ , expr :: String+ , outFile :: String+ , dir :: String+ }+ deriving (Typeable, Data)++build :: Build+build = Build { width = def &= typ "INT"+ , height = def &= typ "INT"+ , srcFile = "" &= argPos 0 &= typFile+ , expr = "dia"+ &= typ "EXPRESSION"+ &= help "Expression to render (default: \"dia\")"+ , outFile = "out.png" &= typFile &= help "Output file (default: \"out.png\")"+ , dir = "diagrams"+ &= typDir+ &= help "Directory in which to store rendered diagrams by hash (default: \"diagrams\")"+ }+ &= summary "The diagrams-builder-cairo program, for dynamically rendering diagrams using the cairo backend. Give it a source file and an expression to render (which may refer to things declared in the source file), and it outputs an image, using hashing to avoid rerendering images unnecessarily."+ &= program "diagrams-builder-cairo"++main :: IO ()+main = do+ opts <- cmdArgs build+ compileExample opts