{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}

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

   It is sometimes useful to be able to manipulate a Dot graph /as/ an
   actual graph.  This representation lets you do so, using an
   inductive approach based upon that from FGL (note that 'DotGraph'
   is /not/ an instance of the FGL classes due to having the wrong
   kind).  Note, however, that the API is not as complete as proper
   graph implementations.

   For purposes of manipulation, all edges are found in the root graph
   and not in a cluster; as such, having 'EdgeAttrs' in a cluster's
   'GlobalAttributes' is redundant.

   Printing is achieved via "Data.GraphViz.Types.Canonical" (using
   'toCanonical') and parsing via "Data.GraphViz.Types.Generalised"
   (so /any/ piece of Dot code can be parsed in).

   This representation doesn't allow non-cluster sub-graphs.  Also, all
   clusters /must/ have a unique identifier.  For those functions (with
   the exception of 'DotRepr' methods) that take or return a \"@Maybe
   GraphID@\", a value of \"@Nothing@\" refers to the root graph; \"@Just
   clust@\" refers to the cluster with the identifier \"@clust@\".

   You would not typically explicitly create these values, instead
   converting existing Dot graphs (via 'fromDotRepr').  However, one
   way of constructing the sample graph would be:

   > setID (Str "G")
   > . setStrictness False
   > . setIsDirected True
   > . setClusterAttributes (Int 0) [GraphAttrs [style filled, color LightGray, textLabel "process #1"], NodeAttrs [style filled, color White]]
   > . setClusterAttributes (Int 1) [GraphAttrs [textLabel "process #2", color Blue], NodeAttrs [style filled]]
   > $ composeList [ Cntxt "a0"    (Just $ Int 0)   []               [("a3",[]),("start",[])] [("a1",[])]
   >               , Cntxt "a1"    (Just $ Int 0)   []               []                       [("a2",[]),("b3",[])]
   >               , Cntxt "a2"    (Just $ Int 0)   []               []                       [("a3",[])]
   >               , Cntxt "a3"    (Just $ Int 0)   []               [("b2",[])]              [("end",[])]
   >               , Cntxt "b0"    (Just $ Int 1)   []               [("start",[])]           [("b1",[])]
   >               , Cntxt "b1"    (Just $ Int 1)   []               []                       [("b2",[])]
   >               , Cntxt "b2"    (Just $ Int 1)   []               []                       [("b3",[])]
   >               , Cntxt "b3"    (Just $ Int 1)   []               []                       [("end",[])]
   >               , Cntxt "end"   Nothing          [shape MSquare]  []                       []
   >               , Cntxt "start" Nothing          [shape MDiamond] []                       []]

 -}
module Data.GraphViz.Types.Graph
       ( DotGraph
       , GraphID(..)
       , Context(..)
         -- * Conversions
       , toCanonical
       , unsafeFromCanonical
       , fromDotRepr
         -- * Graph information
       , isEmpty
       , hasClusters
       , isEmptyGraph
       , graphAttributes
       , parentOf
       , clusterAttributes
       , foundInCluster
       , attributesOf
       , predecessorsOf
       , successorsOf
       , adjacentTo
       , adjacent
         -- * Graph construction
       , mkGraph
       , emptyGraph
       , (&)
       , composeList
       , addNode
       , DotNode(..)
       , addDotNode
       , addEdge
       , DotEdge(..)
       , addDotEdge
       , addCluster
       , setClusterParent
       , setClusterAttributes
         -- * Graph deconstruction
       , decompose
       , decomposeAny
       , decomposeList
       , deleteNode
       , deleteAllEdges
       , deleteEdge
       , deleteDotEdge
       , deleteCluster
       , removeEmptyClusters
       ) where

import           Data.GraphViz.Algorithms            (CanonicaliseOptions(..),
                                                      canonicaliseOptions)
import           Data.GraphViz.Algorithms.Clustering
import           Data.GraphViz.Attributes.Complete   (Attributes)
import           Data.GraphViz.Attributes.Same
import           Data.GraphViz.Internal.Util         (groupSortBy,
                                                      groupSortCollectBy)
import           Data.GraphViz.Types
import qualified Data.GraphViz.Types.Canonical       as C
import qualified Data.GraphViz.Types.Generalised     as G
import           Data.GraphViz.Types.Internal.Common (partitionGlobal)
import qualified Data.GraphViz.Types.State           as St

import           Control.Applicative             (liftA2, (<|>))
import           Control.Arrow                   ((***))
import qualified Data.Foldable                   as F
import           Data.List                       (delete, foldl', unfoldr)
import           Data.Map                        (Map)
import qualified Data.Map                        as M
import           Data.Maybe                      (fromMaybe, mapMaybe,
                                                  maybeToList)
import qualified Data.Sequence                   as Seq
import qualified Data.Set                        as S
import           Text.ParserCombinators.ReadPrec (prec)
import           Text.Read                       (Lexeme(Ident), lexP, parens,
                                                  readPrec)

#if !(MIN_VERSION_base (4,8,0))
import Control.Applicative ((<$>), (<*>))
#endif

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

-- | A Dot graph that allows graph operations on it.
data DotGraph n = DG { forall n. DotGraph n -> Bool
strictGraph   :: !Bool
                     , forall n. DotGraph n -> Bool
directedGraph :: !Bool
                     , forall n. DotGraph n -> GlobAttrs
graphAttrs    :: !GlobAttrs
                     , forall n. DotGraph n -> Maybe GraphID
graphID       :: !(Maybe GraphID)
                     , forall n. DotGraph n -> Map GraphID ClusterInfo
clusters      :: !(Map GraphID ClusterInfo)
                     , forall n. DotGraph n -> NodeMap n
values        :: !(NodeMap n)
                     }
                deriving (DotGraph n -> DotGraph n -> Bool
forall n. Eq n => DotGraph n -> DotGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotGraph n -> DotGraph n -> Bool
$c/= :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
== :: DotGraph n -> DotGraph n -> Bool
$c== :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
Eq, DotGraph n -> DotGraph n -> Bool
DotGraph n -> DotGraph n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (DotGraph n)
forall n. Ord n => DotGraph n -> DotGraph n -> Bool
forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
min :: DotGraph n -> DotGraph n -> DotGraph n
$cmin :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
max :: DotGraph n -> DotGraph n -> DotGraph n
$cmax :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
>= :: DotGraph n -> DotGraph n -> Bool
$c>= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
> :: DotGraph n -> DotGraph n -> Bool
$c> :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
<= :: DotGraph n -> DotGraph n -> Bool
$c<= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
< :: DotGraph n -> DotGraph n -> Bool
$c< :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
compare :: DotGraph n -> DotGraph n -> Ordering
$ccompare :: forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
Ord)

-- | It should be safe to substitute 'unsafeFromCanonical' for
--   'fromCanonical' in the output of this.
instance (Show n) => Show (DotGraph n) where
  showsPrec :: Int -> DotGraph n -> ShowS
showsPrec Int
d DotGraph n
dg = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
                   String -> ShowS
showString String
"fromCanonical " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall n. DotGraph n -> DotGraph n
toCanonical DotGraph n
dg)

-- | If the graph is the output from 'show', then it should be safe to
--   substitute 'unsafeFromCanonical' for 'fromCanonical'.
instance (Ord n, Read n) => Read (DotGraph n) where
  readPrec :: ReadPrec (DotGraph n)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
             forall a b. (a -> b) -> a -> b
$ do Ident String
"fromCanonical" <- ReadPrec Lexeme
lexP
                  DotGraph n
cdg <- forall a. Read a => ReadPrec a
readPrec
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (dg :: * -> *) n. DotRepr dg n => DotGraph n -> dg n
fromCanonical DotGraph n
cdg

