diagrams-builder 0.4.2 → 0.5
raw patch · 7 files changed
+320/−209 lines, 7 filesdep +hashabledep −cryptohashdep ~haskell-src-extsdep ~lens
Dependencies added: hashable
Dependencies removed: cryptohash
Dependency ranges changed: haskell-src-exts, lens
Files
- diagrams-builder.cabal +6/−5
- src/Diagrams/Builder.hs +60/−138
- src/Diagrams/Builder/Modules.hs +8/−7
- src/Diagrams/Builder/Opts.hs +187/−0
- src/tools/diagrams-builder-cairo.hs +22/−22
- src/tools/diagrams-builder-ps.hs +22/−21
- src/tools/diagrams-builder-svg.hs +15/−16
diagrams-builder.cabal view
@@ -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,
src/Diagrams/Builder.hs view
@@ -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
src/Diagrams/Builder/Modules.hs view
@@ -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
+ src/Diagrams/Builder/Opts.hs view
@@ -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)
src/tools/diagrams-builder-cairo.hs view
@@ -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
src/tools/diagrams-builder-ps.hs view
@@ -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"
src/tools/diagrams-builder-svg.hs view
@@ -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