diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -7,7 +7,21 @@ The following is information about what major changes have gone into each release. -Changes in 2999.18.1.1 +Changes in 2999.19.0.0 +---------------------- + +* Roll back change in 2999.18.1.0 for Monadic graphs, as they turn out + to not actually work in practice (reported by **Lennart Spitzner**). + +* Add a `quickParams` value to help with testing graphs in ghci + (requested by **Ian Jeffries**). + +* Fix parsing of edge chains (reported by **Jonas Collberg**). + +* Fix how seemingly numeric text literals are quoted (reported by + **Joey Hess**). + +Changes in 2999.18.1.2 ---------------------- * Allow dlist-0.8, thanks to **Sean Leather**. diff --git a/Data/GraphViz.hs b/Data/GraphViz.hs --- a/Data/GraphViz.hs +++ b/Data/GraphViz.hs @@ -26,6 +26,7 @@ -- ** Specifying parameters. -- $params GraphvizParams(..) + , quickParams , defaultParams , nonClusteredParams , blankParams @@ -206,6 +207,15 @@ -- | An alias for 'NodeCluster' when dealing with FGL graphs. type LNodeCluster cl l = NodeCluster cl (Node,l) +-- | Especially useful for quick explorations in ghci, this is a "do +-- what I mean" set of parameters that prints the specified labels +-- of a non-clustered graph. +quickParams :: (Labellable nl, Labellable el) => GraphvizParams n nl el () nl +quickParams = nonClusteredParams { fmtNode = nodeFmt, fmtEdge = edgeFmt } + where + nodeFmt (_,l) = [toLabel l] + edgeFmt (_,_,l) = [toLabel l] + -- | A default 'GraphvizParams' value which assumes the graph is -- directed, contains no clusters and has no 'Attribute's set. -- @@ -243,14 +253,14 @@ -- programmatically setting the clustering function (and as such do -- not know what the types might be). blankParams :: GraphvizParams n nl el cl l -blankParams = Params { isDirected = undefined - , globalAttributes = undefined - , clusterBy = undefined - , isDotCluster = undefined - , clusterID = undefined - , fmtCluster = undefined - , fmtNode = undefined - , fmtEdge = undefined +blankParams = Params { isDirected = error "Unspecified definition of isDirected" + , globalAttributes = error "Unspecified definition of globalAttributes" + , clusterBy = error "Unspecified definition of clusterBy" + , isDotCluster = error "Unspecified definition of isDotCluster" + , clusterID = error "Unspecified definition of clusterID" + , fmtCluster = error "Unspecified definition of fmtCluster" + , fmtNode = error "Unspecified definition of fmtNode" + , fmtEdge = error "Unspecified definition of fmtEdge" } -- | Determine if the provided 'Graph' is directed or not and set the diff --git a/Data/GraphViz/Internal/Util.hs b/Data/GraphViz/Internal/Util.hs --- a/Data/GraphViz/Internal/Util.hs +++ b/Data/GraphViz/Internal/Util.hs @@ -27,7 +27,7 @@ #if MIN_VERSION_base(4,8,0) import Data.Version (Version, makeVersion) #else -import Data.Version (Version (..)) +import Data.Version (Version(..)) #endif -- ----------------------------------------------------------------------------- @@ -48,13 +48,14 @@ restIDString :: Char -> Bool restIDString c = frstIDString c || isDigit c --- | Determine if this String represents a number. -isNumString :: Text -> Bool -isNumString "" = False -isNumString "-" = False -isNumString str = case T.uncons $ T.toLower str of - Just ('-',str') -> go str' - _ -> go str +-- | Determine if this String represents a number. Boolean parameter +-- determines if exponents are considered part of numbers for this. +isNumString :: Bool -> Text -> Bool +isNumString _ "" = False +isNumString _ "-" = False +isNumString allowE str = case T.uncons $ T.toLower str of + Just ('-',str') -> go str' + _ -> go str where -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all -- possible cases @@ -73,7 +74,7 @@ (ds,es) -> T.all isDigit ds && checkEs es checkEs str' = case T.uncons str' of Nothing -> True - Just ('e',ds) -> isIntString ds + Just ('e',ds) -> allowE && isIntString ds _ -> False {- diff --git a/Data/GraphViz/Parsing.hs b/Data/GraphViz/Parsing.hs --- a/Data/GraphViz/Parsing.hs +++ b/Data/GraphViz/Parsing.hs @@ -33,6 +33,7 @@ , runParserWith , parseLiberally , checkValidParse + , checkValidParseWithRest -- * Convenience parsing combinators. , ignoreSep , onlyBool @@ -125,7 +126,7 @@ -- parsing function consumes all of the 'Text' input (with the -- exception of whitespace at the end). runParser' :: Parse a -> Text -> a -runParser' p = checkValidParse . fst . runParser p' +runParser' p = checkValidParseWithRest . runParser p' where p' = p `discard` (whitespace *> eof) @@ -157,6 +158,15 @@ checkValidParse :: Either String a -> a checkValidParse (Left err) = throw (NotDotCode err) checkValidParse (Right a) = a + +-- | If unable to parse /Dot/ code properly, 'throw' a +-- 'GraphvizException', with the error containing the remaining +-- unparsed code.. +checkValidParseWithRest :: (Either String a, Text) -> a +checkValidParseWithRest (Left err, rst) = throw (NotDotCode err') + where + err' = err ++ "\n\nRemaining input:\n\t" ++ show rst +checkValidParseWithRest (Right a,_) = a -- | Parse the required value with the assumption that it will parse -- all of the input 'Text'. diff --git a/Data/GraphViz/Printing.hs b/Data/GraphViz/Printing.hs --- a/Data/GraphViz/Printing.hs +++ b/Data/GraphViz/Printing.hs @@ -72,8 +72,8 @@ -- Only implicitly import and re-export combinators. import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T -import Text.PrettyPrint.Leijen.Text.Monadic hiding (Pretty (..), - SimpleDoc (..), bool, +import Text.PrettyPrint.Leijen.Text.Monadic hiding (Pretty(..), + SimpleDoc(..), bool, displayIO, displayT, hPutDoc, putDoc, renderCompact, @@ -85,7 +85,7 @@ import Control.Monad.Trans.State import Data.Char (toLower) import qualified Data.Set as Set -import Data.Version (Version (..)) +import Data.Version (Version(..)) import Data.Word (Word16, Word8) -- ----------------------------------------------------------------------------- @@ -205,11 +205,11 @@ needsQuotes :: Text -> Bool needsQuotes str - | T.null str = True - | isKeyword str = True - | isIDString str = False - | isNumString str = False - | otherwise = True + | T.null str = True + | isKeyword str = True + | isIDString str = False + | isNumString False str = False + | otherwise = True addQuotes :: Text -> DotCode -> DotCode addQuotes = bool id dquotes . needsQuotes diff --git a/Data/GraphViz/Types.hs b/Data/GraphViz/Types.hs --- a/Data/GraphViz/Types.hs +++ b/Data/GraphViz/Types.hs @@ -125,7 +125,7 @@ import Data.GraphViz.Internal.State (GraphvizState) import Data.GraphViz.Internal.Util (bool) import Data.GraphViz.Parsing (ParseDot (..), adjustErr, - checkValidParse, parse, + checkValidParseWithRest, parse, parseLiberally, runParserWith) import Data.GraphViz.PreProcessing (preProcess) import Data.GraphViz.Printing (PrintDot (..), printIt) @@ -136,7 +136,7 @@ Number (..), numericValue, withGlob) import Data.GraphViz.Types.State -import Control.Arrow (first, second, (***)) +import Control.Arrow (second, (***)) import Control.Monad.Trans.State (evalState, execState, get, modify, put) import Data.Text.Lazy (Text) @@ -286,9 +286,9 @@ parseDotGraphWith :: (ParseDotRepr dg n) => (GraphvizState -> GraphvizState) -> Text -> dg n -parseDotGraphWith f = fst . prs . preProcess +parseDotGraphWith f = prs . preProcess where - prs = first checkValidParse . runParserWith f parse' + prs = checkValidParseWithRest . runParserWith f parse' parse' = parse `adjustErr` ("Unable to parse the Dot graph; usually this is because of either:\n\ diff --git a/Data/GraphViz/Types/Generalised.hs b/Data/GraphViz/Types/Generalised.hs --- a/Data/GraphViz/Types/Generalised.hs +++ b/Data/GraphViz/Types/Generalised.hs @@ -62,7 +62,7 @@ ) where import Data.GraphViz.Algorithms (canonicalise) -import Data.GraphViz.Internal.State (AttributeType (..)) +import Data.GraphViz.Internal.State (AttributeType(..)) import Data.GraphViz.Internal.Util (bool) import Data.GraphViz.Parsing import Data.GraphViz.Printing @@ -135,7 +135,6 @@ parse = parseUnqt -- Don't want the option of quoting `adjustErr` ("Not a valid generalised DotGraph\n\t"++) - -- | Assumed to be an injective mapping function. instance Functor DotGraph where diff --git a/Data/GraphViz/Types/Internal/Common.hs b/Data/GraphViz/Types/Internal/Common.hs --- a/Data/GraphViz/Types/Internal/Common.hs +++ b/Data/GraphViz/Types/Internal/Common.hs @@ -32,8 +32,8 @@ , parseStatements ) where -import Data.GraphViz.Attributes.Complete (Attribute (HeadPort, TailPort), - Attributes, Number (..), +import Data.GraphViz.Attributes.Complete (Attribute(HeadPort, TailPort), + Attributes, Number(..), usedByClusters, usedByGraphs, usedByNodes) import Data.GraphViz.Attributes.Internal (PortPos, parseEdgeBasedPP) @@ -76,7 +76,7 @@ stringNum :: Text -> GraphID stringNum str = maybe checkDbl (Num . Int) $ stringToInt str where - checkDbl = if isNumString str + checkDbl = if isNumString True str then Num . Dbl $ toDouble str else Str str @@ -280,8 +280,9 @@ parseEdgeNodes = oneOf [ parseBraced (wrapWhitespace -- Should really use sepBy1, but this will do. $ parseStatements parseEdgeNode) - , wrapWhitespace (sepBy1 parseEdgeNode (wrapWhitespace parseComma)) - , (: []) <$> parseEdgeNode ] + , sepBy1 parseEdgeNode (wrapWhitespace parseComma) + , (: []) <$> parseEdgeNode + ] parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n) parseEdgeNode = liftA2 (,) parse diff --git a/Data/GraphViz/Types/Monadic.hs b/Data/GraphViz/Types/Monadic.hs --- a/Data/GraphViz/Types/Monadic.hs +++ b/Data/GraphViz/Types/Monadic.hs @@ -70,7 +70,7 @@ , node , node' -- ** Edges - , NodeList (..) + -- $edges , edge , (-->) , (<->) @@ -84,7 +84,7 @@ import qualified Data.Sequence as Seq #if !(MIN_VERSION_base (4,8,0)) -import Control.Applicative (Applicative (..)) +import Control.Applicative (Applicative(..)) #endif -- ----------------------------------------------------------------------------- @@ -212,29 +212,35 @@ -- ----------------------------------------------------------------------------- -- Edges --- | A list of nodes to serve as edge end-points. -class NodeList n nl where - toNodeList :: nl -> [n] +{- $edges -instance NodeList n [n] where - toNodeList = id + If you wish to use something analogous to Dot's ability to write + multiple edges with in-line subgraphs such as: -instance NodeList n n where - toNodeList = (:[]) + > {a b c} -> {d e f} + Then you can use '-->' and '<->' in combination with monadic + traversal functions such as @traverse_@, @for_@, @mapM_@, @forM_@ + and @zipWithM_@; for example: + + > ("a" -->) `traverse_` ["d", "e", "f"] + > ["a", "b", "c"] `for_` (--> "d") + > zipWithM_ (-->) ["a", "b", "c"] ["d", "e", "f"] + + -} + -- | Add an edge to the graph. -edge :: (NodeList n f, NodeList n t) => f -> t -> Attributes -> Dot n -edge fl tl as = mapM_ (tellStmt . ME) - [ DotEdge f t as | f <- toNodeList fl, t <- toNodeList tl ] +edge :: n -> n -> Attributes -> Dot n +edge f t = tellStmt . ME . DotEdge f t -- | Add an edge with no attributes. -(-->) :: (NodeList n f, NodeList n t) => f -> t -> Dot n +(-->) :: n -> n -> Dot n f --> t = edge f t [] infixr 9 --> -- | An alias for '-->' to make edges look more undirected. -(<->) :: (NodeList n f, NodeList n t) => f -> t -> Dot n +(<->) :: n -> n -> Dot n (<->) = (-->) infixr 9 <-> diff --git a/graphviz.cabal b/graphviz.cabal --- a/graphviz.cabal +++ b/graphviz.cabal @@ -1,5 +1,5 @@ Name: graphviz -Version: 2999.18.1.2 +Version: 2999.19.0.0 Stability: Beta Synopsis: Bindings to Graphviz for graph visualisation. Description: { diff --git a/tests/Data/GraphViz/Testing/Instances/Helpers.hs b/tests/Data/GraphViz/Testing/Instances/Helpers.hs --- a/tests/Data/GraphViz/Testing/Instances/Helpers.hs +++ b/tests/Data/GraphViz/Testing/Instances/Helpers.hs @@ -66,7 +66,7 @@ shrinkString = map T.unpack . shrink . T.pack notNumStr :: Text -> Bool -notNumStr = not . isNumString +notNumStr = not . isNumString True arbBounded :: (Bounded a, Enum a) => Gen a arbBounded = elements [minBound .. maxBound]