diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,7 +1,16 @@ +0.7 (19 April 2015) +------------------- + +- Update to `diagrams-lib-1.3`. +- Add `diagrams-rasterific` support. +- Add support for `DIAGRAMS_SANDBOX` environment variable. +- Allow `exceptions-0.8` +- Fix `diagrams-latex` directory creation on Windows + 0.6.0.4 (2 April 2015) ---------------------- - - allow `lens-4.9` +- allow `lens-4.9` 0.6.0.3 (13 Jan 2015) --------------------- @@ -18,7 +27,7 @@ ------------------------ - Allow lens-4.4 - + 0.6 (5 June 2014) ----------------- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,12 @@ -Copyright (c) 2012-2013 diagrams-builder team: +Copyright (c) 2012-2015 diagrams-builder team: + Daniel Bergey + Jeroen Bransen + Christopher Chalmers + Anthony Cowley + Yiding Jia Jeffrey Rosenbluth + Ryan Yates Brent Yorgey All rights reserved. diff --git a/diagrams-builder.cabal b/diagrams-builder.cabal --- a/diagrams-builder.cabal +++ b/diagrams-builder.cabal @@ -1,5 +1,5 @@ name: diagrams-builder -version: 0.6.0.4 +version: 0.7.0.0 synopsis: hint-based build service for the diagrams graphics EDSL. description: @diagrams-builder@ provides backend-agnostic tools for @@ -14,13 +14,14 @@ plugin for @BlogLiterately@) to compile diagrams embedded in Markdown-formatted blog posts. . - Executables specific to the cairo, SVG, and postscript + Executables specific to the cairo, SVG, postscript, + and rasterific backends are included (more executables specific to other backends may be included in the future). All take an input file and an expression to render, and output an image file. If you want these executables you must explicitly enable the - @-fcairo@, @-fsvg@, or @-fps@ flags. + @-fcairo@, @-fsvg@, @-fpostscript@, or @-frasterific@ flags. . A LaTeX package, @diagrams-latex.sty@, is also provided in the @latex/@ directory of the source @@ -36,7 +37,7 @@ category: Graphics build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.3 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 bug-reports: https://github.com/diagrams/diagrams-builder/issues Source-repository head type: git @@ -47,9 +48,9 @@ Diagrams.Builder.Opts Diagrams.Builder.Modules Diagrams.Builder.CmdLine - build-depends: base >=4.2 && < 4.8, + build-depends: base >=4.2 && < 4.9, mtl >= 2.1 && < 2.3, - diagrams-lib >= 1.2 && < 1.3, + diagrams-lib >= 1.3 && < 1.4, hint >= 0.4 && < 0.5, directory, filepath, @@ -59,7 +60,7 @@ cmdargs >= 0.6 && < 0.11, lens >= 4.0 && < 4.10, hashable >= 1.1 && < 1.3, - exceptions >= 0.3 && < 0.7 + exceptions >= 0.3 && < 0.9 hs-source-dirs: src default-language: Haskell2010 other-extensions: StandaloneDeriving, @@ -82,6 +83,16 @@ default: False manual: True +flag postscript + description: install postscript-specific builder tool + default: False + manual: True + +flag rasterific + description: install rasterific-specific builder tool + default: False + manual: True + executable diagrams-builder-cairo main-is: diagrams-builder-cairo.hs hs-source-dirs: src/tools @@ -97,10 +108,10 @@ filepath, directory, diagrams-builder, - diagrams-lib >= 0.6 && < 1.3, - diagrams-cairo >= 0.6 && < 1.3, + diagrams-lib >= 1.3 && < 1.4, + diagrams-cairo >= 1.3 && < 1.4, cmdargs >= 0.6 && < 0.11, - lens >= 3.8 && < 4.10 + lens >= 4.0 && < 4.10 executable diagrams-builder-svg main-is: diagrams-builder-svg.hs @@ -117,9 +128,9 @@ filepath, directory, diagrams-builder, - diagrams-lib >= 0.6 && < 1.3, - diagrams-svg >= 0.8.0.1 && < 1.2, - blaze-svg >= 0.3.3 && < 0.4, + diagrams-lib >= 0.6 && < 1.4, + diagrams-svg >= 0.8.0.1 && < 1.4, + lucid-svg, bytestring >= 0.9.2 && < 0.11, cmdargs >= 0.6 && < 0.11 @@ -130,15 +141,36 @@ other-extensions: DeriveDataTypeable RecordWildCards - if !flag(ps) + if !flag(ps) && !flag(postscript) buildable: False - if flag(ps) + if flag(ps) || flag(postscript) build-depends: base >= 4 && < 5, filepath, directory, diagrams-builder, - diagrams-lib >= 0.6 && < 1.3, - diagrams-postscript >= 0.6 && < 1.2, + diagrams-lib >= 0.6 && < 1.4, + diagrams-postscript >= 0.6 && < 1.4, cmdargs >= 0.6 && < 0.11, lens >= 3.8 && < 4.10 + +executable diagrams-builder-rasterific + main-is: diagrams-builder-rasterific.hs + hs-source-dirs: src/tools + default-language: Haskell2010 + other-extensions: DeriveDataTypeable + RecordWildCards + + if !flag(rasterific) + buildable: False + + if flag(rasterific) + build-depends: base >= 4 && < 5, + filepath, + directory, + diagrams-builder, + diagrams-lib >= 0.6 && < 1.4, + diagrams-rasterific >= 1.3 && < 1.4, + cmdargs >= 0.6 && < 0.11, + lens >= 3.8 && < 4.10, + JuicyPixels >= 3.1.5 && < 3.3 diff --git a/latex/diagrams-latex.sty b/latex/diagrams-latex.sty --- a/latex/diagrams-latex.sty +++ b/latex/diagrams-latex.sty @@ -208,7 +208,11 @@ \ifdtt@ForceShellEscape \dtt@ShellEscapetrue \fi - \immediate\write18{mkdir -p \dtt@outputdir} + \ifwindows + \immediate\write18{if not exist \dtt@outputdir\space mkdir \dtt@outputdir} + \else + \immediate\write18{mkdir -p \dtt@outputdir} + \fi \xdef\diagramslatexCutFile{\dtt@figname.hs} \diagramslatexverbatimwrite{\diagramslatexCutFile}} {\enddiagramslatexverbatimwrite% diff --git a/src/Diagrams/Builder.hs b/src/Diagrams/Builder.hs --- a/src/Diagrams/Builder.hs +++ b/src/Diagrams/Builder.hs @@ -1,9 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -43,15 +43,14 @@ ) where -import Control.Lens ((^.)) import Control.Monad (guard, mplus, mzero) -import Control.Monad.Catch (catchAll) +import Control.Monad.Catch (MonadMask, catchAll) import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) import Data.Data import Data.Hashable (Hashable (..)) import Data.List (foldl', nub) import Data.List.Split (splitOn) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes) import System.Directory (doesFileExist, getTemporaryDirectory, removeFile) @@ -67,9 +66,8 @@ import Diagrams.Builder.CmdLine import Diagrams.Builder.Modules import Diagrams.Builder.Opts -import Diagrams.Prelude hiding ((<.>)) +import Diagrams.Prelude import Language.Haskell.Interpreter.Unsafe (unsafeRunInterpreterWithArgs) -import System.Environment (getEnvironment) deriving instance Typeable Any @@ -106,30 +104,36 @@ ] ++ imps -getHsenvArgv :: IO [String] -getHsenvArgv = do - env <- getEnvironment - return $ case (lookup "HSENV" env) of - Nothing -> [] - _ -> hsenvArgv - where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env) +-- | Run an interpretor using sandbox from 'findSandbox'. +runSandboxInterpreter :: (MonadMask m, MonadIO m, Functor m) + => InterpreterT m a -> m (Either InterpreterError a) +runSandboxInterpreter i = do + mSandbox <- liftIO $ findSandbox [] + case mSandbox of + Just sandbox -> let args = ["-package-db", sandbox] + in unsafeRunInterpreterWithArgs args i + Nothing -> runInterpreter i -- | Interpret a diagram expression based on the contents of a given -- source file, using some backend to produce a result. The --- expression can be of type @Diagram b v@ or @IO (Diagram b v)@. +-- expression can be of type @Diagram b v n@ or @IO (Diagram b v n)@. interpretDiagram - :: forall b v. - ( Typeable b, Typeable v, Data v, Data (Scalar v) - , InnerSpace v, OrderedField (Scalar v), Backend b v + :: forall b v n. + ( Typeable b +#if __GLASGOW_HASKELL__ > 707 + , Typeable v +#else + , Typeable1 v +#endif + , HasLinearMap v, Data (v n), Data n + , Metric v, OrderedField n, Backend b v n ) - => BuildOpts b v + => BuildOpts b v n -> FilePath - -> IO (Either InterpreterError (Result b v)) + -> IO (Either InterpreterError (Result b v n)) interpretDiagram bopts m = do - -- use an hsenv sandbox, if one is enabled. - args <- liftIO getHsenvArgv - unsafeRunInterpreterWithArgs args $ do + runSandboxInterpreter $ do setDiagramImports m (bopts ^. imports) let dexp = bopts ^. diaExpr @@ -138,7 +142,7 @@ -- b v and IO (Diagram b v). Take whichever one typechecks, -- running the IO action in the second case to produce a -- diagram. - d <- interpret dexp (as :: Diagram b v) `catchAll` const (interpret dexp (as :: IO (Diagram b v)) >>= liftIO) + d <- interpret dexp (as :: QDiagram b v n Any) `catchAll` const (interpret dexp (as :: IO (QDiagram b v n Any)) >>= liftIO) -- Finally, call renderDia. return $ renderDia (backendToken bopts) (bopts ^. backendOpts) ((bopts ^. postProcess) d) @@ -155,14 +159,14 @@ ------------------------------------------------------------ -- | Potential results of a dynamic diagram building operation. -data BuildResult b v = - ParseErr String -- ^ Parsing of the code failed. - | InterpErr InterpreterError -- ^ Interpreting the code - -- failed. See 'ppInterpError'. - | Skipped Hash -- ^ This diagram did not need to be - -- regenerated; includes the hash. - | OK Hash (Result b v) -- ^ A successful build, yielding the - -- hash and a backend-specific result. +data BuildResult b v n = + ParseErr String -- ^ Parsing of the code failed. + | InterpErr InterpreterError -- ^ Interpreting the code + -- failed. See 'ppInterpError'. + | Skipped Hash -- ^ This diagram did not need to be + -- regenerated; includes the hash. + | OK Hash (Result b v n) -- ^ A successful build, yielding the + -- hash and a backend-specific result. -- | Build a diagram by writing the given source code to a temporary -- module and interpreting the given expression, which can be of @@ -170,11 +174,17 @@ -- parse error if the source does not parse, an interpreter error, -- or the final result. buildDiagram - :: ( Typeable b, Typeable v, Data v, Data (Scalar v) - , InnerSpace v, OrderedField (Scalar v), Backend b v - , Hashable (Options b v) + :: ( Typeable b, Data (v n), Data n + , Metric v, HasLinearMap v +#if __GLASGOW_HASKELL__ > 707 + , Typeable v +#else + , Typeable1 v +#endif + , OrderedField n, Backend b v n + , Hashable (Options b v n) ) - => BuildOpts b v -> IO (BuildResult b v) + => BuildOpts b v n -> IO (BuildResult b v n) buildDiagram bopts = do let bopts' = bopts & snippets %~ map unLit @@ -194,7 +204,7 @@ Nothing -> return $ Skipped diaHash Just upd -> do tmpDir <- getTemporaryDirectory - (tmp, h) <- openTempFile tmpDir ("Diagram.hs") + (tmp, h) <- openTempFile tmpDir "Diagram.hs" let m' = replaceModuleName (takeBaseName tmp) m hPutStr h (prettyPrint m') hClose h @@ -211,8 +221,7 @@ hashLocalImports :: [ImportDecl] -> IO Hash hashLocalImports = fmap (foldl' hashWithSalt 0 . catMaybes) - . mapM getLocalSource - . map (foldr1 () . splitOn "." . getModuleName . importModule) + . mapM (getLocalSource . foldr1 () . splitOn "." . getModuleName . importModule) -- | Given a relative path with no extension, like -- @\"Foo\/Bar\/Baz\"@, check whether such a file exists with either diff --git a/src/Diagrams/Builder/Modules.hs b/src/Diagrams/Builder/Modules.hs --- a/src/Diagrams/Builder/Modules.hs +++ b/src/Diagrams/Builder/Modules.hs @@ -35,7 +35,7 @@ -- Returns the updated module, or an error message if parsing -- failed. createModule :: Maybe String -- ^ Module name to use - -> BuildOpts b v + -> BuildOpts b v n -> Either String Module createModule nm opts = do ms <- mapM doModuleParse (opts ^. snippets) @@ -93,7 +93,7 @@ where addImport imp is | any ((==imp) . getModuleName . importModule) is = is | otherwise = ImportDecl noLoc (ModuleName imp) False False False - Nothing Nothing Nothing : is + 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). @@ -125,3 +125,4 @@ -- | Convert a @ModuleName@ to a @String@. getModuleName :: ModuleName -> String getModuleName (ModuleName n) = n + diff --git a/src/Diagrams/Builder/Opts.hs b/src/Diagrams/Builder/Opts.hs --- a/src/Diagrams/Builder/Opts.hs +++ b/src/Diagrams/Builder/Opts.hs @@ -34,7 +34,7 @@ import System.FilePath (takeBaseName) import Text.Printf -import Diagrams.Prelude (Diagram, Options) +import Diagrams.Prelude (QDiagram, Options, Any) -- | Synonym for more perspicuous types. -- @@ -56,19 +56,19 @@ -- & imports .~ [\"Foo.Bar\", \"Baz.Quux\"] -- & diaExpr .~ \"square 6 # fc green\" -- @ -data BuildOpts b v +data BuildOpts b v n = BuildOpts { backendToken :: b -- ^ Backend token - , vectorToken :: v + , vectorToken :: v n -- ^ Dummy vector argument to fix the vector space type - , _backendOpts :: Options b v + , _backendOpts :: Options b v n , _snippets :: [String] , _pragmas :: [String] , _imports :: [String] - , _decideRegen :: Hash -> IO (Maybe (Options b v -> Options b v)) + , _decideRegen :: Hash -> IO (Maybe (Options b v n -> Options b v n)) , _diaExpr :: String - , _postProcess :: Diagram b v -> Diagram b v + , _postProcess :: QDiagram b v n Any -> QDiagram b v n Any } makeLensesWith (lensRules & generateSignatures .~ False) ''BuildOpts @@ -86,26 +86,26 @@ -- * the diagram expression @circle 1@ -- -- * no postprocessing -mkBuildOpts :: b -> v -> Options b v -> BuildOpts b v +mkBuildOpts :: b -> v n -> Options b v n -> BuildOpts b v n mkBuildOpts b v opts = BuildOpts b v opts [] [] [] alwaysRegenerate "circle 1" id -- | Backend-specific options to use. -backendOpts :: Lens' (BuildOpts b v) (Options b v) +backendOpts :: Lens' (BuildOpts b v n) (Options b v n) -- | 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. -snippets :: Lens' (BuildOpts b v) [String] +snippets :: Lens' (BuildOpts b v n) [String] -- | Extra @LANGUAGE@ pragmas to use (@NoMonomorphismRestriction@ -- is automatically enabled.) -pragmas :: Lens' (BuildOpts b v) [String] +pragmas :: Lens' (BuildOpts b v n) [String] -- | Additional module imports (note that "Diagrams.Prelude" is -- automatically imported). -imports :: Lens' (BuildOpts b v) [String] +imports :: Lens' (BuildOpts b v n) [String] -- | A function to decide whether a particular diagram needs to be -- regenerated. It will be passed a hash of the final assembled @@ -127,13 +127,13 @@ -- 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. -decideRegen :: Lens' (BuildOpts b v) (Hash -> IO (Maybe (Options b v -> Options b v))) +decideRegen :: Lens' (BuildOpts b v n) (Hash -> IO (Maybe (Options b v n -> Options b v n))) -- | The diagram expression to interpret. All the given import sand -- snippets will be in scope, with the given LANGUAGE pragmas --- enabled. The expression may have either of the types @Diagram b --- v@ or @IO (Diagram b v)@. -diaExpr :: Lens' (BuildOpts b v) String +-- enabled. The expression may have either of the types @Diagram b@ +-- or @IO (Diagram b)@. +diaExpr :: Lens' (BuildOpts b v n) String -- | A function to apply to the interpreted diagram prior to -- rendering. For example, you might wish to apply @pad 1.1 @@ -141,7 +141,7 @@ -- string expression to be interpreted, since it gives better -- typechecking, and works no matter whether the expression -- represents a diagram or an IO action. -postProcess :: Lens' (BuildOpts b v) (Diagram b v -> Diagram b v) +postProcess :: Lens' (BuildOpts b v n) (QDiagram b v n Any -> QDiagram b v n Any) -- | Convenience function suitable to be given as the final argument -- to 'buildDiagram'. It implements the simple policy of always diff --git a/src/tools/diagrams-builder-cairo.hs b/src/tools/diagrams-builder-cairo.hs --- a/src/tools/diagrams-builder-cairo.hs +++ b/src/tools/diagrams-builder-cairo.hs @@ -29,7 +29,7 @@ createDirectoryIfMissing True dir - let bopts = mkBuildOpts Cairo zeroV (CairoOptions outFile (mkSizeSpec width height) fmt False) + let bopts = mkBuildOpts Cairo zero (CairoOptions outFile (mkSizeSpec2D width height) fmt False) & snippets .~ [f] & imports .~ [ "Diagrams.Backend.Cairo" ] & diaExpr .~ expr diff --git a/src/tools/diagrams-builder-ps.hs b/src/tools/diagrams-builder-ps.hs --- a/src/tools/diagrams-builder-ps.hs +++ b/src/tools/diagrams-builder-ps.hs @@ -19,7 +19,7 @@ createDirectoryIfMissing True dir - let bopts = mkBuildOpts Postscript zeroV (PostscriptOptions outFile (mkSizeSpec width height) EPS) + let bopts = mkBuildOpts Postscript zero (PostscriptOptions outFile (mkSizeSpec2D width height) EPS) & snippets .~ [f] & imports .~ [ "Diagrams.Backend.Postscript" ] & diaExpr .~ expr diff --git a/src/tools/diagrams-builder-rasterific.hs b/src/tools/diagrams-builder-rasterific.hs new file mode 100644 --- /dev/null +++ b/src/tools/diagrams-builder-rasterific.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RecordWildCards #-} + +module Main where +import qualified Codec.Picture as J +import Diagrams.Backend.Rasterific +import Diagrams.Prelude hiding (height, width) + +import Diagrams.Builder + +import System.Directory (copyFile, + createDirectoryIfMissing) +import qualified System.FilePath as FP + +import System.Console.CmdArgs + +compileExample :: Build -> IO () +compileExample (Build{..}) = do + let ext = FP.takeExtension outFile + save = case ext of + ".png" -> J.savePngImage + ".jpg" -> J.saveJpgImage 100 + ".bmp" -> J.saveBmpImage + ".gif" -> (either error id .) . J.saveGifImage + ".tiff" -> J.saveTiffImage + _ -> J.savePngImage + f <- readFile srcFile + + createDirectoryIfMissing True dir + + let w = fmap realToFrac width + h = fmap realToFrac height + bopts = mkBuildOpts Rasterific zero (RasterificOptions (mkSizeSpec2D w h)) + & snippets .~ [f] + & imports .~ [ "Diagrams.Backend.Rasterific" ] + & diaExpr .~ expr + & decideRegen .~ (hashedRegenerate (\_ opts -> opts) dir) + + res <- buildDiagram bopts + 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 (hashToHexStr hash) ext) outFile + OK hash img -> let cached = mkFile (hashToHexStr hash) ext + in do save cached (J.ImageRGBA8 img) + copyFile cached outFile + where + mkFile base ext = dir FP. base FP.<.> ext + +build :: Build +build = + defaultBuildOpts + { outFile = "out.png" &= typFile &= help "Output file (default: \"out.png\")" } + &= summary "The diagrams-builder-rasterific program, for dynamically rendering diagrams using the rasterific 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.\n\nIf you have installed the diagrams-lib and diagrams-rasterific packages in a sandbox, set the environment variable DIAGRAMS_SANDBOX to that directory so the builder can compile your diagram. For example, \"export DIAGRAMS_SANDBOX=~/diagrams/.cabal-sandbox\". If you have package databases for multiple versions of GHC in that sandbox, you will need to set the full path to the package database (it ends in \".conf.d\")." + &= program "diagrams-builder-rasterific" + +main :: IO () +main = do + opts <- cmdArgs build + compileExample opts diff --git a/src/tools/diagrams-builder-svg.hs b/src/tools/diagrams-builder-svg.hs --- a/src/tools/diagrams-builder-svg.hs +++ b/src/tools/diagrams-builder-svg.hs @@ -1,26 +1,27 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import Diagrams.Backend.SVG import Diagrams.Builder import Diagrams.Prelude hiding (height, width) +import Lucid.Svg import qualified Data.ByteString.Lazy as BS import System.Console.CmdArgs import System.Directory (copyFile, createDirectoryIfMissing) import qualified System.FilePath as FP -import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) compileExample :: Build -> IO () compileExample (Build{..}) = do - f <- readFile srcFile + f <- readFile srcFile createDirectoryIfMissing True dir - let bopts = mkBuildOpts SVG zeroV (SVGOptions (mkSizeSpec width height) Nothing) + let bopts = mkBuildOpts SVG zero (SVGOptions (mkSizeSpec2D width height) [] "" ) & snippets .~ [f] & imports .~ [ "Diagrams.Backend.SVG" ] & diaExpr .~ expr @@ -34,7 +35,7 @@ putStrLn (ppInterpError ierr) Skipped hash -> copyFile (mkFile (hashToHexStr hash)) outFile OK hash svg -> do let cached = mkFile (hashToHexStr hash) - BS.writeFile cached (renderSvg svg) + renderToFile cached svg copyFile cached outFile where mkFile base = dir FP. base FP.<.> "svg"