data GlobAttrs = GA { GlobAttrs -> SAttrs
graphAs :: !SAttrs
                    , GlobAttrs -> SAttrs
nodeAs  :: !SAttrs
                    , GlobAttrs -> SAttrs
edgeAs  :: !SAttrs
                    }
               deriving (GlobAttrs -> GlobAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobAttrs -> GlobAttrs -> Bool
$c/= :: GlobAttrs -> GlobAttrs -> Bool
== :: GlobAttrs -> GlobAttrs -> Bool
$c== :: GlobAttrs -> GlobAttrs -> Bool
Eq, Eq GlobAttrs
GlobAttrs -> GlobAttrs -> Bool
GlobAttrs -> GlobAttrs -> Ordering
GlobAttrs -> GlobAttrs -> GlobAttrs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlobAttrs -> GlobAttrs -> GlobAttrs
$cmin :: GlobAttrs -> GlobAttrs -> GlobAttrs
max :: GlobAttrs -> GlobAttrs -> GlobAttrs
$cmax :: GlobAttrs -> GlobAttrs -> GlobAttrs
>= :: GlobAttrs -> GlobAttrs -> Bool
$c>= :: GlobAttrs -> GlobAttrs -> Bool
> :: GlobAttrs -> GlobAttrs -> Bool
$c> :: GlobAttrs -> GlobAttrs -> Bool
<= :: GlobAttrs -> GlobAttrs -> Bool
$c<= :: GlobAttrs -> GlobAttrs -> Bool
< :: GlobAttrs -> GlobAttrs -> Bool
$c< :: GlobAttrs -> GlobAttrs -> Bool
compare :: GlobAttrs -> GlobAttrs -> Ordering
$ccompare :: GlobAttrs -> GlobAttrs -> Ordering
Ord, Int -> GlobAttrs -> ShowS
[GlobAttrs] -> ShowS
GlobAttrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobAttrs] -> ShowS
$cshowList :: [GlobAttrs] -> ShowS
show :: GlobAttrs -> String
$cshow :: GlobAttrs -> String
showsPrec :: Int -> GlobAttrs -> ShowS
$cshowsPrec :: Int -> GlobAttrs -> ShowS
Show, ReadPrec [GlobAttrs]
ReadPrec GlobAttrs
Int -> ReadS GlobAttrs
ReadS [GlobAttrs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlobAttrs]
$creadListPrec :: ReadPrec [GlobAttrs]
readPrec :: ReadPrec GlobAttrs
$creadPrec :: ReadPrec GlobAttrs
readList :: ReadS [GlobAttrs]
$creadList :: ReadS [GlobAttrs]
readsPrec :: Int -> ReadS GlobAttrs
$creadsPrec :: Int -> ReadS GlobAttrs
Read)

data NodeInfo n = NI { forall n. NodeInfo n -> Maybe GraphID
_inCluster    :: !(Maybe GraphID)
                     , forall n. NodeInfo n -> Attributes
_attributes   :: !Attributes
                     , forall n. NodeInfo n -> EdgeMap n
_predecessors :: !(EdgeMap n)
                     , forall n. NodeInfo n -> EdgeMap n
_successors   :: !(EdgeMap n)
                     }
                deriving (NodeInfo n -> NodeInfo n -> Bool
forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfo n -> NodeInfo n -> Bool
$c/= :: forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
== :: NodeInfo n -> NodeInfo n -> Bool
$c== :: forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
Eq, NodeInfo n -> NodeInfo n -> Bool
NodeInfo n -> NodeInfo n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (NodeInfo n)
forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
forall n. Ord n => NodeInfo n -> NodeInfo n -> Ordering
forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
min :: NodeInfo n -> NodeInfo n -> NodeInfo n
$cmin :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
max :: NodeInfo n -> NodeInfo n -> NodeInfo n
$cmax :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
>= :: NodeInfo n -> NodeInfo n -> Bool
$c>= :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
> :: NodeInfo n -> NodeInfo n -> Bool
$c> :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
<= :: NodeInfo n -> NodeInfo n -> Bool
$c<= :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
< :: NodeInfo n -> NodeInfo n -> Bool
$c< :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
compare :: NodeInfo n -> NodeInfo n -> Ordering
$ccompare :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Ordering
Ord, Int -> NodeInfo n -> ShowS
forall n. Show n => Int -> NodeInfo n -> ShowS
forall n. Show n => [NodeInfo n] -> ShowS
forall n. Show n => NodeInfo n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo n] -> ShowS
$cshowList :: forall n. Show n => [NodeInfo n] -> ShowS
show :: NodeInfo n -> String
$cshow :: forall n. Show n => NodeInfo n -> String
showsPrec :: Int -> NodeInfo n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> NodeInfo n -> ShowS
Show, ReadPrec [NodeInfo n]
ReadPrec (NodeInfo n)
ReadS [NodeInfo n]
forall n. (Ord n, Read n) => ReadPrec [NodeInfo n]
forall n. (Ord n, Read n) => ReadPrec (NodeInfo n)
forall n. (Ord n, Read n) => Int -> ReadS (NodeInfo n)
forall n. (Ord n, Read n) => ReadS [NodeInfo n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeInfo n]
$creadListPrec :: forall n. (Ord n, Read n) => ReadPrec [NodeInfo n]
readPrec :: ReadPrec (NodeInfo n)
$creadPrec :: forall n. (Ord n, Read n) => ReadPrec (NodeInfo n)
readList :: ReadS [NodeInfo n]
$creadList :: forall n. (Ord n, Read n) => ReadS [NodeInfo n]
readsPrec :: Int -> ReadS (NodeInfo n)
$creadsPrec :: forall n. (Ord n, Read n) => Int -> ReadS (NodeInfo n)
Read)

data ClusterInfo = CI { ClusterInfo -> Maybe GraphID
parentCluster :: !(Maybe GraphID)
                      , ClusterInfo -> GlobAttrs
clusterAttrs  :: !GlobAttrs
                      }
                 deriving (ClusterInfo -> ClusterInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterInfo -> ClusterInfo -> Bool
$c/= :: ClusterInfo -> ClusterInfo -> Bool
== :: ClusterInfo -> ClusterInfo -> Bool
$c== :: ClusterInfo -> ClusterInfo -> Bool
Eq, Eq ClusterInfo
ClusterInfo -> ClusterInfo -> Bool
ClusterInfo -> ClusterInfo -> Ordering
ClusterInfo -> ClusterInfo -> ClusterInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClusterInfo -> ClusterInfo -> ClusterInfo
$cmin :: ClusterInfo -> ClusterInfo -> ClusterInfo
max :: ClusterInfo -> ClusterInfo -> ClusterInfo
$cmax :: ClusterInfo -> ClusterInfo -> ClusterInfo
>= :: ClusterInfo -> ClusterInfo -> Bool
$c>= :: ClusterInfo -> ClusterInfo -> Bool
> :: ClusterInfo -> ClusterInfo -> Bool
$c> :: ClusterInfo -> ClusterInfo -> Bool
<= :: ClusterInfo -> ClusterInfo -> Bool
$c<= :: ClusterInfo -> ClusterInfo -> Bool
< :: ClusterInfo -> ClusterInfo -> Bool
$c< :: ClusterInfo -> ClusterInfo -> Bool
compare :: ClusterInfo -> ClusterInfo -> Ordering
$ccompare :: ClusterInfo -> ClusterInfo -> Ordering
Ord, Int -> ClusterInfo -> ShowS
[ClusterInfo] -> ShowS
ClusterInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterInfo] -> ShowS
$cshowList :: [ClusterInfo] -> ShowS
show :: ClusterInfo -> String
$cshow :: ClusterInfo -> String
showsPrec :: Int -> ClusterInfo -> ShowS
$cshowsPrec :: Int -> ClusterInfo -> ShowS
Show, ReadPrec [ClusterInfo]
ReadPrec ClusterInfo
Int -> ReadS ClusterInfo
ReadS [ClusterInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterInfo]
$creadListPrec :: ReadPrec [ClusterInfo]
readPrec :: ReadPrec ClusterInfo
$creadPrec :: ReadPrec ClusterInfo
readList :: ReadS [ClusterInfo]
$creadList :: ReadS [ClusterInfo]
readsPrec :: Int -> ReadS ClusterInfo
$creadsPrec :: Int -> ReadS ClusterInfo
Read)

