graphviz 2999.5.0.0 → 2999.5.1.0

raw patch · 8 files changed

+186/−78 lines, 8 filesdep +parallelPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parallel

API changes (from Hackage documentation)

Files

• Changelog +28/−14
• Data/GraphViz.hs +6/−5
• Data/GraphViz/Attributes.hs +22/−17
• Data/GraphViz/Commands.hs +10/−6
• Data/GraphViz/Types.hs +8/−7
• Data/GraphViz/Types/Parsing.hs +103/−27
• Data/GraphViz/Types/Printing.hs +7/−1
• graphviz.cabal +2/−1

@@ -1,6 +1,20 @@-Changes since 2999.1.0.2-========================+Changes in 2999.5.1.0+===================== +* Potentially fixed the graphvizWithHandle bug; correct approach+  spotted by Nikolas Mayr.++* Fixed up Parsing of various Attribute sub-values, especially Point and+  Spline (and hence Pos, which uses them).++* Pre-process out comments and join together multi-line strings before+  parsing.++* Properly parse Doubles like ".2".++Changes in 2999.5.0.0+=====================+ A major re-write occured; these are the highlights:  * Re-write parsing and printing of Dot code using the new ParseDot and@@ -34,25 +48,25 @@   uses "from" and "to" avoid ambiguity; the various Attribute values   still follow upstream usage. -Changes since 2999.1.0.1-========================+Changes in 2999.1.0.2+=====================  * Fix a bug spotted by Srihari Ramanathan where Color values were   double-quoted. -Changes since 2999.1.0.0-========================+Changes in 2999.1.0.1+=====================  * The Color Attribute should take [Color], not just a single Color. -Changes since 2999.0.0.0-========================+Changes in 2999.1.0.0+=====================  * Stop using Either for composite Attributes and use a custom type:   this avoids problems with the Show instance. -Changes since 2009.5.1-======================+Changes in 2999.0.0.0+=====================  * Fixed a bug where the Show instance and read function for DotEdge   had the from/to nodes the wrong way round.  This was not immediately@@ -79,8 +93,8 @@ * Follow the PVP rather than using dates for versions:   http://www.haskell.org/haskellwiki/Package_versioning_policy -Changes since 2008.9.20:-========================+Changes in 2009.5.1+===================  * Support polyparse >= 1.1 (as opposed to < 1.3) @@ -96,8 +110,8 @@  * Improved Haddock documentation. -Changes since 2008.9.6-======================+Changes in 2008.9.20+====================  * Differentiate between undirected and directed graphs (previously   only directed graphs were supported).

@@ -59,6 +59,7 @@ import Control.Arrow((&&&)) import Data.Maybe(mapMaybe, fromJust) import qualified Data.Map as Map+import Control.Parallel.Strategies(rnf) import System.IO(hGetContents) import System.IO.Unsafe(unsafePerformIO) @@ -166,13 +167,13 @@ dotAttributes :: (Graph gr) => Bool -> gr a b -> DotGraph Node                  -> IO (gr (AttributeNode a) (AttributeEdge b)) dotAttributes isDir gr dot-    = do output <- graphvizWithHandle command dot DotOutput hGetContents-         let res = fromJust output-         length res `seq` return ()-         return $ rebuildGraphWithAttributes res+    = do (Just output) <- graphvizWithHandle command dot DotOutput hToString+         return $ rebuildGraphWithAttributes output     where       command = if isDir then dirCommand else undirCommand-      rebuildGraphWithAttributes dotResult = mkGraph lnodes ledges+      hToString h = do s <- hGetContents h+                       rnf s `seq` return s+      rebuildGraphWithAttributes dotResult =  mkGraph lnodes ledges           where             lnodes = map (\(n, l) -> (n, (fromJust $ Map.lookup n nodeMap, l)))                      $ labNodes gr

