{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
             TypeSynonymInstances #-}

{- |
   Module      : Data.GraphViz.Types
   Description : Haskell representation of Dot graphs.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   Four different representations of Dot graphs are available, all of
   which are based loosely upon the specifications at:
   <http://graphviz.org/doc/info/lang.html>.  The 'DotRepr' class
   provides a common interface for them (the 'PrintDotRepr',
   'ParseDotRepr' and 'PPDotRepr' classes are used until class aliases
   are implemented).

   Every representation takes in a type parameter: this indicates the
   node type (e.g. @DotGraph Int@ is a Dot graph with integer nodes).
   Sum types are allowed, though care must be taken when specifying
   their 'ParseDot' instances if there is the possibility of
   overlapping definitions.  The 'GraphID' type is an existing sum
   type that allows textual and numeric values.

   If you require using more than one Dot representation, you will
   most likely need to import at least one of them qualified, as they
   typically all use the same names.

   As a comparison, all four representations provide how you would
   define the following Dot graph (or at least one isomorphic to it)
   (the original of which can be found at
   <http://graphviz.org/content/cluster>).  Note that in all the
   examples, they are not necessarily done the best way (variables
   rather than repeated constants, etc.); they are just there to
   provide a comparison on the structure of each representation.

   > digraph G {
   >
   >   subgraph cluster_0 {
   >     style=filled;
   >     color=lightgrey;
   >     node [style=filled,color=white];
   >     a0 -> a1 -> a2 -> a3;
   >     label = "process #1";
   >   }
   >
   >   subgraph cluster_1 {
   >     node [style=filled];
   >     b0 -> b1 -> b2 -> b3;
   >     label = "process #2";
   >     color=blue
   >   }
   >   start -> a0;
   >   start -> b0;
   >   a1 -> b3;
   >   b2 -> a3;
   >   a3 -> a0;
   >   a3 -> end;
   >   b3 -> end;
   >
   >   start [shape=Mdiamond];
   >   end [shape=Msquare];
   > }

    Each representation is suited for different things:

    ["Data.GraphViz.Types.Canonical"] is ideal for converting other
    graph-like data structures into Dot graphs (the "Data.GraphViz"
    module provides some functions for this).  It is a structured
    representation of Dot code.

    ["Data.GraphViz.Types.Generalised"] matches the actual structure
    of Dot code.  As such, it is suited for parsing in existing Dot
    code.

    ["Data.GraphViz.Types.Graph"] provides graph operations for
    manipulating Dot graphs; this is suited when you want to edit
    existing Dot code.  It uses generalised Dot graphs for parsing and
    canonical Dot graphs for printing.

    ["Data.GraphViz.Types.Monadic"] is a much easier representation to
    use when defining relatively static Dot graphs in Haskell code,
    and looks vaguely like actual Dot code if you squint a bit.

    Please also read the limitations section at the end for advice on
    how to properly use these Dot representations.

-}
module Data.GraphViz.Types
       ( DotRepr(..)
       , PrintDot(..)
       , ParseDot(..)
       , PrintDotRepr
       , ParseDotRepr
       , PPDotRepr
         -- * Common sub-types
       , GraphID(..)
       , Number (..)
       , ToGraphID(..)
       , textGraphID
       , GlobalAttributes(..)
       , DotNode(..)
       , DotEdge(..)
         -- * Helper types for looking up information within a @DotRepr@.
       , ClusterLookup
       , NodeLookup
       , Path
       , graphStructureInformationClean
       , nodeInformationClean
       , edgeInformationClean
         -- * Obtaining the @DotNode@s and @DotEdges@.
       , graphNodes
       , graphEdges
         -- * Printing and parsing a @DotRepr@.
       , printDotGraph
       , parseDotGraph
       , parseDotGraphLiberally
         -- * Limitations and documentation
         -- $limitations
       ) where

import Data.GraphViz.Attributes.Complete   (rmUnwantedAttributes,
                                            usedByClusters, usedByEdges,
                                            usedByGraphs, usedByNodes)
import Data.GraphViz.Internal.State        (GraphvizState)
import Data.GraphViz.Internal.Util         (bool)
import Data.GraphViz.Parsing               (ParseDot(..), adjustErr,
                                            checkValidParseWithRest, parse,
                                            parseLiberally, runParserWith)
import Data.GraphViz.PreProcessing         (preProcess)
import Data.GraphViz.Printing              (PrintDot(..), printIt)
import Data.GraphViz.Types.Canonical       (DotGraph(..), DotStatements(..),
                                            DotSubGraph(..))
import Data.GraphViz.Types.Internal.Common (DotEdge(..), DotNode(..),
                                            GlobalAttributes(..), GraphID(..),
                                            Number(..), numericValue, withGlob)
import Data.GraphViz.Types.State

import           Control.Arrow       (second, (***))
import           Control.Monad.State (evalState, execState, get, modify, put)
import           Data.Text.Lazy      (Text)
import qualified Data.Text.Lazy      as T

-- -----------------------------------------------------------------------------

-- | This class is used to provide a common interface to different
--   ways of representing a graph in /Dot/ form.
--
--   You will most probably /not/ need to create your own instances of
--   this class.
--
--   The type variable represents the current node type of the Dot
--   graph, and the 'Ord' restriction is there because in practice
--   most implementations of some of these methods require it.
class (Ord n) => DotRepr dg n where
  -- | Convert from a graph in canonical form.  This is especially
  --   useful when using the functions from "Data.GraphViz.Algorithms".
  --
  --   See @FromGeneralisedDot@ in "Data.GraphViz.Types.Generalised"
  --   for a semi-inverse of this function.
  fromCanonical :: DotGraph n -> dg n

  -- | Return the ID of the graph.
  getID :: dg n -> Maybe GraphID

  -- | Set the ID of the graph.
  setID :: GraphID -> dg n -> dg n

  -- | Is this graph directed?
  graphIsDirected :: dg n -> Bool

  -- | Set whether a graph is directed or not.
  setIsDirected :: Bool -> dg n -> dg n

  -- | Is this graph strict?  Strict graphs disallow multiple edges.
  graphIsStrict :: dg n -> Bool

  -- | A strict graph disallows multiple edges.
  setStrictness :: Bool -> dg n -> dg n

  -- | Change the node values.  This function is assumed to be
  --   /injective/, otherwise the resulting graph will not be
  --   identical to the original (modulo labels).
  mapDotGraph :: (DotRepr dg n') => (n -> n') -> dg n -> dg n'

  -- | Return information on all the clusters contained within this
  --   'DotRepr', as well as the top-level 'GraphAttrs' for the
  --   overall graph.
  graphStructureInformation :: dg n -> (GlobalAttributes, ClusterLookup)

  -- | Return information on the 'DotNode's contained within this
  --   'DotRepr'.  The 'Bool' parameter indicates if applicable
  --   'NodeAttrs' should be included.
  nodeInformation :: Bool -> dg n -> NodeLookup n

  -- | Return information on the 'DotEdge's contained within this
  --   'DotRepr'.  The 'Bool' parameter indicates if applicable
  --   'EdgeAttrs' should be included.
  edgeInformation :: Bool -> dg n -> [DotEdge n]

  -- | Give any anonymous sub-graphs or clusters a unique identifier
  --   (i.e. there will be no 'Nothing' key in the 'ClusterLookup'
  --   from 'graphStructureInformation').
  unAnonymise :: dg n -> dg n

-- | A variant of 'graphStructureInformation' with default attributes
--   removed and only attributes usable by graph/cluster kept (where
--   applicable).
graphStructureInformationClean :: (DotRepr dg n) => dg n
                                  -> (GlobalAttributes, ClusterLookup)
graphStructureInformationClean :: forall (dg :: * -> *) n.
DotRepr dg n =>
dg n -> (GlobalAttributes, ClusterLookup)
graphStructureInformationClean = (GlobalAttributes -> GlobalAttributes
globOnly forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second GlobalAttributes -> GlobalAttributes
clustOnly))
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
dg n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation
  where
    globOnly :: GlobalAttributes -> GlobalAttributes
globOnly = (Attributes -> Attributes) -> GlobalAttributes -> GlobalAttributes
withGlob forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByGraphs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
rmUnwantedAttributes

    clustOnly :: GlobalAttributes -> GlobalAttributes
clustOnly = (Attributes -> Attributes) -> GlobalAttributes -> GlobalAttributes
withGlob forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByClusters forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
rmUnwantedAttributes


-- | A variant of 'nodeInformation' with default attributes removed
--   and only attributes used by nodes kept.
nodeInformationClean :: (DotRepr dg n) => Bool -> dg n -> NodeLookup n
nodeInformationClean :: forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> NodeLookup n
nodeInformationClean = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Attributes -> Attributes
nodeOnly) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> NodeLookup n
nodeInformation
  where
    nodeOnly :: Attributes -> Attributes
