diagrams-haddock 0.2 → 0.2.1
raw patch · 3 files changed
+67/−44 lines, 3 filesdep +ansi-terminaldep ~Cabaldep ~diagrams-svgPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: ansi-terminal
Dependency ranges changed: Cabal, diagrams-svg
API changes (from Hackage documentation)
- Diagrams.Haddock: compileDiagram :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> Set String -> [CodeBlock] -> DiagramURL -> IO (DiagramURL, Bool)
+ Diagrams.Haddock: compileDiagram :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> Set String -> [CodeBlock] -> DiagramURL -> WriterT [String] IO (DiagramURL, Bool)
- Diagrams.Haddock: compileDiagrams :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> Set String -> [CodeBlock] -> [Either String DiagramURL] -> IO ([Either String DiagramURL], Bool)
+ Diagrams.Haddock: compileDiagrams :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> Set String -> [CodeBlock] -> [Either String DiagramURL] -> WriterT [String] IO ([Either String DiagramURL], Bool)
Files
- CHANGES.md +16/−0
- diagrams-haddock.cabal +5/−4
- src/Diagrams/Haddock.hs +46/−40
CHANGES.md view
@@ -1,3 +1,19 @@+0.2.1 (11 September 2013)+-------------------------++ - prettier progress output and error logging+ - allow Cabal-1.18+ - require diagrams-svg >= 0.8.0.1++0.2 (2 September 2013)+----------------------++ - Take active hsenv into account when looking for distdir (closes #18)+ - add an option to generate data URIs instead of external SVGs+ - base generated diagram file names on module name + diagram name,+ so diagrams with the same name in different files no longer+ clobber each other+ 0.1.2.0 (1 September 2013) --------------------------
diagrams-haddock.cabal view
@@ -1,5 +1,5 @@ name: diagrams-haddock-version: 0.2+version: 0.2.1 synopsis: Preprocessor for embedding diagrams in Haddock documentation description: diagrams-haddock is a tool for compiling embedded inline diagrams code in Haddock documentation, for an@@ -45,14 +45,15 @@ blaze-svg >= 0.3 && < 0.4, diagrams-builder >= 0.3 && < 0.5, diagrams-lib >= 0.6 && < 0.8,- diagrams-svg >= 0.6 && < 0.8,+ diagrams-svg >= 0.8.0.1 && < 0.9, vector-space >= 0.8 && < 0.9, lens >= 3.8 && < 3.10, cpphs >= 1.15, cautious-file >= 1.0 && < 1.1, uniplate >= 1.6 && < 1.7, text >= 0.11 && < 0.12,- base64-bytestring >= 1 && < 1.1+ base64-bytestring >= 1 && < 1.1,+ ansi-terminal >= 0.5 && < 0.7 hs-source-dirs: src other-extensions: TemplateHaskell default-language: Haskell2010@@ -64,7 +65,7 @@ filepath, diagrams-haddock, cmdargs >= 0.8 && < 0.11,- Cabal >= 1.14 && < 1.18,+ Cabal >= 1.14 && < 1.19, cpphs >= 1.15 hs-source-dirs: tools default-language: Haskell2010
src/Diagrams/Haddock.hs view
@@ -95,6 +95,8 @@ import Language.Haskell.Exts.Annotated hiding (loc) import qualified Language.Haskell.Exts.Annotated as HSE import Language.Preprocessor.Cpphs+import System.Console.ANSI (cursorDownLine,+ setCursorColumn) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)@@ -290,7 +292,7 @@ (collectIdents m) (collectBindings m) ParseFailed loc err -> failWith . unlines $- [ file ++ ": " ++ show l ++ ": Warning: could not parse code block:" ]+ [ file ++ ": " ++ show l ++ ":\nWarning: could not parse code block:" ] ++ showBlock s ++@@ -419,17 +421,17 @@ -> FilePath -- ^ output directory -> FilePath -- ^ file being processed -> S.Set String -- ^ diagrams referenced from URLs- -> [CodeBlock] -> DiagramURL -> IO (DiagramURL, Bool)+ -> [CodeBlock]+ -> DiagramURL+ -> WriterT [String] IO (DiagramURL, Bool) compileDiagram quiet dataURIs cacheDir outputDir file ds code url -- See https://github.com/diagrams/diagrams-haddock/issues/7 . | (url ^. diagramName) `S.notMember` ds = return (url, False) -- The normal case. | otherwise = do- createDirectoryIfMissing True cacheDir- when (not dataURIs) $ createDirectoryIfMissing True outputDir-- let outFile = outputDir </> (munge file ++ "_" ++ (url ^. diagramName)) <.> "svg"+ let outFile = outputDir </>+ (munge file ++ "_" ++ (url ^. diagramName)) <.> "svg" munge = intercalate "_" . splitDirectories . normalise . dropExtension @@ -441,54 +443,64 @@ neededCode = transitiveClosure (url ^. diagramName) code - logStr $ (url ^. diagramName) ++ "..."- IO.hFlush IO.stdout+ errHeader = file ++ ": " ++ (url ^. diagramName) ++ ":\n" - res <- buildDiagram- SVG- zeroV- (SVGOptions (mkSizeSpec w h))- (map (view codeBlockCode) neededCode)- (url ^. diagramName)- []- [ "Diagrams.Backend.SVG" ]- (hashedRegenerate (\_ opts -> opts) cacheDir)+ res <- liftIO $ do+ createDirectoryIfMissing True cacheDir+ when (not dataURIs) $ createDirectoryIfMissing True outputDir + logStr $ "[ ] " ++ (url ^. diagramName)+ IO.hFlush IO.stdout++ buildDiagram+ SVG+ zeroV+ (SVGOptions (mkSizeSpec w h) Nothing)+ (map (view codeBlockCode) neededCode)+ (url ^. diagramName)+ []+ [ "Diagrams.Backend.SVG" ]+ (hashedRegenerate (\_ opts -> opts) cacheDir)+ case res of -- XXX incorporate these into error reporting framework instead of printing ParseErr err -> do- putStrLn ("Parse error:")- putStrLn err+ tell [errHeader ++ "Parse error: " ++ err]+ logResult "!" return oldURL InterpErr ierr -> do- putStrLn ("Interpreter error:")- putStrLn (ppInterpError ierr)+ tell [errHeader ++ "Interpreter error: " ++ ppInterpError ierr]+ logResult "!" return oldURL Skipped hash -> do let cached = mkCached hash- when (not dataURIs) $ copyFile cached outFile- logStrLn ""+ when (not dataURIs) $ liftIO $ copyFile cached outFile+ logResult "." if dataURIs then do- svgBS <- BS.readFile cached+ svgBS <- liftIO $ BS.readFile cached return (newURL (mkDataURI svgBS)) else return (newURL outFile) OK hash svg -> do let cached = mkCached hash svgBS = renderSvg svg- BS.writeFile cached svgBS+ liftIO $ BS.writeFile cached svgBS url' <- if dataURIs then return (newURL (mkDataURI svgBS))- else (copyFile cached outFile >> return (newURL outFile))- logStrLn "compiled."+ else liftIO (copyFile cached outFile >> return (newURL outFile))+ logResult "X" return url' where mkCached base = cacheDir </> base <.> "svg"- logStr = when (not quiet) . putStr- logStrLn = when (not quiet) . putStrLn mkDataURI svg = "data:image/svg+xml;base64," ++ BS8.unpack (BS64.encode svg) + logStr, logResult :: MonadIO m => String -> m ()+ logStr = liftIO . when (not quiet) . putStr+ logResult s = liftIO . when (not quiet) $ do+ setCursorColumn 1+ putStrLn s+ -- | Compile all the diagrams referenced in an entire module. compileDiagrams :: Bool -- ^ @True@ = quiet -> Bool -- ^ @True@ = generate data URIs@@ -497,7 +509,8 @@ -> FilePath -- ^ file being processed -> S.Set String -- ^ diagram names referenced from URLs -> [CodeBlock]- -> [Either String DiagramURL] -> IO ([Either String DiagramURL], Bool)+ -> [Either String DiagramURL]+ -> WriterT [String] IO ([Either String DiagramURL], Bool) compileDiagrams quiet dataURIs cacheDir outputDir file ds cs urls = do urls' <- urls & (traverse . _Right) %%~ compileDiagram quiet dataURIs cacheDir outputDir file ds cs@@ -550,15 +563,8 @@ Left _ -> error "This case can never happen; see prop_parseDiagramURLs_succeeds" Right urls -> do- (urls', changed) <- compileDiagrams- quiet- dataURIs- cacheDir- outputDir- file- ds- cs- urls+ ((urls', changed), msgs2) <- runWriterT $+ compileDiagrams quiet dataURIs cacheDir outputDir file ds cs urls let src' = displayDiagramURLs urls' -- See https://github.com/diagrams/diagrams-haddock/issues/8:@@ -566,7 +572,7 @@ -- we do the encoding to UTF-8 ourselves and then call -- writeFileL. when changed $ Cautiously.writeFileL file (T.encodeUtf8 . T.pack $ src')- return msgs+ return (msgs ++ msgs2) where go src = case runCE (parseCodeBlocks file src) of