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.4.2 +version: 0.5 synopsis: hint-based build service for the diagrams graphics EDSL. description: @diagrams-builder@ provides backend-agnostic tools for @@ -44,6 +44,7 @@ library exposed-modules: Diagrams.Builder + Diagrams.Builder.Opts Diagrams.Builder.Modules Diagrams.Builder.CmdLine build-depends: base >=4.2 && < 4.7, @@ -54,10 +55,10 @@ filepath, transformers >= 0.3 && < 0.4, split >= 0.2 && < 0.3, - haskell-src-exts >= 1.13.1 && < 1.15, - cryptohash >= 0.8 && < 0.12, - bytestring >= 0.9.2 && < 0.11, - cmdargs >= 0.6 && < 0.11 + haskell-src-exts >= 1.14 && < 1.15, + cmdargs >= 0.6 && < 0.11, + lens >= 3.9 && < 3.11, + hashable >= 1.2 && < 1.3 hs-source-dirs: src default-language: Haskell2010 other-extensions: StandaloneDeriving, diff --git a/src/Diagrams/Builder.hs b/src/Diagrams/Builder.hs --- a/src/Diagrams/Builder.hs +++ b/src/Diagrams/Builder.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -19,12 +20,17 @@ module Diagrams.Builder ( -- * Building diagrams - buildDiagram, BuildResult(..) - , ppInterpError + -- ** Options + BuildOpts(..), mkBuildOpts, backendOpts, snippets, pragmas, imports, decideRegen, diaExpr, postProcess - -- ** Regeneration decision functions + -- ** Regeneration decision functions and hashing , alwaysRegenerate, hashedRegenerate + , hashToHexStr + -- ** Building + , buildDiagram, BuildResult(..) + , ppInterpError + -- * Interpreting diagrams -- $interp , setDiagramImports @@ -37,19 +43,16 @@ ) where +import Control.Lens ((^.)) import Control.Monad (guard, mplus, mzero) import Control.Monad.Error (catchError) import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) -import Crypto.Hash (Digest, MD5, - digestToHexByteString, - hash) -import qualified Data.ByteString.Char8 as B -import Data.List (nub) +import Data.Hashable (Hashable (..)) +import Data.List (foldl', nub) import Data.List.Split (splitOn) import Data.Maybe (catMaybes, fromMaybe) import Data.Typeable (Typeable) import System.Directory (doesFileExist, - getDirectoryContents, getTemporaryDirectory, removeFile) import System.FilePath (takeBaseName, (<.>), @@ -63,6 +66,7 @@ import Diagrams.Builder.CmdLine import Diagrams.Builder.Modules +import Diagrams.Builder.Opts import Diagrams.Prelude hiding ((<.>)) import Language.Haskell.Interpreter.Unsafe (unsafeRunInterpreterWithArgs) import System.Environment (getEnvironment) @@ -118,20 +122,27 @@ ( 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 + => BuildOpts b v + -> FilePath -> IO (Either InterpreterError (Result b v)) -interpretDiagram b _ opts m imps dexp = do - args <- liftIO getHsenvArgv - unsafeRunInterpreterWithArgs args $ do - setDiagramImports m imps - d <- interpret dexp (as :: Diagram b v) `catchError` const (interpret dexp (as :: IO (Diagram b v)) >>= liftIO) - return (renderDia b opts d) +interpretDiagram bopts m = do + -- use an hsenv sandbox, if one is enabled. + args <- liftIO getHsenvArgv + unsafeRunInterpreterWithArgs args $ do + + setDiagramImports m (bopts ^. imports) + let dexp = bopts ^. diaExpr + + -- Try interpreting the diagram expression at two types: Diagram + -- 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) `catchError` const (interpret dexp (as :: IO (Diagram b v)) >>= liftIO) + + -- Finally, call renderDia. + return $ renderDia (backendToken bopts) (bopts ^. backendOpts) ((bopts ^. postProcess) d) + -- | Pretty-print an @InterpreterError@. ppInterpError :: InterpreterError -> String ppInterpError (UnknownError err) = "UnknownError: " ++ err @@ -144,15 +155,14 @@ ------------------------------------------------------------ -- | Potential results of a dynamic diagram building operation. -data BuildResult b v x = +data BuildResult b v = 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. + | 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. -- | Build a diagram by writing the given source code to a temporary -- module and interpreting the given expression, which can be of @@ -162,90 +172,45 @@ buildDiagram :: ( Typeable b, Typeable v , InnerSpace v, OrderedField (Scalar v), Backend b v - , Show (Options b v) + , Hashable (Options 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 + => BuildOpts b v -> IO (BuildResult b v) +buildDiagram bopts = do + let bopts' = bopts + & snippets %~ map unLit + & pragmas %~ ("NoMonomorphismRestriction" :) + & imports %~ ("Diagrams.Prelude" :) + case createModule Nothing bopts' of Left err -> return (ParseErr err) Right m@(Module _ _ _ _ _ srcImps _) -> do - liHashes <- getLocalImportHashes srcImps - regen <- shouldRegen (prettyPrint m ++ dexp ++ show opts ++ concat liHashes) + liHash <- hashLocalImports srcImps + let diaHash + = 0 `hashWithSalt` prettyPrint m + `hashWithSalt` (bopts ^. diaExpr) + `hashWithSalt` (bopts ^. backendOpts) + `hashWithSalt` liHash + regen <- (bopts ^. decideRegen) diaHash case regen of - (info, Nothing) -> return $ Skipped info - (info, Just upd) -> do + Nothing -> return $ Skipped diaHash + 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 + compilation <- interpretDiagram (bopts' & backendOpts %~ upd) tmp removeFile tmp - return $ either InterpErr (OK info) compilation + return $ either InterpErr (OK diaHash) compilation --- | Take a list of imports, and return hashes of the contents of +-- | Take a list of imports, and return a hash of the contents of -- those imports which are local. Note, this only finds imports -- which exist relative to the current directory, which is not as -- general as it probably should be --- we could be calling -- 'buildDiagram' on source code which lives anywhere. -getLocalImportHashes :: [ImportDecl] -> IO [String] -getLocalImportHashes - = (fmap . map) hashStr - . fmap catMaybes +hashLocalImports :: [ImportDecl] -> IO Hash +hashLocalImports + = fmap (foldl' hashWithSalt 0 . catMaybes) . mapM getLocalSource . map (foldr1 () . splitOn "." . getModuleName . importModule) @@ -269,46 +234,3 @@ tryExt ext = do let f = m <.> ext liftIO (doesFileExist f) >>= guard >> liftIO (readFile f) - --- | 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 d src = do - let fileBase = hashStr src - files <- getDirectoryContents d - case any ((fileBase==) . takeBaseName) files of - True -> return (fileBase, Nothing) - False -> return (fileBase, Just (upd fileBase)) - -hashStr :: String -> String -hashStr = B.unpack . digestToHexByteString . (hash :: B.ByteString -> Digest MD5) . B.pack 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 @@ -11,6 +11,7 @@ module Diagrams.Builder.Modules where +import Control.Lens ((^.)) import Data.Function (on) import Data.List (foldl', groupBy, isPrefixOf, nub, sortBy) @@ -19,6 +20,8 @@ import Language.Haskell.Exts import Language.Haskell.Exts.SrcLoc (noLoc) +import Diagrams.Builder.Opts + ------------------------------------------------------------ -- Manipulating modules ------------------------------------------------------------ @@ -32,17 +35,15 @@ -- 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 + -> BuildOpts b v -> Either String Module -createModule nm langs imps srcs = do - ms <- mapM doModuleParse srcs +createModule nm opts = do + ms <- mapM doModuleParse (opts ^. snippets) return . deleteExports . maybe id replaceModuleName nm - . addPragmas langs - . addImports imps + . addPragmas (opts ^. pragmas) + . addImports (opts ^. imports) . foldl' combineModules emptyModule $ ms diff --git a/src/Diagrams/Builder/Opts.hs b/src/Diagrams/Builder/Opts.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Builder/Opts.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.Builder.Opts +-- Copyright : (c) 2013 diagrams-lib team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Options for dynamic creation of diagrams. +-- +----------------------------------------------------------------------------- +module Diagrams.Builder.Opts + ( -- * Options + + Hash + , BuildOpts(..), mkBuildOpts, backendOpts, snippets, pragmas, imports, decideRegen, diaExpr, postProcess + + -- * Rebuilding + + , alwaysRegenerate, hashedRegenerate, hashToHexStr + ) + where + +import Control.Lens (Lens', generateSignatures, lensRules, + makeLensesWith, (&), (.~)) +import System.Directory (getDirectoryContents) +import System.FilePath (takeBaseName) +import Text.Printf + +import Diagrams.Prelude (Diagram, Options) + +-- | Synonym for more perspicuous types. +-- +-- We use @Int@ values for hashes because that's what the @Hashable@ +-- package uses. Assuming diagram hashes are uniformly distributed, +-- on a 64-bit system one needs to build on the order of billions of +-- diagrams before the probability of a hash collision exceeds 1/2, +-- and for anything up to tens of millions of diagrams the +-- probability of a collision is under 0.1%. On 32-bit systems +-- those become tens of thousands and thousands, respectively. +type Hash = Int + +-- | Options to control the behavior of @buildDiagram@. Create one +-- with 'mkBuildOpts' followed by using the provided lenses to +-- override more fields; for example, +-- +-- @ +-- mkBuildOpts SVG zeroV (Options ...) +-- & imports .~ [\"Foo.Bar\", \"Baz.Quux\"] +-- & diaExpr .~ \"square 6 # fc green\" +-- @ +data BuildOpts b v + = BuildOpts + { backendToken :: b + -- ^ Backend token + , vectorToken :: v + -- ^ Dummy vector argument to fix the vector space type + , _backendOpts :: Options b v + , _snippets :: [String] + , _pragmas :: [String] + , _imports :: [String] + , _decideRegen :: Hash -> IO (Maybe (Options b v -> Options b v)) + , _diaExpr :: String + , _postProcess :: Diagram b v -> Diagram b v + } + +makeLensesWith (lensRules & generateSignatures .~ False) ''BuildOpts + +-- | Create a @BuildOpts@ record with default options: +-- +-- * no snippets +-- +-- * no pragmas +-- +-- * no imports +-- +-- * always regenerate +-- +-- * the diagram expression @circle 1@ +-- +-- * no postprocessing +mkBuildOpts :: b -> v -> Options b v -> BuildOpts b v +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) + +-- | 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] + +-- | Extra @LANGUAGE@ pragmas to use (@NoMonomorphismRestriction@ +-- is automatically enabled.) +pragmas :: Lens' (BuildOpts b v) [String] + +-- | Additional module imports (note that "Diagrams.Prelude" is +-- automatically imported). +imports :: Lens' (BuildOpts b v) [String] + +-- | A function to decide whether a particular diagram needs to be +-- regenerated. It will be passed a hash of 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), plus any options, +-- local imports, and other things which could affect the result of +-- rendering. 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. +decideRegen :: Lens' (BuildOpts b v) (Hash -> IO (Maybe (Options b v -> Options b v))) + +-- | 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 + +-- | A function to apply to the interpreted diagram prior to +-- rendering. For example, you might wish to apply @pad 1.1 +-- . centerXY@. This is preferred over directly modifying the +-- 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) + +-- | Convenience function suitable to be given as the final argument +-- to 'buildDiagram'. It implements the simple policy of always +-- rebuilding every diagram. +alwaysRegenerate :: Hash -> IO (Maybe (a -> a)) +alwaysRegenerate _ = return (Just id) + +-- | Convenience function suitable to be given as the final argument +-- to 'buildDiagram'. It works by converting the hash value to a +-- zero-padded hexadecimal string 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 string. (Most likely, one +-- would want to set the requested output file to the hash followed +-- by some extension.) +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 + + -> Hash + -- ^ The hash + + -> IO (Maybe (a -> a)) + +hashedRegenerate upd d hash = do + let fileBase = hashToHexStr hash + files <- getDirectoryContents d + case any ((fileBase==) . takeBaseName) files of + True -> return Nothing + False -> return $ Just (upd fileBase) + +hashToHexStr :: Hash -> String +hashToHexStr n = printf "%016x" n' + where + n' :: Integer + n' = fromIntegral n - fromIntegral (minBound :: Int) 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 @@ -1,18 +1,19 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RecordWildCards #-} +{-# 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.Backend.Cairo +import Diagrams.Backend.Cairo.Internal +import Diagrams.Prelude hiding (height, width) -import Diagrams.Builder +import Diagrams.Builder -import System.Directory (createDirectoryIfMissing, copyFile) -import qualified System.FilePath as FP +import System.Directory (copyFile, + createDirectoryIfMissing) +import qualified System.FilePath as FP -import System.Console.CmdArgs +import System.Console.CmdArgs compileExample :: Build -> IO () compileExample (Build{..}) = do @@ -28,24 +29,23 @@ createDirectoryIfMissing True dir - res <- buildDiagram - Cairo - zeroV - (CairoOptions outFile (mkSizeSpec width height) fmt False) - [f] - expr - [] - [ "Diagrams.Backend.Cairo" ] - (hashedRegenerate - (\hash opts -> opts & cairoFileName .~ mkFile hash ext) - dir - ) + let bopts = mkBuildOpts Cairo zeroV (CairoOptions outFile (mkSizeSpec width height) fmt False) + & snippets .~ [f] + & imports .~ [ "Diagrams.Backend.Cairo" ] + & diaExpr .~ expr + & decideRegen + .~ (hashedRegenerate + (\base opts -> opts & cairoFileName .~ mkFile base ext) + 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 hash ext) outFile - OK hash (act,_) -> act >> copyFile (mkFile hash ext) outFile + Skipped hash -> copyFile (mkFile (hashToHexStr hash) ext) outFile + OK hash (act,_) -> act >> copyFile (mkFile (hashToHexStr hash) ext) outFile where mkFile base ext = dir FP. base FP.<.> ext 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 @@ -1,16 +1,17 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} module Main where -import System.Directory (createDirectoryIfMissing, copyFile) -import qualified System.FilePath as FP +import System.Directory (copyFile, + createDirectoryIfMissing) +import qualified System.FilePath as FP -import System.Console.CmdArgs +import System.Console.CmdArgs -import Diagrams.Prelude hiding (width, height) -import Diagrams.Backend.Postscript -import Diagrams.Builder +import Diagrams.Backend.Postscript +import Diagrams.Builder +import Diagrams.Prelude hiding (height, width) compileExample :: Build -> IO () compileExample (Build{..}) = do @@ -18,25 +19,25 @@ createDirectoryIfMissing True dir - res <- buildDiagram - Postscript - zeroV - (PostscriptOptions outFile (mkSizeSpec width height) EPS) - [f] - expr - [] - [ "Diagrams.Backend.Postscript" ] - (hashedRegenerate - (\hash opts -> opts & psfileName .~ mkFile hash ) - dir - ) + let bopts = mkBuildOpts Postscript zeroV (PostscriptOptions outFile (mkSizeSpec width height) EPS) + & snippets .~ [f] + & imports .~ [ "Diagrams.Backend.Postscript" ] + & diaExpr .~ expr + & decideRegen .~ + (hashedRegenerate + (\hash opts -> opts & psfileName .~ mkFile hash ) + 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 hash) outFile - OK hash act -> do act >> copyFile (mkFile hash) outFile + Skipped hash -> copyFile (mkFile (hashToHexStr hash)) outFile + OK hash act -> do act >> copyFile (mkFile (hashToHexStr hash)) outFile where mkFile base = dir FP. base FP.<.> "eps" 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,16 +1,17 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} module Main where import Diagrams.Backend.SVG import Diagrams.Builder -import Diagrams.Prelude hiding (width, height) +import Diagrams.Prelude hiding (height, width) -import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy as BS import System.Console.CmdArgs -import System.Directory (createDirectoryIfMissing, copyFile) -import qualified System.FilePath as FP +import System.Directory (copyFile, + createDirectoryIfMissing) +import qualified System.FilePath as FP import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) compileExample :: Build -> IO () @@ -19,22 +20,20 @@ createDirectoryIfMissing True dir - res <- buildDiagram - SVG - zeroV - (SVGOptions (mkSizeSpec width height) Nothing) - [f] - expr - [] - [ "Diagrams.Backend.SVG" ] - (hashedRegenerate (\_ opts -> opts) dir) + let bopts = mkBuildOpts SVG zeroV (SVGOptions (mkSizeSpec width height) Nothing) + & snippets .~ [f] + & imports .~ [ "Diagrams.Backend.SVG" ] + & 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 hash) outFile - OK hash svg -> do let cached = mkFile hash + Skipped hash -> copyFile (mkFile (hashToHexStr hash)) outFile + OK hash svg -> do let cached = mkFile (hashToHexStr hash) BS.writeFile cached (renderSvg svg) copyFile cached outFile where