nodeOnly = forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
rmUnwantedAttributes

-- | A variant of 'edgeInformation' with default attributes removed
--   and only attributes used by edges kept.
edgeInformationClean :: (DotRepr dg n) => Bool -> dg n -> [DotEdge n]
edgeInformationClean :: forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> [DotEdge n]
edgeInformationClean = (forall a b. (a -> b) -> [a] -> [b]
map forall {n}. DotEdge n -> DotEdge n
rmEdgeAs forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> [DotEdge n]
edgeInformation
  where
    rmEdgeAs :: DotEdge n -> DotEdge n
rmEdgeAs DotEdge n
de = DotEdge n
de { edgeAttributes :: Attributes
edgeAttributes = Attributes -> Attributes
edgeOnly forall a b. (a -> b) -> a -> b
$ forall n. DotEdge n -> Attributes
edgeAttributes DotEdge n
de }

    edgeOnly :: Attributes -> Attributes
edgeOnly = forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
rmUnwantedAttributes


-- | This class exists just to make type signatures nicer; all
--   instances of 'DotRepr' should also be an instance of
--   'PrintDotRepr'.
class (DotRepr dg n, PrintDot (dg n)) => PrintDotRepr dg n

-- | This class exists just to make type signatures nicer; all
--   instances of 'DotRepr' should also be an instance of
--   'ParseDotRepr'.
class (DotRepr dg n, ParseDot (dg n)) => ParseDotRepr dg n

-- | This class exists just to make type signatures nicer; all
--   instances of 'DotRepr' should also be an instance of
--   'PPDotRepr'.
class (PrintDotRepr dg n, ParseDotRepr dg n) => PPDotRepr dg n

-- | Returns all resultant 'DotNode's in the 'DotRepr' (not including
--   'NodeAttr's).
graphNodes :: (DotRepr dg n) => dg n -> [DotNode n]
graphNodes :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> [DotNode n]
graphNodes = forall n. NodeLookup n -> [DotNode n]
toDotNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> NodeLookup n
nodeInformation Bool
False

-- | Returns all resultant 'DotEdge's in the 'DotRepr' (not including
--   'EdgeAttr's).
graphEdges :: (DotRepr dg n) => dg n -> [DotEdge n]
graphEdges :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> [DotEdge n]
graphEdges = forall (dg :: * -> *) n.
DotRepr dg n =>
Bool -> dg n -> [DotEdge n]
edgeInformation Bool
False

-- | The actual /Dot/ code for an instance of 'DotRepr'.  Note that it
--   is expected that @'parseDotGraph' . 'printDotGraph' == 'id'@
--   (this might not be true the other way around due to un-parseable
--   components).
printDotGraph :: (PrintDotRepr dg n) => dg n -> Text
printDotGraph :: forall (dg :: * -> *) n. PrintDotRepr dg n => dg n -> Text
printDotGraph = forall a. PrintDot a => a -> Text
printIt

-- | Parse a limited subset of the Dot language to form an instance of
--   'DotRepr'.  Each instance may have its own limitations on what
--   may or may not be parseable Dot code.
--
--   Also removes any comments, etc. before parsing.
parseDotGraph :: (ParseDotRepr dg n) => Text -> dg n
parseDotGraph :: forall (dg :: * -> *) n. ParseDotRepr dg n => Text -> dg n
parseDotGraph = forall (dg :: * -> *) n.
ParseDotRepr dg n =>
(GraphvizState -> GraphvizState) -> Text -> dg n
parseDotGraphWith forall a. a -> a
id

-- | As with 'parseDotGraph', but if an 'Attribute' cannot be parsed
--   strictly according to the known rules, let it fall back to being
--   parsed as an 'UnknownAttribute'.  This is especially useful for
--   when using a version of Graphviz that is either newer (especially
--   for the XDot attributes) or older (when some attributes have
--   changed) but you'd still prefer it to parse rather than throwing
--   an error.
parseDotGraphLiberally :: (ParseDotRepr dg n) => Text -> dg n
parseDotGraphLiberally :: forall (dg :: * -> *) n. ParseDotRepr dg n => Text -> dg n
parseDotGraphLiberally = forall (dg :: * -> *) n.
ParseDotRepr dg n =>
(GraphvizState -> GraphvizState) -> Text -> dg n
parseDotGraphWith GraphvizState -> GraphvizState
parseLiberally

parseDotGraphWith :: (ParseDotRepr dg n) => (GraphvizState -> GraphvizState)
                     -> Text -> dg n
parseDotGraphWith :: forall (dg :: * -> *) n.
ParseDotRepr dg n =>
(GraphvizState -> GraphvizState) -> Text -> dg n
parseDotGraphWith GraphvizState -> GraphvizState
f = Text -> dg n
prs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
preProcess
  where
    prs :: Text -> dg n
prs = forall a. (Either String a, Text) -> a
checkValidParseWithRest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(GraphvizState -> GraphvizState)
-> Parse a -> Text -> (Either String a, Text)
runParserWith GraphvizState -> GraphvizState
f Parser GraphvizState (dg n)
parse'

    parse' :: Parser GraphvizState (dg n)
parse' = forall a. ParseDot a => Parse a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr`
             (String
"Unable to parse the Dot graph; usually this is because of either:\n\
              \  * Wrong choice of representation: try the Generalised one\n\
              \  * Wrong choice of node type; try with `DotGraph String`.\n\
              \\n\
              \The actual parsing error was:\n\t"forall a. [a] -> [a] -> [a]
++)

-- -----------------------------------------------------------------------------
-- Instance for Canonical graphs, to avoid cyclic modules.

instance (Ord n) => DotRepr DotGraph n where
  fromCanonical :: DotGraph n -> DotGraph n
fromCanonical = forall a. a -> a
id

  getID :: DotGraph n -> Maybe GraphID
getID = forall n. DotGraph n -> Maybe GraphID
graphID

  setID :: GraphID -> DotGraph n -> DotGraph n
setID GraphID
i DotGraph n
g = DotGraph n
g { graphID :: Maybe GraphID
graphID = forall a. a -> Maybe a
Just GraphID
i }

  graphIsDirected :: DotGraph n -> Bool
graphIsDirected = forall n. DotGraph n -> Bool
directedGraph

  setIsDirected :: Bool -> DotGraph n -> DotGraph n
setIsDirected Bool
d DotGraph n
g = DotGraph n
g { directedGraph :: Bool
directedGraph = Bool
d }

  graphIsStrict :: DotGraph n -> Bool
graphIsStrict = forall n. DotGraph n -> Bool
strictGraph

  setStrictness :: Bool -> DotGraph n -> DotGraph n
setStrictness Bool
s DotGraph n
g = DotGraph n
g { strictGraph :: Bool
strictGraph = Bool
s }

  mapDotGraph :: forall n'.
DotRepr DotGraph n' =>
(n -> n') -> DotGraph n -> DotGraph n'
mapDotGraph = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

  graphStructureInformation :: DotGraph n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation = forall a. GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotStatements n -> GraphState ()
statementStructure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements

  nodeInformation :: Bool -> DotGraph n -> NodeLookup n
nodeInformation Bool
wGlobal = forall n a. Bool -> NodeState n a -> NodeLookup n
getNodeLookup Bool
wGlobal
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements

  edgeInformation :: Bool -> DotGraph n -> [DotEdge n]
edgeInformation Bool
wGlobal = forall n a. Bool -> EdgeState n a -> [DotEdge n]
getDotEdges Bool
wGlobal
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotStatements n -> EdgeState n ()
statementEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements

  unAnonymise :: DotGraph n -> DotGraph n
unAnonymise = forall n. DotGraph n -> DotGraph n
renumber

instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n
instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n
instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n

statementStructure :: DotStatements n -> GraphState ()
statementStructure :: forall n. DotStatements n -> GraphState ()
statementStructure DotStatements n
stmts
  = do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GlobalAttributes -> GraphState ()
addGraphGlobals forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
attrStmts DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall a. Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph forall n. DotStatements n -> GraphState ()
statementStructure) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
subGraphs DotStatements n
stmts

statementNodes :: (Ord n) => DotStatements n -> NodeState n ()
statementNodes :: forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes DotStatements n
stmts
  = do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall n. GlobalAttributes -> NodeState n ()
addNodeGlobals forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
attrStmts DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
subGraphs DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall n. Ord n => DotNode n -> NodeState n ()
addNode forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotNode n]
nodeStmts DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall n. Ord n => DotEdge n -> NodeState n ()
addEdgeNodes forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotEdge n]
edgeStmts DotStatements n
stmts