@@ -26,9 +26,6 @@      /A/ to /B/, then /A/ is the tail node and /B/ is the head node      (since /A/ is at the tail end of the arrow). -   * GraphViz says that a number like @/.02/@ is valid; this library-     disagrees.-    * When parsing named 'Color' values, the entire value entered is      kept as-is; this library as yet has no understanding of different      color schemes, etc.@@ -153,6 +150,7 @@ import Data.Maybe(isJust, maybe) import Data.Word(Word8) import Numeric(showHex, readHex)+import Control.Arrow(first) import Control.Monad(liftM)  -- -----------------------------------------------------------------------------@@ -1084,14 +1082,14 @@     toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at  instance ParseDot AspectType where-    parseUnqt = liftM (uncurry RatioPassCount) commaSep+    parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt                 `onFail`-                liftM RatioOnly parse+                liftM RatioOnly parseUnqt  -    parse = quotedParse (liftM (uncurry RatioPassCount) commaSep)+    parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)             `onFail`-            optionalQuoted (liftM RatioOnly parse)+            liftM RatioOnly parse  -- ----------------------------------------------------------------------------- @@ -1104,11 +1102,9 @@     toDot = doubleQuotes . unqtDot  instance ParseDot Rect where-    parseUnqt = liftM (uncurry Rect)-                $ commaSep' parseUnqt parseUnqt+    parseUnqt = liftM (uncurry Rect) commaSepUnqt -    parse = liftM (uncurry Rect) . quotedParse-            $ commaSep' parseUnqt parseUnqt+    parse = quotedParse parseUnqt  -- ----------------------------------------------------------------------------- @@ -1354,9 +1350,20 @@     listToDot = doubleQuotes . unqtListToDot  instance ParseDot Point where-    parseUnqt = liftM (uncurry Point)  commaSep+    -- Need to take into account the situation where first value is an+    -- integer, second a double: if Point parsing first, then it won't+    -- parse the second number properly; but if PointD first then it+    -- will treat Int/Int as Double/Double.+    parseUnqt = intDblPoint                 `onFail`-                liftM (uncurry PointD) commaSep+                liftM (uncurry Point)  commaSepUnqt+                `onFail`+                liftM (uncurry PointD) commaSepUnqt+        where+          intDblPoint = liftM (uncurry PointD . first fI)+                        $ commaSep' parseUnqt parseStrictFloat+          fI :: Int -> Double+          fI = fromIntegral      parse = quotedParse parseUnqt @@ -1663,15 +1670,13 @@  instance ParseDot Spline where     parseUnqt = do ms <- parseP 's'-                   whitespace                    me <- parseP 'e'-                   whitespace                    ps <- sepBy1 parseUnqt whitespace                    return $ Spline ms me ps         where           parseP t = optional $ do character t-                                   character ';'-                                   parse+                                   parseComma+                                   parseUnqt `discard` whitespace      parse = quotedParse parseUnqt 

@@ -164,17 +164,23 @@                  $ openFile fp WriteMode          case pipe of            (Left _)  -> return False-           (Right f) -> do file <- graphvizWithHandle cmd gr t (flip squirt f)-                           hClose f+           (Right f) -> do file <- graphvizWithHandle cmd gr t (toFile f)                            case file of                              (Just _) -> return True                              _        -> return False+    where+      toFile f h = do squirt h f+                      hClose h+                      hClose f  -- graphvizWithHandle sometimes throws an error about handles not -- being closed properly: investigate (now on the official TODO). --- | Run the chosen Graphviz command on this graph, but send the result to the---   given handle rather than to a file.+-- | Run the chosen Graphviz command on this graph, but send the+--   result to the given handle rather than to a file.  The @'Handle'+--   -> 'IO' a@ function should close the 'Handle' once it is+--   finished.+-- --   The result is wrapped in 'Maybe' rather than throwing an error. graphvizWithHandle :: (PrintDot n, Show a) => GraphvizCommand -> DotGraph n                       -> GraphvizOutput -> (Handle -> IO a) -> IO (Maybe a)@@ -183,8 +189,6 @@          forkIO $ hPutStrLn inp (printDotGraph gr) >> hClose inp          forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)          a <- f outp-         -- Don't close outp until f finishes.-         a `seq` hClose outp          exitCode <- waitForProcess prc          case exitCode of            ExitSuccess -> return (Just a)