type NodeMap n = Map n (NodeInfo n)

type EdgeMap n = Map n [Attributes]

-- | The decomposition of a node from a dot graph.  Any loops should
--   be found in 'successors' rather than 'predecessors'.  Note also
--   that these are created\/consumed as if for /directed/ graphs.
data Context n = Cntxt { forall n. Context n -> n
node         :: !n
                         -- | The cluster this node can be found in;
                         --   @Nothing@ indicates the node can be
                         --   found in the root graph.
                       , forall n. Context n -> Maybe GraphID
inCluster    :: !(Maybe GraphID)
                       , forall n. Context n -> Attributes
attributes   :: !Attributes
                       , forall n. Context n -> [(n, Attributes)]
predecessors :: ![(n, Attributes)]
                       , forall n. Context n -> [(n, Attributes)]
successors   :: ![(n, Attributes)]
                       }
               deriving (Context n -> Context n -> Bool
forall n. Eq n => Context n -> Context n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context n -> Context n -> Bool
$c/= :: forall n. Eq n => Context n -> Context n -> Bool
== :: Context n -> Context n -> Bool
$c== :: forall n. Eq n => Context n -> Context n -> Bool
Eq, Context n -> Context n -> Bool
Context n -> Context n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (Context n)
forall n. Ord n => Context n -> Context n -> Bool
forall n. Ord n => Context n -> Context n -> Ordering
forall n. Ord n => Context n -> Context n -> Context n
min :: Context n -> Context n -> Context n
$cmin :: forall n. Ord n => Context n -> Context n -> Context n
max :: Context n -> Context n -> Context n
$cmax :: forall n. Ord n => Context n -> Context n -> Context n
>= :: Context n -> Context n -> Bool
$c>= :: forall n. Ord n => Context n -> Context n -> Bool
> :: Context n -> Context n -> Bool
$c> :: forall n. Ord n => Context n -> Context n -> Bool
<= :: Context n -> Context n -> Bool
$c<= :: forall n. Ord n => Context n -> Context n -> Bool
< :: Context n -> Context n -> Bool
$c< :: forall n. Ord n => Context n -> Context n -> Bool
compare :: Context n -> Context n -> Ordering
$ccompare :: forall n. Ord n => Context n -> Context n -> Ordering
Ord, Int -> Context n -> ShowS
forall n. Show n => Int -> Context n -> ShowS
forall n. Show n => [Context n] -> ShowS
forall n. Show n => Context n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context n] -> ShowS
$cshowList :: forall n. Show n => [Context n] -> ShowS
show :: Context n -> String
$cshow :: forall n. Show n => Context n -> String
showsPrec :: Int -> Context n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Context n -> ShowS
Show, ReadPrec [Context n]
ReadPrec (Context n)
ReadS [Context n]
forall n. Read n => ReadPrec [Context n]
forall n. Read n => ReadPrec (Context n)
forall n. Read n => Int -> ReadS (Context n)
forall n. Read n => ReadS [Context n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Context n]
$creadListPrec :: forall n. Read n => ReadPrec [Context n]
readPrec :: ReadPrec (Context n)
$creadPrec :: forall n. Read n => ReadPrec (Context n)
readList :: ReadS [Context n]
$creadList :: forall n. Read n => ReadS [Context n]
readsPrec :: Int -> ReadS (Context n)
$creadsPrec :: forall n. Read n => Int -> ReadS (Context n)
Read)

adjacent :: Context n -> [DotEdge n]
adjacent :: forall n. Context n -> [DotEdge n]
adjacent Context n
c = forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) (forall n. Context n -> [(n, Attributes)]
predecessors Context n
c)
             forall a. [a] -> [a] -> [a]
++ forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) (forall n. Context n -> [(n, Attributes)]
successors Context n
c)
  where
    n :: n
n = forall n. Context n -> n
node Context n
c
    mapU :: (a -> b -> b) -> [(a, b)] -> [b]
mapU = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

emptyGraph :: DotGraph n
emptyGraph :: forall n. DotGraph n
emptyGraph = DG { strictGraph :: Bool
strictGraph   = Bool
False
                , directedGraph :: Bool
directedGraph = Bool
True
                , graphID :: Maybe GraphID
graphID       = forall a. Maybe a
Nothing
                , graphAttrs :: GlobAttrs
graphAttrs    = GlobAttrs
emptyGA
                , clusters :: Map GraphID ClusterInfo
clusters      = forall k a. Map k a
M.empty
                , values :: NodeMap n
values        = forall k a. Map k a
M.empty
                }

emptyGA :: GlobAttrs
emptyGA :: GlobAttrs
emptyGA = SAttrs -> SAttrs -> SAttrs -> GlobAttrs
GA forall a. Set a
S.empty forall a. Set a
S.empty forall a. Set a
S.empty

-- -----------------------------------------------------------------------------
-- Construction

-- | Merge the 'Context' into the graph.  Assumes that the specified
--   node is not in the graph but that all endpoints in the
--   'successors' and 'predecessors' (with the exception of loops)
--   are.  If the cluster is not present in the graph, then it will be
--   added with no attributes with a parent of the root graph.
--
--   Note that @&@ and @'decompose'@ are /not/ quite inverses, as this
--   function will add in the cluster if it does not yet exist in the
--   graph, but 'decompose' will not delete it.
(&) :: (Ord n) => Context n -> DotGraph n -> DotGraph n
(Cntxt n
n Maybe GraphID
mc Attributes
as [(n, Attributes)]
ps [(n, Attributes)]
ss) & :: forall n. Ord n => Context n -> DotGraph n -> DotGraph n
& DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues Map n (NodeInfo n) -> Map n (NodeInfo n)
merge DotGraph n
dg'
  where
    ps' :: EdgeMap n
ps' = forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ps
    ps'' :: [(n, Attributes)]
ps'' = forall n. EdgeMap n -> [(n, Attributes)]
fromMap (forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ps')
    ss' :: EdgeMap n
ss' = forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ss
    ss'' :: [(n, Attributes)]
ss'' = forall n. EdgeMap n -> [(n, Attributes)]
fromMap (forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ss')

    dg' :: DotGraph n
dg' = forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n Maybe GraphID
mc Attributes
as DotGraph n
dg

    merge :: Map n (NodeInfo n) -> Map n (NodeInfo n)
merge = forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev n
n [(n, Attributes)]
ps'' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev n
n [(n, Attributes)]
ss''
            -- Add reverse edges
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\NodeInfo n
ni -> NodeInfo n
ni { _predecessors :: EdgeMap n
_predecessors = EdgeMap n
ps', _successors :: EdgeMap n
_successors = EdgeMap n
ss' }) n
n
            -- Add actual edges

infixr 5 &

-- | Recursively merge the list of contexts.
--
--   > composeList = foldr (&) emptyGraph
composeList :: (Ord n) => [Context n] -> DotGraph n
composeList :: forall n. Ord n => [Context n] -> DotGraph n
composeList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall n. Ord n => Context n -> DotGraph n -> DotGraph n
(&) forall n. DotGraph n
emptyGraph

addSuccRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev :: forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSkip forall n. UpdateEdgeMap n
niSucc

addPredRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev :: forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSkip forall n. UpdateEdgeMap n
niPred

addEdgeLinks :: (Ord n) => UpdateEdgeMap n -> UpdateEdgeMap n
                -> n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addEdgeLinks :: forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks UpdateEdgeMap n
fwd UpdateEdgeMap n
rev n
f [(n, Attributes)]
tas = NodeMap n -> NodeMap n
updRev forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeMap n -> NodeMap n
updFwd
  where
    updFwd :: NodeMap n -> NodeMap n
updFwd = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust NodeInfo n -> NodeInfo n
addFwd n
f

    addFwd :: NodeInfo n -> NodeInfo n
addFwd NodeInfo n
ni = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NodeInfo n
ni' (n
t,Attributes
as) -> UpdateEdgeMap n
fwd (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) n
t [Attributes
as]) NodeInfo n
ni') NodeInfo n
ni [(n, Attributes)]
tas

    updRev :: NodeMap n -> NodeMap n
updRev NodeMap n
nm = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NodeMap n
nm' (n
t,Attributes
as) -> forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Attributes -> NodeInfo n -> NodeInfo n
addRev Attributes
as) n
t NodeMap n
nm') NodeMap n
nm [(n, Attributes)]
tas

    addRev :: Attributes -> NodeInfo n -> NodeInfo n