statementEdges :: DotStatements n -> EdgeState n ()
statementEdges :: forall n. DotStatements n -> EdgeState n ()
statementEdges DotStatements n
stmts
  = do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall n. GlobalAttributes -> EdgeState n ()
addEdgeGlobals forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
attrStmts DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall forall n. DotStatements n -> EdgeState n ()
statementEdges) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
subGraphs DotStatements n
stmts
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall n. DotEdge n -> EdgeState n ()
addEdge forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotEdge n]
edgeStmts DotStatements n
stmts

withSubGraphID        :: (Maybe (Maybe GraphID) -> b -> a)
                         -> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID :: forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID Maybe (Maybe GraphID) -> b -> a
f DotStatements n -> b
g DotSubGraph n
sg = Maybe (Maybe GraphID) -> b -> a
f Maybe (Maybe GraphID)
mid forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> b
g forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
  where
    mid :: Maybe (Maybe GraphID)
mid = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg) forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> Bool
isCluster DotSubGraph n
sg

renumber    :: DotGraph n -> DotGraph n
renumber :: forall n. DotGraph n -> DotGraph n
renumber DotGraph n
dg = DotGraph n
dg { graphStatements :: DotStatements n
graphStatements = DotStatements n
newStmts }
  where
    startN :: Int