@@ -43,8 +43,8 @@      end points.     * When either creating a 'DotGraph' by hand or parsing one, it is-     possible to specify that @'directedGraph' = d@, but at lease one-     'DotEdge' has @'directedEdge' = 'not' d@.+     possible to specify that @'directedGraph' = d@, but 'DotEdge'+     values with @'directedEdge' = 'not' d@.     * Nodes cannot have Port values. @@ -53,10 +53,9 @@      having graph attributes that do not apply to subgraphs\/clusters      by listing them /after/ the subgraphs\/clusters. -   * The parser cannot as yet parse comments (in that it doesn't even-     know what comments are, and will throw an error).  Multiline-     statements and C pre-processor lines (that is, lines beginning-     with a @#@) are also not parseable.+   * The parser will strip out comments and convert multiline strings+     into a single line string.  Pre-processor lines (i.e. those+     started by @#@) and string concatenation are not yet supported.     See "Data.GraphViz.Attributes" for more limitations. @@ -130,8 +129,10 @@ -- | Parse a limited subset of the Dot language to form a 'DotGraph' --   (that is, the caveats listed in "Data.GraphViz.Attributes" aside, --   Dot graphs are parsed if they match the layout of 'DotGraph').+--+--   Also removes any comments, etc. before parsing. parseDotGraph :: (ParseDot a) => String -> DotGraph a-parseDotGraph = fst . runParser parse+parseDotGraph = fst . runParser parse . preprocess  -- | Check if all the 'Attribute's are being used correctly. isValidGraph :: DotGraph a -> Bool

@@ -19,9 +19,12 @@    instance. -} module Data.GraphViz.Types.Parsing-    ( module Text.ParserCombinators.Poly.Lazy+    ( -- * Re-exporting pertinent parts of Polyparse.+      module Text.ParserCombinators.Poly.Lazy+      -- * The ParseDot class.     , Parse     , ParseDot(..)+      -- * Convenience parsing combinators.     , stringBlock     , numString     , quotedString@@ -30,6 +33,7 @@     , strings     , hasString     , character+    , parseStrictFloat     , noneOf     , whitespace     , whitespace'@@ -49,8 +53,11 @@     , parseFieldDef     , parseFieldsDef     , commaSep+    , commaSepUnqt     , commaSep'     , stringRep+    -- * Pre-processing+    , preprocess     ) where  import Data.GraphViz.Types.Internal@@ -64,7 +71,7 @@ import Data.Function(on) import Data.Maybe(isJust, fromMaybe) import Data.Ratio((%))-import Control.Monad+import Control.Monad(liftM)  -- ----------------------------------------------------------------------------- -- Based off code from Text.Parse in the polyparse library@@ -104,7 +111,7 @@  instance ParseDot Char where     -- Can't be a quote character.-    parseUnqt = satisfy ((/=) '"')+    parseUnqt = satisfy ((/=) quoteChar)      parse = satisfy restIDString             `onFail`@@ -138,12 +145,15 @@  -- | Used when quotes are explicitly required; quotedString :: Parse String-quotedString = many $ oneOf [ stringRep '"' "\\\""-                            , satisfy ((/=) '"')-                            ]+quotedString = many stringInterior +stringInterior :: Parse Char+stringInterior = stringRep quoteChar "\\\""+                 `onFail`+                 satisfy ((/=) quoteChar)+ parseSigned :: Real a => Parse a -> Parse a-parseSigned p = do '-' <- next; commit (fmap negate p)+parseSigned p = (character '-' >> liftM negate p)                 `onFail`                 p @@ -158,29 +168,35 @@ parseInt' :: Parse Int parseInt' = parseSigned parseInt +-- | Parse a floating point number that actually contains decimals.+parseStrictFloat :: (RealFrac a) => Parse a+parseStrictFloat = parseSigned parseFloat+ parseFloat :: (RealFrac a) => Parse a-parseFloat = do ds   <- many1 (satisfy isDigit)-                frac <- (do '.' <- next-                            many (satisfy isDigit)-                              `adjustErrBad` (++"expected digit after .")-                         `onFail` return [] )+parseFloat = do ds   <- many (satisfy isDigit)+                frac <- do character '.'+                           many (satisfy isDigit)+                                    `adjustErrBad` (++ "\nexpected digit after .")+                       `adjustErr` (++ "expected decimal component")                 expn  <- parseExp `onFail` return 0                 ( return . fromRational . (* (10^^(expn - length frac)))                   . (%1) . fst                   . runParser parseInt) (ds++frac)              `onFail`-             do w <- many (satisfy (not.isSpace))-                case map toLower w of-                  "nan"      -> return (0/0)-                  "infinity" -> return (1/0)-                  _          -> fail "expected a floating point number"-  where parseExp = do 'e' <- fmap toLower next-                      commit (do '+' <- next; parseInt-                              `onFail`-                              parseSigned parseInt)+             fail "Expected a floating point number"+    where parseExp = do character 'e'+                        commit ((character '+' >> parseInt)+                                `onFail`+                                parseSigned parseInt)  parseFloat' :: Parse Double-parseFloat' = parseSigned parseFloat+parseFloat' = parseSigned ( parseFloat+                            `onFail`+                            liftM fI parseInt+                          )+    where+      fI :: Integer -> Double+      fI = fromIntegral  -- ----------------------------------------------------------------------------- @@ -222,10 +238,14 @@                    quotedParse p  quotedParse   :: Parse a -> Parse a-quotedParse p = bracket quote quote p-    where-      quote = character '"'+quotedParse p = bracket parseQuote parseQuote p +parseQuote :: Parse Char+parseQuote = character quoteChar++quoteChar :: Char+quoteChar = '"'+ newline :: Parse String newline = oneOf $ map string ["\r\n", "\n", "\r"] @@ -235,8 +255,10 @@ newline' :: Parse () newline' = many (whitespace' >> newline) >> return () -skipToNewline :: Parse ()-skipToNewline = many (noneOf ['\n','\r']) >> newline >> return ()+-- | Parses and returns all characters up till the end of the line,+--   then skips to the beginning of the next line.+skipToNewline :: Parse String+skipToNewline = many (noneOf ['\n','\r']) `discard` newline  parseField     :: (ParseDot a) => String -> Parse a parseField fld = do string fld@@ -267,6 +289,9 @@ commaSep :: (ParseDot a, ParseDot b) => Parse (a, b) commaSep = commaSep' parse parse +commaSepUnqt :: (ParseDot a, ParseDot b) => Parse (a, b)+commaSepUnqt = commaSep' parseUnqt parseUnqt+ commaSep'       :: Parse a -> Parse b -> Parse (a,b) commaSep' pa pb = do a <- pa                      whitespace'@@ -283,3 +308,54 @@  tryParseList' :: Parse [a] -> Parse [a] tryParseList' = liftM (fromMaybe []) . optional++-- -----------------------------------------------------------------------------+-- Filtering out unwanted Dot items such as comments++-- | Remove unparseable features of Dot, such as comments and+--   multi-line strings (which are converted to single-line strings).+preprocess :: String -> String+preprocess = fst . runParser parseOutUnwanted++-- | Parse out comments and make quoted strings spread over multiple+--   lines only over a single line.  Should parse the /entire/ input+--   'String'.+parseOutUnwanted :: Parse String+parseOutUnwanted = liftM concat (many getNext)+    where+      getNext :: Parse String+      getNext = (oneOf [ parseLineComment, parseMultiLineComment ] >> return [])+                `onFail`+                parseSplitStrings+                `onFail`+                liftM return next++-- | Parse @//@-style comments.+parseLineComment :: Parse String+parseLineComment = string "//" >> newline++-- | Parse @/* ... */@-style comments.+parseMultiLineComment :: Parse String+parseMultiLineComment = bracket start end (liftM concat $ many inner)+    where+      start = string "/*"+      end = string "*/"+      inner = many1 (satisfy ((/=) '*'))+              `onFail`+              do ast <- character '*'+                 n <- satisfy ((/=) '/')+                 liftM ((:) ast . (:) n) inner++-- | Parse out @\<newline>@ from a quoted string.+parseSplitStrings :: Parse String+parseSplitStrings = do oq <- parseQuote+                       inner <- liftM concat $ many parseInner+                       cq <- parseQuote+                       return $ oq : inner ++ [cq]+    where+      parseInner = string "\\\""+                   `onFail`+                   (character '\\' >> newline >> return [])+                   `onFail`+                   liftM return (satisfy ((/=) quoteChar))+

@@ -100,7 +100,13 @@     unqtDot = int  instance PrintDot Double where-    unqtDot = double+    -- If it's an "integral" double, then print as an integer.+    -- This seems to match how GraphViz apps use Dot.+    unqtDot d = if d == fromIntegral di+                then int di+                else double d+        where+          di = round d  instance PrintDot Bool where     unqtDot True  = text "true"

@@ -1,5 +1,5 @@ Name:               graphviz-Version:            2999.5.0.0+Version:            2999.5.1.0 Stability:          Beta Synopsis:           GraphViz bindings for Haskell. Description:        Provides convenient functions to convert FGL@@ -33,6 +33,7 @@                            process,                            array,                            fgl,+                           parallel >= 1.1 && < 1.2,                            polyparse >= 1.1,                            pretty