addRev Attributes
as = UpdateEdgeMap n
rev (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) n
f [Attributes
as])

-- | Add a node to the current graph. Merges attributes and edges if
--   the node already exists in the graph.
--
--   If the specified cluster does not yet exist in the graph, then it
--   will be added (as a sub-graph of the overall graph and no
--   attributes).
addNode :: (Ord n)
           => n
           -> Maybe GraphID -- ^ The cluster the node can be found in
                            --   (@Nothing@ refers to the root graph).
           -> Attributes
           -> DotGraph n
           -> DotGraph n
addNode :: forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n Maybe GraphID
mc Attributes
as DotGraph n
dg = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mc forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { values :: NodeMap n
values = NodeMap n
ns' }
  where
    ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
    ns' :: NodeMap n
ns' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
mergeLogic n
n (forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as forall k a. Map k a
M.empty forall k a. Map k a
M.empty) NodeMap n
ns
    mergeLogic :: NodeInfo n -> NodeInfo n -> NodeInfo n
mergeLogic (NI Maybe GraphID
newClust Attributes
newAttrs EdgeMap n
newPreds EdgeMap n
newSuccs) (NI Maybe GraphID
oldClust Attributes
oldAttrs EdgeMap n
oldPreds EdgeMap n
oldSuccs) =
        forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
resClust Attributes
resAttrs EdgeMap n
resPreds EdgeMap n
resSuccs
      where
        resClust :: Maybe GraphID
resClust = Maybe GraphID
newClust forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe GraphID
oldClust
        resAttrs :: Attributes
resAttrs = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union (Attributes -> SAttrs
toSAttr Attributes
newAttrs) (Attributes -> SAttrs
toSAttr Attributes
oldAttrs)
        resPreds :: EdgeMap n
resPreds = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) EdgeMap n
newPreds EdgeMap n
oldPreds
        resSuccs :: EdgeMap n
resSuccs = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) EdgeMap n
newSuccs EdgeMap n
oldSuccs

-- | A variant of 'addNode' that takes in a DotNode (not in a
--   cluster).
addDotNode                :: (Ord n) => DotNode n -> DotGraph n -> DotGraph n
addDotNode :: forall n. Ord n => DotNode n -> DotGraph n -> DotGraph n
addDotNode (DotNode n
n Attributes
as) = forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n forall a. Maybe a
Nothing Attributes
as

-- | Add the specified edge to the graph; assumes both node values are
--   already present in the graph.  If the graph is undirected then
--   the order of nodes doesn't matter.
addEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge :: forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge n
f n
t Attributes
as = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
merge
  where
    merge :: NodeMap n -> NodeMap n
merge = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSucc forall n. UpdateEdgeMap n
niPred n
f [(n
t,Attributes
as)]

-- | A variant of 'addEdge' that takes a 'DotEdge' value.
addDotEdge                  :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge :: forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge (DotEdge n
f n
t Attributes
as) = forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge n
f n
t Attributes
as

-- | Add a new cluster to the graph; throws an error if the cluster
--   already exists.  Assumes that it doesn't match the identifier of
--   the overall graph.  If the parent cluster doesn't already exist
--   in the graph then it will be added.
addCluster :: GraphID          -- ^ The identifier for this cluster.
              -> Maybe GraphID -- ^ The parent of this cluster
                               --   (@Nothing@ refers to the root
                               --   graph)
              -> [GlobalAttributes]
              -> DotGraph n
              -> DotGraph n
addCluster :: forall n.
GraphID
-> Maybe GraphID -> [GlobalAttributes] -> DotGraph n -> DotGraph n
addCluster GraphID
c Maybe GraphID
mp [GlobalAttributes]
gas DotGraph n
dg
  | GraphID
c forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map GraphID ClusterInfo
cs = forall a. HasCallStack => String -> a
error String
"Cluster already exists in the graph"
  | Bool
otherwise       = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mp
                      forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert GraphID
c ClusterInfo
ci Map GraphID ClusterInfo
cs }
  where
    cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
    ci :: ClusterInfo
ci = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
mp forall a b. (a -> b) -> a -> b
$ [GlobalAttributes] -> GlobAttrs
toGlobAttrs [GlobalAttributes]
gas

-- Used to make sure that the parent cluster exists
addEmptyCluster :: Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster :: forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a}. GraphID -> a -> Map GraphID a -> Map GraphID a
`dontReplace` ClusterInfo
defCI))
  where
    dontReplace :: GraphID -> a -> Map GraphID a -> Map GraphID a
dontReplace = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (forall a b. a -> b -> a
const forall a. a -> a
id)
    defCI :: ClusterInfo
defCI = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI forall a. Maybe a
Nothing GlobAttrs
emptyGA

-- | Specify the parent of the cluster; adds both in if not already present.
setClusterParent     :: GraphID -> Maybe GraphID -> DotGraph n -> DotGraph n
setClusterParent :: forall n. GraphID -> Maybe GraphID -> DotGraph n -> DotGraph n
setClusterParent GraphID
c Maybe GraphID
p = forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setP GraphID
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. DotGraph n -> DotGraph n
addCs
  where
    addCs :: DotGraph n -> DotGraph n
addCs = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (forall a. a -> Maybe a
Just GraphID
c)
    setP :: ClusterInfo -> ClusterInfo
setP ClusterInfo
ci = ClusterInfo
ci { parentCluster :: Maybe GraphID
parentCluster = Maybe GraphID
p }

-- | Specify the attributes of the cluster; adds it if not already
--   present.
setClusterAttributes       :: GraphID -> [GlobalAttributes]
                              -> DotGraph n -> DotGraph n
setClusterAttributes :: forall n. GraphID -> [GlobalAttributes] -> DotGraph n -> DotGraph n
setClusterAttributes GraphID
c [GlobalAttributes]
gas = forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setAs GraphID
c)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (forall a. a -> Maybe a
Just GraphID
c)
  where
    setAs :: ClusterInfo -> ClusterInfo
setAs ClusterInfo
ci = ClusterInfo
ci { clusterAttrs :: GlobAttrs
clusterAttrs = [GlobalAttributes] -> GlobAttrs
toGlobAttrs [GlobalAttributes]
gas }

-- | Create a graph with no clusters.
mkGraph :: (Ord n) => [DotNode n] -> [DotEdge n] -> DotGraph n
mkGraph :: forall n. Ord n => [DotNode n] -> [DotEdge n] -> DotGraph n
mkGraph [DotNode n]
ns [DotEdge n]
es = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge) [DotEdge n]
es
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Ord n => DotNode n -> DotGraph n -> DotGraph n
addDotNode) forall n. DotGraph n
emptyGraph [DotNode n]
ns

-- | Convert this DotGraph into canonical form.  All edges are found
--   in the outer graph rather than in clusters.
toCanonical :: DotGraph n -> C.DotGraph n
toCanonical :: forall n. DotGraph n -> DotGraph n
toCanonical DotGraph n
dg = C.DotGraph { strictGraph :: Bool
C.strictGraph     = forall n. DotGraph n -> Bool
strictGraph DotGraph n
dg
                            , directedGraph :: Bool
C.directedGraph   = forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg
                            , graphID :: Maybe GraphID
C.graphID         = forall n. DotGraph n -> Maybe GraphID
graphID DotGraph n
dg
                            , graphStatements :: DotStatements n
C.graphStatements = DotStatements n
stmts
                            }
  where
    stmts :: DotStatements n