startN = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg

    newStmts :: DotStatements n
newStmts = forall s a. State s a -> s -> a
evalState (forall {m :: * -> *} {n}.
MonadState Int m =>
DotStatements n -> m (DotStatements n)
stRe forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg) Int
startN

    stRe :: DotStatements n -> m (DotStatements n)
stRe DotStatements n
st = do [DotSubGraph n]
sgs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DotSubGraph n -> m (DotSubGraph n)
sgRe forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
subGraphs DotStatements n
st
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DotStatements n
st { subGraphs :: [DotSubGraph n]
subGraphs = [DotSubGraph n]
sgs' }
    sgRe :: DotSubGraph n -> m (DotSubGraph n)
sgRe DotSubGraph n
sg = do Maybe GraphID
sgid' <- case forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg of
                            Maybe GraphID
Nothing -> do Int
n <- forall s (m :: * -> *). MonadState s m => m s
get
                                          forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Int
n
                                          forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> GraphID
Num forall a b. (a -> b) -> a -> b
$ Int -> Number
Int Int
n
                            Maybe GraphID
sgid    -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GraphID
sgid
                 DotStatements n
stmts' <- DotStatements n -> m (DotStatements n)
stRe forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DotSubGraph n
sg { subGraphID :: Maybe GraphID
subGraphID    = Maybe GraphID
sgid'
                             , subGraphStmts :: DotStatements n
subGraphStmts = DotStatements n
stmts'
                             }

maxSGInt    :: DotGraph n -> Int
maxSGInt :: forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg = forall s a. State s a -> s -> s
execState (forall {n}. DotStatements n -> StateT Int Identity ()
stInt forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe GraphID -> Int -> Int
`check` Int
0)
              forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Maybe GraphID
graphID DotGraph n
dg
  where
    check :: Maybe GraphID -> Int -> Int
check = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Ord a => a -> a -> a
max forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphID -> Maybe Int
numericValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

    stInt :: DotStatements n -> StateT Int Identity ()
stInt = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DotSubGraph n -> StateT Int Identity ()
sgInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotStatements n -> [DotSubGraph n]
subGraphs
    sgInt :: DotSubGraph n -> StateT Int Identity ()
sgInt DotSubGraph n
sg = do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Maybe GraphID -> Int -> Int
check forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg)
                  DotStatements n -> StateT Int Identity ()
stInt forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg

-- -----------------------------------------------------------------------------

-- | A convenience class to make it easier to convert data types to
--   'GraphID' values, e.g. for cluster identifiers.
--
--   In most cases, conversion would be via the 'Text' or 'String'
--   instances (e.g. using 'show').
class ToGraphID a where
  toGraphID :: a -> GraphID

-- | An alias for 'toGraphID' for use with the @OverloadedStrings@
--   extension.
textGraphID :: Text -> GraphID
textGraphID :: Text -> GraphID
textGraphID = forall a. ToGraphID a => a -> GraphID
toGraphID

instance ToGraphID Text where
  toGraphID :: Text -> GraphID
toGraphID = Text -> GraphID
Str

instance ToGraphID String where
  toGraphID :: String -> GraphID
toGraphID = forall a. ToGraphID a => a -> GraphID
toGraphID forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToGraphID Char where
  toGraphID :: Char -> GraphID
toGraphID = forall a. ToGraphID a => a -> GraphID
toGraphID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

instance ToGraphID Int where
  toGraphID :: Int -> GraphID
toGraphID = Number -> GraphID
Num forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Number
Int

-- | This instance loses precision by going via 'Int'.
instance ToGraphID Integer where
  toGraphID :: Integer -> GraphID
toGraphID = Number -> GraphID
Num forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Number
Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