stmts = C.DotStmts { attrStmts :: [GlobalAttributes]
C.attrStmts = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg
                       , subGraphs :: [DotSubGraph n]
C.subGraphs = [DotSubGraph n]
cs
                       , nodeStmts :: [DotNode n]
C.nodeStmts = [DotNode n]
ns
                       , edgeStmts :: [DotEdge n]
C.edgeStmts = forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo Bool
False DotGraph n
dg
                       }

    cls :: Map GraphID ClusterInfo
cls = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
    pM :: Map GraphID (Seq GraphID)
pM = forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath' DotGraph n
dg

    clustAs :: GraphID -> [GlobalAttributes]
clustAs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClusterInfo -> GlobAttrs
clusterAttrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`Map GraphID ClusterInfo
cls)

    lns :: [(n, (Maybe GraphID, Attributes))]
lns = forall a b. (a -> b) -> [a] -> [b]
map (\ (n
n,NodeInfo n
ni) -> (n
n,(forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni, forall n. NodeInfo n -> Attributes
_attributes NodeInfo n
ni)))
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg

    ([DotSubGraph n]
cs,[DotNode n]
ns) = forall c n a l.
Ord c =>
((n, a) -> NodeCluster c (n, l))
-> (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> [(n, a)]
-> ([DotSubGraph n], [DotNode n])
clustersToNodes forall {a} {b}.
(a, (Maybe GraphID, b)) -> NodeCluster GraphID (a, b)
pathOf (forall a b. a -> b -> a
const Bool
True) forall a. a -> a
id GraphID -> [GlobalAttributes]
clustAs forall a b. (a, b) -> b
snd [(n, (Maybe GraphID, Attributes))]
lns

    pathOf :: (a, (Maybe GraphID, b)) -> NodeCluster GraphID (a, b)
pathOf (a
n,(Maybe GraphID
c,b
as)) = forall {a}. Maybe GraphID -> a -> NodeCluster GraphID a
pathFrom Maybe GraphID
c (a
n,b
as)
    pathFrom :: Maybe GraphID -> a -> NodeCluster GraphID a
pathFrom Maybe GraphID
c a
ln = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall c a. c -> NodeCluster c a -> NodeCluster c a
C (forall c a. a -> NodeCluster c a
N a
ln) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`Map GraphID (Seq GraphID)
pM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
c

-- -----------------------------------------------------------------------------
-- Deconstruction

-- | A partial inverse of @'&'@, in that if a node exists in a graph
--   then it will be decomposed, but will not remove the cluster that
--   it was in even if it was the only node in that cluster.
decompose :: (Ord n) => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose :: forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose n
n DotGraph n
dg
  | n
n forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` NodeMap n
ns = forall a. Maybe a
Nothing
  | Bool
otherwise          = forall a. a -> Maybe a
Just (Context n
c, DotGraph n
dg')
  where
    ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
    (Just (NI Maybe GraphID
mc Attributes
as EdgeMap n
ps EdgeMap n
ss), NodeMap n
ns') = forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a. Maybe a
Nothing) n
n NodeMap n
ns

    c :: Context n
c = forall n.
n
-> Maybe GraphID
-> Attributes
-> [(n, Attributes)]
-> [(n, Attributes)]
-> Context n
Cntxt n
n Maybe GraphID
mc Attributes
as (forall n. EdgeMap n -> [(n, Attributes)]
fromMap forall a b. (a -> b) -> a -> b
$ n
n forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` EdgeMap n
ps) (forall n. EdgeMap n -> [(n, Attributes)]
fromMap EdgeMap n
ss)
    dg' :: DotGraph n
dg' = DotGraph n
dg { values :: NodeMap n
values = forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc n
n EdgeMap n
ps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred n
n EdgeMap n
ss forall a b. (a -> b) -> a -> b
$ NodeMap n
ns' }

-- | As with 'decompose', but do not specify /which/ node to
--   decompose.
decomposeAny :: (Ord n) => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny :: forall n. Ord n => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny DotGraph n
dg
  | forall n. DotGraph n -> Bool
isEmpty DotGraph n
dg = forall a. Maybe a
Nothing
  | Bool
otherwise  = forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> (k, a)
M.findMin forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg) DotGraph n
dg

-- | Recursively decompose the Dot graph into a list of contexts such
--   that if @(c:cs) = decomposeList dg@, then @dg = c & 'composeList' cs@.
--
--   Note that all global attributes are lost, so this is /not/
--   suitable for representing a Dot graph on its own.
decomposeList :: (Ord n) => DotGraph n -> [Context n]
decomposeList :: forall n. Ord n => DotGraph n -> [Context n]
decomposeList = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall n. Ord n => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny

delSucc :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc :: forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc = forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS forall n. UpdateEdgeMap n
niSucc

delPred :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred :: forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred = forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS forall n. UpdateEdgeMap n
niPred

-- Only takes in EdgeMap rather than [n] to make it easier to call
-- from decompose
delPS :: (Ord n) => ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
         -> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS :: forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
fni n
t EdgeMap n
fm NodeMap n
nm = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {k}. Ord k => Map k (NodeInfo n) -> k -> Map k (NodeInfo n)
delE NodeMap n
nm forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys EdgeMap n
fm
  where
    delE :: Map k (NodeInfo n) -> k -> Map k (NodeInfo n)
delE Map k (NodeInfo n)
nm' k
f = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
fni forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
t) k
f Map k (NodeInfo n)
nm'

-- | Delete the specified node from the graph; returns the original
--   graph if that node isn't present.
deleteNode      :: (Ord n) => n -> DotGraph n -> DotGraph n
deleteNode :: forall n. Ord n => n -> DotGraph n -> DotGraph n
deleteNode n
n DotGraph n
dg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe DotGraph n
dg forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose n
n DotGraph n
dg

-- | Delete all edges between the two nodes; returns the original
--   graph if there are no edges.
deleteAllEdges          :: (Ord n) => n -> n -> DotGraph n -> DotGraph n
deleteAllEdges :: forall n. Ord n => n -> n -> DotGraph n -> DotGraph n
deleteAllEdges n
n1 n
n2 = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues (forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delAE n
n1 n
n2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delAE n
n2 n
n1)
  where
    delAE :: n -> n -> NodeMap n -> NodeMap n
delAE n
f n
t = forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc n
f forall {a}. Map n [a]
t' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred n
f forall {a}. Map n [a]
t'
      where
        t' :: Map n [a]
t' = forall k a. k -> a -> Map k a
M.singleton n
t []

-- | Deletes the specified edge from the DotGraph (note: for unordered
--   graphs both orientations are considered).
deleteEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge :: forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge n
n1 n
n2 Attributes
as DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues Map n (NodeInfo n) -> Map n (NodeInfo n)
delEs DotGraph n
dg
  where
    delE :: n -> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
delE n
f n
t = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall n. UpdateEdgeMap n
niSucc forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
t) n
f
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall n. UpdateEdgeMap n
niPred forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
f) n
t

    delEs :: Map n (NodeInfo n) -> Map n (NodeInfo n)
delEs | forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2
          | Bool
otherwise        = forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n2 n
n1

-- | As with 'deleteEdge' but takes a 'DotEdge' rather than individual
--   values.
deleteDotEdge :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n
deleteDotEdge :: forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
deleteDotEdge (DotEdge n
n1 n
n2 Attributes
as) = forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge n
n1 n
n2 Attributes
as

-- | Delete the specified cluster, and makes any clusters or nodes
--   within it be in its root cluster (or the overall graph if
--   required).
deleteCluster      :: GraphID -> DotGraph n -> DotGraph n
deleteCluster :: forall n. GraphID -> DotGraph n -> DotGraph n
deleteCluster GraphID
c DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues (forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {n}. NodeInfo n -> NodeInfo n
adjNode)
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> ClusterInfo
adjCluster forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete GraphID
c)
                     forall a b. (a -> b) -> a -> b
$ DotGraph n
dg
  where
    p :: Maybe GraphID
p = ClusterInfo -> Maybe GraphID
parentCluster forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GraphID
c forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg

    adjParent :: Maybe GraphID -> Maybe GraphID
adjParent Maybe GraphID
p'
      | Maybe GraphID
p' forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just GraphID
c = Maybe GraphID
p
      | Bool
otherwise    = Maybe GraphID
p'

    adjNode :: NodeInfo n -> NodeInfo n
adjNode NodeInfo n
ni = NodeInfo n
ni { _inCluster :: Maybe GraphID
_inCluster = Maybe GraphID -> Maybe GraphID
adjParent forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni }

    adjCluster :: ClusterInfo -> ClusterInfo
adjCluster ClusterInfo
ci = ClusterInfo
ci { parentCluster :: Maybe GraphID
parentCluster = Maybe GraphID -> Maybe GraphID
adjParent forall a b. (a -> b) -> a -> b
$ ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci }

-- | Remove clusters with no sub-clusters and no nodes within them.
removeEmptyClusters :: DotGraph n -> DotGraph n
removeEmptyClusters :: forall {n}. DotGraph n -> DotGraph n
removeEmptyClusters DotGraph n
dg = DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = Map GraphID ClusterInfo
cM' }
  where
    cM :: Map GraphID ClusterInfo
cM = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
    cM' :: Map GraphID ClusterInfo
cM' = (Map GraphID ClusterInfo
cM forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map GraphID [GraphID]
invCs) forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map GraphID [n]
invNs

    invCs :: Map GraphID [GraphID]
invCs = forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> Maybe GraphID
parentCluster Map GraphID ClusterInfo
cM
    invNs :: Map GraphID [n]
invNs = forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall n. NodeInfo n -> Maybe GraphID
_inCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg

    usedClustsIn :: Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy forall a b. (a, b) -> a
fst
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)))
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs

-- -----------------------------------------------------------------------------
-- Information

-- | Does this graph have any nodes?
isEmpty :: DotGraph n -> Bool
isEmpty :: forall n. DotGraph n -> Bool
isEmpty = forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> NodeMap n
values

-- | Does this graph have any clusters?
hasClusters :: DotGraph n -> Bool
hasClusters :: forall n. DotGraph n -> Bool
hasClusters = forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Map GraphID ClusterInfo
clusters

-- | Determine if this graph has nodes or clusters.
isEmptyGraph :: DotGraph n -> Bool
isEmptyGraph :: forall n. DotGraph n -> Bool
isEmptyGraph = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) forall n. DotGraph n -> Bool
isEmpty (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Bool
hasClusters)

graphAttributes :: DotGraph n -> [GlobalAttributes]
graphAttributes :: forall n. DotGraph n -> [GlobalAttributes]
graphAttributes = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> GlobAttrs
graphAttrs

-- | Return the ID for the cluster the node is in.
foundInCluster :: (Ord n) => DotGraph n -> n -> Maybe GraphID
foundInCluster :: forall n. Ord n => DotGraph n -> n -> Maybe GraphID
foundInCluster DotGraph n
dg n
n = forall n. NodeInfo n -> Maybe GraphID
_inCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n

-- | Return the attributes for the node.
attributesOf :: (Ord n) => DotGraph n -> n -> Attributes
attributesOf :: forall n. Ord n => DotGraph n -> n -> Attributes
attributesOf DotGraph n
dg n
n = forall n. NodeInfo n -> Attributes
_attributes forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n

-- | Predecessor edges for the specified node.  For undirected graphs
--   equivalent to 'adjacentTo'.
predecessorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]
predecessorsOf :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
predecessorsOf DotGraph n
dg n
t
  | forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
t)
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_predecessors forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
t
  | Bool
otherwise        = forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
t

-- | Successor edges for the specified node.  For undirected graphs
--   equivalent to 'adjacentTo'.
successorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]
successorsOf :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
successorsOf DotGraph n
dg n
f
  | forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f)
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_successors forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
f
  | Bool
otherwise        = forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
f

-- | All edges involving this node.
adjacentTo :: (Ord n) => DotGraph n -> n -> [DotEdge n]
adjacentTo :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
n = [DotEdge n]
sucs forall a. [a] -> [a] -> [a]
++ [DotEdge n]
preds
  where
    ni :: NodeInfo n
ni = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n
    sucs :: [DotEdge n]
sucs = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_successors NodeInfo n
ni
    preds :: [DotEdge n]
preds = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) forall a b. (a -> b) -> a -> b
$ n
n forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` forall n. NodeInfo n -> EdgeMap n
_predecessors NodeInfo n
ni

emToDE :: (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE :: forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE n -> Attributes -> DotEdge n
f = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry n -> Attributes -> DotEdge n
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. EdgeMap n -> [(n, Attributes)]
fromMap

-- | Which cluster (or the root graph) is this cluster in?
parentOf :: DotGraph n -> GraphID -> Maybe GraphID
parentOf :: forall n. DotGraph n -> GraphID -> Maybe GraphID
parentOf DotGraph n
dg GraphID
c = ClusterInfo -> Maybe GraphID
parentCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! GraphID
c

clusterAttributes :: DotGraph n -> GraphID -> [GlobalAttributes]
clusterAttributes :: forall n. DotGraph n -> GraphID -> [GlobalAttributes]
clusterAttributes DotGraph n
dg GraphID
c = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClusterInfo -> GlobAttrs
clusterAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! GraphID
c

-- -----------------------------------------------------------------------------
-- For DotRepr instance

instance (Ord n) => DotRepr DotGraph n where
  fromCanonical :: DotGraph n -> DotGraph n
fromCanonical = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr

  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 n' n. Ord n' => (n -> n') -> DotGraph n -> DotGraph n'
mapNs

  graphStructureInformation :: DotGraph n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation = forall n. DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo

  nodeInformation :: Bool -> DotGraph n -> NodeLookup n
nodeInformation = forall n. Bool -> DotGraph n -> NodeLookup n
getNodeInfo

  edgeInformation :: Bool -> DotGraph n -> [DotEdge n]
edgeInformation = forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo

  unAnonymise :: DotGraph n -> DotGraph n
unAnonymise = forall a. a -> a
id -- No anonymous clusters!

instance (Ord n) => G.FromGeneralisedDot DotGraph n where
  fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr

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

-- | Uses the PrintDot instance for canonical 'C.DotGraph's.
instance (PrintDot n) => PrintDot (DotGraph n) where
  unqtDot :: DotGraph n -> DotCode
unqtDot = forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotGraph n
toCanonical

-- | Uses the ParseDot instance for generalised 'G.DotGraph's.
instance (Ord n, ParseDot n) => ParseDot (DotGraph n) where
  parseUnqt :: Parse (DotGraph n)
parseUnqt = DotGraph n -> DotGraph n
fromGDot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
    where
      -- fromGDot :: G.DotGraph n -> DotGraph n
      fromGDot :: DotGraph n -> DotGraph n
fromGDot = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a -> a
`asTypeOf` (forall a. HasCallStack => a
undefined :: G.DotGraph n))

  parse :: Parse (DotGraph n)
parse = forall a. ParseDot a => Parse a
parseUnqt -- Don't want the option of quoting

cOptions :: CanonicaliseOptions
cOptions :: CanonicaliseOptions
cOptions = COpts { edgesInClusters :: Bool
edgesInClusters = Bool
False
                 , groupAttributes :: Bool
groupAttributes = Bool
True
                 }

-- | Convert any existing DotRepr instance to a 'DotGraph'.
fromDotRepr :: (DotRepr dg n) => dg n -> DotGraph n
fromDotRepr :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr = forall n. Ord n => DotGraph n -> DotGraph n
unsafeFromCanonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
CanonicaliseOptions -> dg n -> DotGraph n
canonicaliseOptions CanonicaliseOptions
cOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n. DotRepr dg n => dg n -> dg n
unAnonymise

-- | Convert a canonical Dot graph to a graph-based one.  This assumes
--   that the canonical graph is the same format as returned by
--   'toCanonical'.  The \"unsafeness\" is that:
--
--   * All clusters must have a unique identifier ('unAnonymise' can
--     be used to make sure all clusters /have/ an identifier, but it
--     doesn't ensure uniqueness).
--
--   * All nodes are assumed to be explicitly listed precisely once.
--
--   * Only edges found in the root graph are considered.
--
--   If this isn't the case, use 'fromCanonical' instead.
--
--   The 'graphToDot' function from "Data.GraphViz" produces output
--   suitable for this function (assuming all clusters are provided
--   with a unique identifier); 'graphElemsToDot' is suitable if all
--   nodes are specified in the input list (rather than just the
--   edges).
unsafeFromCanonical :: (Ord n) => C.DotGraph n -> DotGraph n
unsafeFromCanonical :: forall n. Ord n => DotGraph n -> DotGraph n
unsafeFromCanonical DotGraph n
dg = DG { strictGraph :: Bool
strictGraph   = forall n. DotGraph n -> Bool
C.strictGraph DotGraph n
dg
                            , directedGraph :: Bool
directedGraph = Bool
dirGraph
                            , graphAttrs :: GlobAttrs
graphAttrs    = GlobAttrs
as
                            , graphID :: Maybe GraphID
graphID       = Maybe GraphID
mgid
                            , clusters :: Map GraphID ClusterInfo
clusters      = Map GraphID ClusterInfo
cs
                            , values :: NodeMap n
values        = NodeMap n
ns
                            }
  where
    stmts :: DotStatements n
stmts = forall n. DotGraph n -> DotStatements n
C.graphStatements DotGraph n
dg
    mgid :: Maybe GraphID
mgid = forall n. DotGraph n -> Maybe GraphID
C.graphID DotGraph n
dg
    dirGraph :: Bool
dirGraph = forall n. DotGraph n -> Bool
C.directedGraph DotGraph n
dg

    (GlobAttrs
as, Map GraphID ClusterInfo
cs, NodeMap n
ns) = Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt forall a. Maybe a
Nothing DotStatements n
stmts

    fCStmt :: Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt Maybe GraphID
p DotStatements n
stmts' = (GlobAttrs
sgAs, Map GraphID ClusterInfo
cs', NodeMap n
ns')
      where
        sgAs :: GlobAttrs
sgAs = [GlobalAttributes] -> GlobAttrs
toGlobAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
C.attrStmts DotStatements n
stmts'
        (Map GraphID ClusterInfo
cs', NodeMap n
sgNs) = (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID
-> DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n)
fCSG Maybe GraphID
p) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
C.subGraphs DotStatements n
stmts'
        nNs :: NodeMap n
nNs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID -> DotNode n -> (n, NodeInfo n)
fDN Maybe GraphID
p) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotNode n]
C.nodeStmts DotStatements n
stmts'
        ns' :: NodeMap n
ns' = NodeMap n
sgNs forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` NodeMap n
nNs

    fCSG :: Maybe GraphID
-> DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n)
fCSG Maybe GraphID
p DotSubGraph n
sg = (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert GraphID
sgid ClusterInfo
ci Map GraphID ClusterInfo
cs', NodeMap n
ns')
      where
        msgid :: Maybe GraphID
msgid@(Just GraphID
sgid) = forall n. DotSubGraph n -> Maybe GraphID
C.subGraphID DotSubGraph n
sg
        (GlobAttrs
as', Map GraphID ClusterInfo
cs', NodeMap n
ns') = Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt Maybe GraphID
msgid forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
C.subGraphStmts DotSubGraph n
sg
        ci :: ClusterInfo
ci = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
p GlobAttrs
as'

    fDN :: Maybe GraphID -> DotNode n -> (n, NodeInfo n)
fDN Maybe GraphID
p (DotNode n
n Attributes
as') = ( n
n
                            , NI { _inCluster :: Maybe GraphID
_inCluster    = Maybe GraphID
p
                                 , _attributes :: Attributes
_attributes   = Attributes
as'
                                 , _predecessors :: EdgeMap n
_predecessors = forall {k} {k} {a}. Ord k => k -> Map k (Map k a) -> Map k a
eSel n
n Map n (EdgeMap n)
tEs
                                 , _successors :: EdgeMap n
_successors   = forall {k} {k} {a}. Ord k => k -> Map k (Map k a) -> Map k a
eSel n
n Map n (EdgeMap n)
fEs
                                 }
                            )

    es :: [DotEdge n]
es = forall n. DotStatements n -> [DotEdge n]
C.edgeStmts DotStatements n
stmts
    fEs :: Map n (EdgeMap n)
fEs = forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap forall n. DotEdge n -> n
fromNode forall n. DotEdge n -> n
toNode [DotEdge n]
es
    tEs :: Map n (EdgeMap n)
tEs = forall {a}. Map n (Map n a) -> Map n (Map n a)
delLoops forall a b. (a -> b) -> a -> b
$ forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap forall n. DotEdge n -> n
toNode forall n. DotEdge n -> n
fromNode [DotEdge n]
es
    eSel :: k -> Map k (Map k a) -> Map k a
eSel k
n Map k (Map k a)
es' = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ k
n forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map k (Map k a)
es'
    delLoops :: Map n (Map n a) -> Map n (Map n a)
delLoops = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey forall k a. Ord k => k -> Map k a -> Map k a
M.delete

toEdgeMap     :: (Ord n) => (DotEdge n -> n) -> (DotEdge n -> n) -> [DotEdge n]
                 -> Map n (EdgeMap n)
toEdgeMap :: forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap DotEdge n -> n
f DotEdge n -> n
t = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {c}. [(n, c)] -> Map n [c]
eM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy DotEdge n -> n
f DotEdge n -> (n, Attributes)
t'
  where
    t' :: DotEdge n -> (n, Attributes)
t' = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) DotEdge n -> n
t forall n. DotEdge n -> Attributes
edgeAttributes
    eM :: [(n, c)] -> Map n [c]
eM = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd

mapNs :: (Ord n') => (n -> n') -> DotGraph n -> DotGraph n'
mapNs :: forall n' n. Ord n' => (n -> n') -> DotGraph n -> DotGraph n'
mapNs n -> n'
f (DG Bool
st Bool
d GlobAttrs
as Maybe GraphID
mid Map GraphID ClusterInfo
cs NodeMap n
vs) = forall n.
Bool
-> Bool
-> GlobAttrs
-> Maybe GraphID
-> Map GraphID ClusterInfo
-> NodeMap n
-> DotGraph n
DG Bool
st Bool
d GlobAttrs
as Maybe GraphID
mid Map GraphID ClusterInfo
cs
                                 forall a b. (a -> b) -> a -> b
$ NodeMap n -> Map n' (NodeInfo n')
mapNM NodeMap n
vs
  where
    mapNM :: NodeMap n -> Map n' (NodeInfo n')
mapNM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> NodeInfo n'
mapNI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Map n a -> Map n' a
mpM
    mapNI :: NodeInfo n -> NodeInfo n'
mapNI (NI Maybe GraphID
mc Attributes
as' EdgeMap n
ps EdgeMap n
ss) = forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as' (forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ps) (forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ss)
    mpM :: Map n a -> Map n' a
mpM = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys n -> n'
f

getGraphInfo    :: DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo :: forall n. DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo DotGraph n
dg = (GlobalAttributes
gas, ClusterLookup
cl)
  where
    toGA :: SAttrs -> GlobalAttributes
toGA = Attributes -> GlobalAttributes
GraphAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
    (GlobalAttributes
gas, Map GraphID GlobalAttributes
cgs) = (SAttrs -> GlobalAttributes
toGA forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b k. (a -> b) -> Map k a -> Map k b
M.map SAttrs -> GlobalAttributes
toGA) forall a b. (a -> b) -> a -> b
$ forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
graphAs DotGraph n
dg
    pM :: Map (Maybe GraphID) (Seq (Maybe GraphID))
pM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a}. Seq a -> Seq a
pInit forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg

    cl :: ClusterLookup