instance ToGraphID Double where
  toGraphID :: Double -> GraphID
toGraphID = Number -> GraphID
Num forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Number
Dbl

-- -----------------------------------------------------------------------------

{- $limitations

   Printing of /Dot/ code is done as strictly as possible, whilst
   parsing is as permissive as possible.  For example, if the types
   allow it then @\"2\"@ will be parsed as an 'Int' value.  Note that
   quoting and escaping of textual values is done automagically.

   A summary of known limitations\/differences:

   * When creating 'GraphID' values for graphs and sub-graphs,
     you should ensure that none of them have the same printed value
     as one of the node identifiers values to avoid any possible problems.

   * If you want any 'GlobalAttributes' in a sub-graph and want
     them to only apply to that sub-graph, then you must ensure it
     does indeed have a valid 'GraphID'.

   * All sub-graphs which represent clusters should have unique
     identifiers (well, only if you want them to be generated
     sensibly).

   * If eventually outputting to a format such as SVG, then you should
     make sure to specify an identifier for the overall graph, as that is
     used as the title of the resulting image.

   * Whilst the graphs, etc. are polymorphic in their node type, you
     should ensure that you use a relatively simple node type (that
     is, it only covers a single line, etc.).

   * Also, whilst Graphviz allows you to mix the types used for nodes,
     this library requires\/assumes that they are all the same type (but
     you /can/ use a sum-type).

   * 'DotEdge' defines an edge @(a, b)@ (with an edge going from @a@
     to @b@); in /Dot/ parlance the edge has a head at @a@ and a tail
     at @b@.  Care must be taken when using the related @Head*@ and
     @Tail*@ 'Attribute's.  See the differences section in
     "Data.GraphViz.Attributes" for more information.

   * It is common to see multiple edges defined on the one line in Dot
     (e.g. @n1 -> n2 -> n3@ means to create a directed edge from @n1@
     to @n2@ and from @n2@ to @n3@).  These types of edge definitions
     are parseable; however, they are converted to singleton edges.

   * It is not yet possible to create or parse edges with
     subgraphs\/clusters as one of the end points.

   * The parser will strip out comments and pre-processor lines, join
     together multiline statements and concatenate split strings together.
     However, pre-processing within HTML-like labels is currently not
     supported.

   * Graphviz allows a node to be \"defined\" twice (e.g. the actual
     node definition, and then in a subgraph with extra global attributes
     applied to it).  This actually represents the same node, but when
     parsing they will be considered as separate 'DotNode's (such that
     'graphNodes' will return both \"definitions\").  @canonicalise@ from
     "Data.GraphViz.Algorithms" can be used to fix this.

   See "Data.GraphViz.Attributes.Complete" for more limitations.
 -}