cl = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey forall {b}. Maybe GraphID -> b -> ([Seq (Maybe GraphID)], b)
addPath forall a b. (a -> b) -> a -> b
$ forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic forall a. a -> Maybe a
Just Map GraphID GlobalAttributes
cgs

    addPath :: Maybe GraphID -> b -> ([Seq (Maybe GraphID)], b)
addPath Maybe GraphID
c b
as = ( forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Maybe GraphID
c forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe GraphID) (Seq (Maybe GraphID))
pM
                   , b
as
                   )

    pInit :: Seq a -> Seq a
pInit Seq a
p = case forall a. Seq a -> ViewR a
Seq.viewr Seq a
p of
                (Seq a
p' Seq.:> a
_) -> Seq a
p'
                ViewR a
_             -> forall a. Seq a
Seq.empty

getNodeInfo             :: Bool -> DotGraph n -> NodeLookup n
getNodeInfo :: forall n. Bool -> DotGraph n -> NodeLookup n
getNodeInfo Bool
withGlob DotGraph n
dg = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {n}. NodeInfo n -> (Seq (Maybe GraphID), Attributes)
toLookup NodeMap n
ns
  where
    (SAttrs
gGlob, Map GraphID SAttrs
aM) = forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
nodeAs DotGraph n
dg
    pM :: Map (Maybe GraphID) (Seq (Maybe GraphID))
pM = forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg

    ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg

    toLookup :: NodeInfo n -> (Seq (Maybe GraphID), Attributes)
toLookup NodeInfo n
ni = (Seq (Maybe GraphID)
pth, Attributes
as')
      where
        as :: Attributes
as = forall n. NodeInfo n -> Attributes
_attributes NodeInfo n
ni
        mp :: Maybe GraphID
mp = forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni
        pth :: Seq (Maybe GraphID)
pth = forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ Maybe GraphID
mp forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe GraphID) (Seq (Maybe GraphID))
pM
        pAs :: SAttrs
pAs = forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
mp
        as' :: Attributes
as' | Bool
withGlob  = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
pAs
            | Bool
otherwise = Attributes
as

getEdgeInfo             :: Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo :: forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo Bool
withGlob DotGraph n
dg = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {n}. n -> (n, [Attributes]) -> [DotEdge n]
mkDotEdges) [(n, (n, [Attributes]))]
es
  where
    gGlob :: SAttrs
gGlob = GlobAttrs -> SAttrs
edgeAs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg

    es :: [(n, (n, [Attributes]))]
es = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)))
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall k a. Map k a -> [(k, a)]
M.assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_successors)
         forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg

    addGlob :: Attributes -> Attributes
addGlob Attributes
as
      | Bool
withGlob  = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
gGlob
      | Bool
otherwise = Attributes
as

    mkDotEdges :: n -> (n, [Attributes]) -> [DotEdge n]
mkDotEdges n
f (n
t, [Attributes]
ass) = forall a b. (a -> b) -> [a] -> [b]
map (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f n
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
addGlob) [Attributes]
ass

globAttrMap       :: (GlobAttrs -> SAttrs) -> DotGraph n
                     -> (SAttrs, Map GraphID SAttrs)
globAttrMap :: forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
af DotGraph n
dg = (SAttrs
gGlob, Map GraphID SAttrs
aM)
  where
    gGlob :: SAttrs
gGlob = GlobAttrs -> SAttrs
af forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg

    cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg

    aM :: Map GraphID SAttrs
aM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> SAttrs
attrsFor Map GraphID ClusterInfo
cs

    attrsFor :: ClusterInfo -> SAttrs
attrsFor ClusterInfo
ci = SAttrs
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
pAs
      where
        as :: SAttrs
as = GlobAttrs -> SAttrs
af forall a b. (a -> b) -> a -> b
$ ClusterInfo -> GlobAttrs
clusterAttrs ClusterInfo
ci
        p :: Maybe GraphID
p = ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci
        pAs :: SAttrs
pAs = forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
p

clusterPath :: DotGraph n -> Map (Maybe GraphID) St.Path
clusterPath :: forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath'

clusterPath' :: DotGraph n -> Map GraphID (Seq.Seq GraphID)
clusterPath' :: forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath' DotGraph n
dg = Map GraphID (Seq GraphID)
pM
  where
    cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg

    pM :: Map GraphID (Seq GraphID)
pM = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey GraphID -> ClusterInfo -> Seq GraphID
pathOf Map GraphID ClusterInfo
cs

    pathOf :: GraphID -> ClusterInfo -> Seq GraphID
pathOf GraphID
c ClusterInfo
ci = Seq GraphID
pPth forall a. Seq a -> a -> Seq a
Seq.|> GraphID
c
      where
        mp :: Maybe GraphID
mp = ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci
        pPth :: Seq GraphID
pPth = forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID (Seq GraphID)
pM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
mp

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

withValues      :: (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues :: forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
f DotGraph n
dg = DotGraph n
dg { values :: NodeMap n
values = NodeMap n -> NodeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg }

withClusters      :: (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
                     -> DotGraph n -> DotGraph n
withClusters :: forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters Map GraphID ClusterInfo -> Map GraphID ClusterInfo
f DotGraph n
dg = DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = Map GraphID ClusterInfo -> Map GraphID ClusterInfo
f forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg }

toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs = (Attributes, Attributes, Attributes) -> GlobAttrs
mkGA forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalAttributes] -> (Attributes, Attributes, Attributes)
partitionGlobal
  where
    mkGA :: (Attributes, Attributes, Attributes) -> GlobAttrs
mkGA (Attributes
ga,Attributes
na,Attributes
ea) = SAttrs -> SAttrs -> SAttrs -> GlobAttrs
GA (Attributes -> SAttrs
toSAttr Attributes
ga) (Attributes -> SAttrs
toSAttr Attributes
na) (Attributes -> SAttrs
toSAttr Attributes
ea)

fromGlobAttrs :: GlobAttrs -> [GlobalAttributes]
fromGlobAttrs :: GlobAttrs -> [GlobalAttributes]
fromGlobAttrs (GA SAttrs
ga SAttrs
na SAttrs
ea) = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAttributes -> Attributes
attrs)
                              [ Attributes -> GlobalAttributes
GraphAttrs forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
ga
                              , Attributes -> GlobalAttributes
NodeAttrs  forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
na
                              , Attributes -> GlobalAttributes
EdgeAttrs  forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
ea
                              ]

type UpdateEdgeMap n = (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n

niSucc      :: UpdateEdgeMap n
niSucc :: forall n. UpdateEdgeMap n
niSucc EdgeMap n -> EdgeMap n
f NodeInfo n
ni = NodeInfo n
ni { _successors :: EdgeMap n
_successors = EdgeMap n -> EdgeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_successors NodeInfo n
ni }

niPred      :: UpdateEdgeMap n
niPred :: forall n. UpdateEdgeMap n
niPred EdgeMap n -> EdgeMap n
f NodeInfo n
ni = NodeInfo n
ni { _predecessors :: EdgeMap n
_predecessors = EdgeMap n -> EdgeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_predecessors NodeInfo n
ni }

niSkip      :: UpdateEdgeMap n
niSkip :: forall n. UpdateEdgeMap n
niSkip EdgeMap n -> EdgeMap n
_ NodeInfo n
ni = NodeInfo n
ni

toMap :: (Ord n) => [(n, Attributes)] -> EdgeMap n
toMap :: forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd

fromMap :: EdgeMap n -> [(n, Attributes)]
fromMap :: forall n. EdgeMap n -> [(n, Attributes)]
fromMap = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList