{-# 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
(DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool) -> Eq (DotGraph n)
forall n. Eq n => DotGraph n -> DotGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: DotGraph n -> DotGraph n -> Bool
Eq, Eq (DotGraph n)
Eq (DotGraph n) =>
(DotGraph n -> DotGraph n -> Ordering)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n -> DotGraph n)
-> Ord (DotGraph n)
DotGraph n -> DotGraph n -> Bool
DotGraph n -> DotGraph n -> Ordering
DotGraph n -> DotGraph n -> DotGraph n
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
$ccompare :: forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
compare :: DotGraph n -> DotGraph n -> Ordering
$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
>= :: DotGraph n -> DotGraph n -> Bool
$cmax :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
max :: DotGraph n -> DotGraph n -> DotGraph n
$cmin :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
min :: DotGraph n -> DotGraph n -> DotGraph n
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                   String -> ShowS
showString String
"fromCanonical " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> ShowS
forall a. Show a => a -> ShowS
shows (DotGraph n -> DotGraph n
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 = ReadPrec (DotGraph n) -> ReadPrec (DotGraph n)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (DotGraph n) -> ReadPrec (DotGraph n))
-> (ReadPrec (DotGraph n) -> ReadPrec (DotGraph n))
-> ReadPrec (DotGraph n)
-> ReadPrec (DotGraph n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec (DotGraph n) -> ReadPrec (DotGraph n)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
             (ReadPrec (DotGraph n) -> ReadPrec (DotGraph n))
-> ReadPrec (DotGraph n) -> ReadPrec (DotGraph n)
forall a b. (a -> b) -> a -> b
$ do Ident String
"fromCanonical" <- ReadPrec Lexeme
lexP
                  DotGraph n
cdg <- ReadPrec (DotGraph n)
forall a. Read a => ReadPrec a
readPrec
                  DotGraph n -> ReadPrec (DotGraph n)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (DotGraph n -> ReadPrec (DotGraph n))
-> DotGraph n -> ReadPrec (DotGraph n)
forall a b. (a -> b) -> a -> b
$ DotGraph n -> DotGraph n
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
(GlobAttrs -> GlobAttrs -> Bool)
-> (GlobAttrs -> GlobAttrs -> Bool) -> Eq GlobAttrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobAttrs -> GlobAttrs -> Bool
== :: GlobAttrs -> GlobAttrs -> Bool
$c/= :: GlobAttrs -> GlobAttrs -> Bool
/= :: GlobAttrs -> GlobAttrs -> Bool
Eq, Eq GlobAttrs
Eq GlobAttrs =>
(GlobAttrs -> GlobAttrs -> Ordering)
-> (GlobAttrs -> GlobAttrs -> Bool)
-> (GlobAttrs -> GlobAttrs -> Bool)
-> (GlobAttrs -> GlobAttrs -> Bool)
-> (GlobAttrs -> GlobAttrs -> Bool)
-> (GlobAttrs -> GlobAttrs -> GlobAttrs)
-> (GlobAttrs -> GlobAttrs -> GlobAttrs)
-> Ord 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
$ccompare :: GlobAttrs -> GlobAttrs -> Ordering
compare :: GlobAttrs -> GlobAttrs -> Ordering
$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
>= :: GlobAttrs -> GlobAttrs -> Bool
$cmax :: GlobAttrs -> GlobAttrs -> GlobAttrs
max :: GlobAttrs -> GlobAttrs -> GlobAttrs
$cmin :: GlobAttrs -> GlobAttrs -> GlobAttrs
min :: GlobAttrs -> GlobAttrs -> GlobAttrs
Ord, Int -> GlobAttrs -> ShowS
[GlobAttrs] -> ShowS
GlobAttrs -> String
(Int -> GlobAttrs -> ShowS)
-> (GlobAttrs -> String)
-> ([GlobAttrs] -> ShowS)
-> Show GlobAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobAttrs -> ShowS
showsPrec :: Int -> GlobAttrs -> ShowS
$cshow :: GlobAttrs -> String
show :: GlobAttrs -> String
$cshowList :: [GlobAttrs] -> ShowS
showList :: [GlobAttrs] -> ShowS
Show, ReadPrec [GlobAttrs]
ReadPrec GlobAttrs
Int -> ReadS GlobAttrs
ReadS [GlobAttrs]
(Int -> ReadS GlobAttrs)
-> ReadS [GlobAttrs]
-> ReadPrec GlobAttrs
-> ReadPrec [GlobAttrs]
-> Read GlobAttrs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GlobAttrs
readsPrec :: Int -> ReadS GlobAttrs
$creadList :: ReadS [GlobAttrs]
readList :: ReadS [GlobAttrs]
$creadPrec :: ReadPrec GlobAttrs
readPrec :: ReadPrec GlobAttrs
$creadListPrec :: ReadPrec [GlobAttrs]
readListPrec :: ReadPrec [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
(NodeInfo n -> NodeInfo n -> Bool)
-> (NodeInfo n -> NodeInfo n -> Bool) -> Eq (NodeInfo n)
forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: NodeInfo n -> NodeInfo n -> Bool
Eq, Eq (NodeInfo n)
Eq (NodeInfo n) =>
(NodeInfo n -> NodeInfo n -> Ordering)
-> (NodeInfo n -> NodeInfo n -> Bool)
-> (NodeInfo n -> NodeInfo n -> Bool)
-> (NodeInfo n -> NodeInfo n -> Bool)
-> (NodeInfo n -> NodeInfo n -> Bool)
-> (NodeInfo n -> NodeInfo n -> NodeInfo n)
-> (NodeInfo n -> NodeInfo n -> NodeInfo n)
-> Ord (NodeInfo n)
NodeInfo n -> NodeInfo n -> Bool
NodeInfo n -> NodeInfo n -> Ordering
NodeInfo n -> NodeInfo n -> NodeInfo n
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
$ccompare :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Ordering
compare :: NodeInfo n -> NodeInfo n -> Ordering
$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
>= :: NodeInfo n -> NodeInfo n -> Bool
$cmax :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
max :: NodeInfo n -> NodeInfo n -> NodeInfo n
$cmin :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
min :: NodeInfo n -> NodeInfo n -> NodeInfo n
Ord, Int -> NodeInfo n -> ShowS
[NodeInfo n] -> ShowS
NodeInfo n -> String
(Int -> NodeInfo n -> ShowS)
-> (NodeInfo n -> String)
-> ([NodeInfo n] -> ShowS)
-> Show (NodeInfo n)
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
$cshowsPrec :: forall n. Show n => Int -> NodeInfo n -> ShowS
showsPrec :: Int -> NodeInfo n -> ShowS
$cshow :: forall n. Show n => NodeInfo n -> String
show :: NodeInfo n -> String
$cshowList :: forall n. Show n => [NodeInfo n] -> ShowS
showList :: [NodeInfo n] -> ShowS
Show, ReadPrec [NodeInfo n]
ReadPrec (NodeInfo n)
Int -> ReadS (NodeInfo n)
ReadS [NodeInfo n]
(Int -> ReadS (NodeInfo n))
-> ReadS [NodeInfo n]
-> ReadPrec (NodeInfo n)
-> ReadPrec [NodeInfo n]
-> Read (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
$creadsPrec :: forall n. (Ord n, Read n) => Int -> ReadS (NodeInfo n)
readsPrec :: Int -> ReadS (NodeInfo n)
$creadList :: forall n. (Ord n, Read n) => ReadS [NodeInfo n]
readList :: ReadS [NodeInfo n]
$creadPrec :: forall n. (Ord n, Read n) => ReadPrec (NodeInfo n)
readPrec :: ReadPrec (NodeInfo n)
$creadListPrec :: forall n. (Ord n, Read n) => ReadPrec [NodeInfo n]
readListPrec :: ReadPrec [NodeInfo n]
Read)

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

adjacent :: Context n -> [DotEdge n]
adjacent :: forall n. Context n -> [DotEdge n]
adjacent Context n
c = (n -> Attributes -> DotEdge n) -> [(n, Attributes)] -> [DotEdge n]
forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) (Context n -> [(n, Attributes)]
forall n. Context n -> [(n, Attributes)]
predecessors Context n
c)
             [DotEdge n] -> [DotEdge n] -> [DotEdge n]
forall a. [a] -> [a] -> [a]
++ (n -> Attributes -> DotEdge n) -> [(n, Attributes)] -> [DotEdge n]
forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) (Context n -> [(n, Attributes)]
forall n. Context n -> [(n, Attributes)]
successors Context n
c)
  where
    n :: n
n = Context n -> n
forall n. Context n -> n
node Context n
c
    mapU :: (a -> b -> b) -> [(a, b)] -> [b]
mapU = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (((a, b) -> b) -> [(a, b)] -> [b])
-> ((a -> b -> b) -> (a, b) -> b)
-> (a -> b -> b)
-> [(a, b)]
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> (a, b) -> b
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       = Maybe GraphID
forall a. Maybe a
Nothing
                , graphAttrs :: GlobAttrs
graphAttrs    = GlobAttrs
emptyGA
                , clusters :: Map GraphID ClusterInfo
clusters      = Map GraphID ClusterInfo
forall k a. Map k a
M.empty
                , values :: NodeMap n
values        = NodeMap n
forall k a. Map k a
M.empty
                }

emptyGA :: GlobAttrs
emptyGA :: GlobAttrs
emptyGA = SAttrs -> SAttrs -> SAttrs -> GlobAttrs
GA SAttrs
forall a. Set a
S.empty SAttrs
forall a. Set a
S.empty SAttrs
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 = (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
merge DotGraph n
dg'
  where
    ps' :: EdgeMap n
ps' = [(n, Attributes)] -> EdgeMap n
forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ps
    ps'' :: [(n, Attributes)]
ps'' = EdgeMap n -> [(n, Attributes)]
forall n. EdgeMap n -> [(n, Attributes)]
fromMap (n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ps')
    ss' :: EdgeMap n
ss' = [(n, Attributes)] -> EdgeMap n
forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ss
    ss'' :: [(n, Attributes)]
ss'' = EdgeMap n -> [(n, Attributes)]
forall n. EdgeMap n -> [(n, Attributes)]
fromMap (n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ss')

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

    merge :: NodeMap n -> NodeMap n
merge = n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev n
n [(n, Attributes)]
ps'' (NodeMap n -> NodeMap n)
-> (NodeMap n -> NodeMap n) -> NodeMap n -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev n
n [(n, Attributes)]
ss''
            -- Add reverse edges
            (NodeMap n -> NodeMap n)
-> (NodeMap n -> NodeMap n) -> NodeMap n -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo n -> NodeInfo n) -> n -> NodeMap n -> NodeMap n
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\NodeInfo n
ni -> NodeInfo n
ni { _predecessors = ps', _successors = 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 = (Context n -> DotGraph n -> DotGraph n)
-> DotGraph n -> [Context n] -> DotGraph n
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Context n -> DotGraph n -> DotGraph n
forall n. Ord n => Context n -> DotGraph 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 = UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks UpdateEdgeMap n
forall n. UpdateEdgeMap n
niSkip UpdateEdgeMap n
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 = UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks UpdateEdgeMap n
forall n. UpdateEdgeMap n
niSkip UpdateEdgeMap n
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 = Map n (NodeInfo n) -> Map n (NodeInfo n)
updRev (Map n (NodeInfo n) -> Map n (NodeInfo n))
-> (Map n (NodeInfo n) -> Map n (NodeInfo n))
-> Map n (NodeInfo n)
-> Map n (NodeInfo n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map n (NodeInfo n) -> Map n (NodeInfo n)
updFwd
  where
    updFwd :: Map n (NodeInfo n) -> Map n (NodeInfo n)
updFwd = (NodeInfo n -> NodeInfo n)
-> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
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 = (NodeInfo n -> (n, Attributes) -> NodeInfo n)
-> NodeInfo n -> [(n, Attributes)] -> NodeInfo n
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NodeInfo n
ni' (n
t,Attributes
as) -> UpdateEdgeMap n
fwd (([Attributes] -> [Attributes] -> [Attributes])
-> n -> [Attributes] -> Map n [Attributes] -> Map n [Attributes]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Attributes] -> [Attributes] -> [Attributes]
forall a. [a] -> [a] -> [a]
(++) n
t [Attributes
as]) NodeInfo n
ni') NodeInfo n
ni [(n, Attributes)]
tas

    updRev :: Map n (NodeInfo n) -> Map n (NodeInfo n)
updRev Map n (NodeInfo n)
nm = (Map n (NodeInfo n) -> (n, Attributes) -> Map n (NodeInfo n))
-> Map n (NodeInfo n) -> [(n, Attributes)] -> Map n (NodeInfo n)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map n (NodeInfo n)
nm' (n
t,Attributes
as) -> (NodeInfo n -> NodeInfo n)
-> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
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 Map n (NodeInfo n)
nm') Map n (NodeInfo n)
nm [(n, Attributes)]
tas

    addRev :: Attributes -> NodeInfo n -> NodeInfo n
addRev Attributes
as = UpdateEdgeMap n
rev (([Attributes] -> [Attributes] -> [Attributes])
-> n -> [Attributes] -> Map n [Attributes] -> Map n [Attributes]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Attributes] -> [Attributes] -> [Attributes]
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 = Maybe GraphID -> DotGraph n -> DotGraph n
forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mc (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { values = ns' }
  where
    ns :: Map n (NodeInfo n)
ns = DotGraph n -> Map n (NodeInfo n)
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
    ns' :: Map n (NodeInfo n)
ns' = (NodeInfo n -> NodeInfo n -> NodeInfo n)
-> n -> NodeInfo n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith NodeInfo n -> NodeInfo n -> NodeInfo n
forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
mergeLogic n
n (Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as EdgeMap n
forall k a. Map k a
M.empty EdgeMap n
forall k a. Map k a
M.empty) Map n (NodeInfo 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) =
        Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
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 Maybe GraphID -> Maybe GraphID -> Maybe GraphID
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe GraphID
oldClust
        resAttrs :: Attributes
resAttrs = SAttrs -> Attributes
unSame (SAttrs -> Attributes) -> SAttrs -> Attributes
forall a b. (a -> b) -> a -> b
$ SAttrs -> SAttrs -> SAttrs
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 = ([Attributes] -> [Attributes] -> [Attributes])
-> EdgeMap n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Attributes] -> [Attributes] -> [Attributes]
forall a. [a] -> [a] -> [a]
(++) EdgeMap n
newPreds EdgeMap n
oldPreds
        resSuccs :: EdgeMap n
resSuccs = ([Attributes] -> [Attributes] -> [Attributes])
-> EdgeMap n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Attributes] -> [Attributes] -> [Attributes]
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) = n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n Maybe GraphID
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 = (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
merge
  where
    merge :: NodeMap n -> NodeMap n
merge = UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks UpdateEdgeMap n
forall n. UpdateEdgeMap n
niSucc UpdateEdgeMap n
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) = n -> n -> Attributes -> DotGraph n -> DotGraph n
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 GraphID -> Map GraphID ClusterInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map GraphID ClusterInfo
cs = String -> DotGraph n
forall a. HasCallStack => String -> a
error String
"Cluster already exists in the graph"
  | Bool
otherwise       = Maybe GraphID -> DotGraph n -> DotGraph n
forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mp
                      (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { clusters = M.insert c ci cs }
  where
    cs :: Map GraphID ClusterInfo
cs = DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
    ci :: ClusterInfo
ci = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
mp (GlobAttrs -> ClusterInfo) -> GlobAttrs -> ClusterInfo
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 = (DotGraph n -> DotGraph n)
-> (GraphID -> DotGraph n -> DotGraph n)
-> Maybe GraphID
-> DotGraph n
-> DotGraph n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DotGraph n -> DotGraph n
forall a. a -> a
id ((Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters ((Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
 -> DotGraph n -> DotGraph n)
-> (GraphID -> Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> GraphID
-> DotGraph n
-> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphID
-> ClusterInfo
-> Map GraphID ClusterInfo
-> Map GraphID ClusterInfo
forall {a}. GraphID -> a -> Map GraphID a -> Map GraphID a
`dontReplace` ClusterInfo
defCI))
  where
    dontReplace :: GraphID -> a -> Map GraphID a -> Map GraphID a
dontReplace = (a -> a -> a) -> GraphID -> a -> Map GraphID a -> Map GraphID a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith ((a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id)
    defCI :: ClusterInfo
defCI = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
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 = (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters ((ClusterInfo -> ClusterInfo)
-> GraphID -> Map GraphID ClusterInfo -> Map GraphID ClusterInfo
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setP GraphID
c) (DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> DotGraph n
forall {n}. DotGraph n -> DotGraph n
addCs
  where
    addCs :: DotGraph n -> DotGraph n
addCs = Maybe GraphID -> DotGraph n -> DotGraph n
forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
p (DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GraphID -> DotGraph n -> DotGraph n
forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just GraphID
c)
    setP :: ClusterInfo -> ClusterInfo
setP ClusterInfo
ci = ClusterInfo
ci { parentCluster = 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 = (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters ((ClusterInfo -> ClusterInfo)
-> GraphID -> Map GraphID ClusterInfo -> Map GraphID ClusterInfo
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setAs GraphID
c)
                             (DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GraphID -> DotGraph n -> DotGraph n
forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just GraphID
c)
  where
    setAs :: ClusterInfo -> ClusterInfo
setAs ClusterInfo
ci = ClusterInfo
ci { clusterAttrs = toGlobAttrs 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 = (DotGraph n -> [DotEdge n] -> DotGraph n)
-> [DotEdge n] -> DotGraph n -> DotGraph n
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DotGraph n -> DotEdge n -> DotGraph n)
-> DotGraph n -> [DotEdge n] -> DotGraph n
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((DotGraph n -> DotEdge n -> DotGraph n)
 -> DotGraph n -> [DotEdge n] -> DotGraph n)
-> (DotGraph n -> DotEdge n -> DotGraph n)
-> DotGraph n
-> [DotEdge n]
-> DotGraph n
forall a b. (a -> b) -> a -> b
$ (DotEdge n -> DotGraph n -> DotGraph n)
-> DotGraph n -> DotEdge n -> DotGraph n
forall a b c. (a -> b -> c) -> b -> a -> c
flip DotEdge n -> DotGraph n -> DotGraph n
forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge) [DotEdge n]
es
                (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall a b. (a -> b) -> a -> b
$ (DotGraph n -> DotNode n -> DotGraph n)
-> DotGraph n -> [DotNode n] -> DotGraph n
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((DotNode n -> DotGraph n -> DotGraph n)
-> DotGraph n -> DotNode n -> DotGraph n
forall a b c. (a -> b -> c) -> b -> a -> c
flip DotNode n -> DotGraph n -> DotGraph n
forall n. Ord n => DotNode n -> DotGraph n -> DotGraph n
addDotNode) DotGraph n
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     = DotGraph n -> Bool
forall n. DotGraph n -> Bool
strictGraph DotGraph n
dg
                            , directedGraph :: Bool
C.directedGraph   = DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg
                            , graphID :: Maybe GraphID
C.graphID         = DotGraph n -> Maybe 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 (GlobAttrs -> [GlobalAttributes])
-> GlobAttrs -> [GlobalAttributes]
forall a b. (a -> b) -> a -> b
$ DotGraph n -> GlobAttrs
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 = Bool -> DotGraph n -> [DotEdge n]
forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo Bool
False DotGraph n
dg
                       }

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

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

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

    ([DotSubGraph n]
cs,[DotNode n]
ns) = ((n, (Maybe GraphID, Attributes))
 -> NodeCluster GraphID (n, Attributes))
-> (GraphID -> Bool)
-> (GraphID -> GraphID)
-> (GraphID -> [GlobalAttributes])
-> ((n, Attributes) -> Attributes)
-> [(n, (Maybe GraphID, Attributes))]
-> ([DotSubGraph n], [DotNode n])
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 (n, (Maybe GraphID, Attributes))
-> NodeCluster GraphID (n, Attributes)
forall {a} {b}.
(a, (Maybe GraphID, b)) -> NodeCluster GraphID (a, b)
pathOf (Bool -> GraphID -> Bool
forall a b. a -> b -> a
const Bool
True) GraphID -> GraphID
forall a. a -> a
id GraphID -> [GlobalAttributes]
clustAs (n, Attributes) -> Attributes
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)) = Maybe GraphID -> (a, b) -> NodeCluster GraphID (a, b)
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 = (GraphID -> NodeCluster GraphID a -> NodeCluster GraphID a)
-> NodeCluster GraphID a -> Seq GraphID -> NodeCluster GraphID a
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr GraphID -> NodeCluster GraphID a -> NodeCluster GraphID a
forall c a. c -> NodeCluster c a -> NodeCluster c a
C (a -> NodeCluster GraphID a
forall c a. a -> NodeCluster c a
N a
ln) (Seq GraphID -> NodeCluster GraphID a)
-> (Maybe (Seq GraphID) -> Seq GraphID)
-> Maybe (Seq GraphID)
-> NodeCluster GraphID a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq GraphID -> Maybe (Seq GraphID) -> Seq GraphID
forall a. a -> Maybe a -> a
fromMaybe Seq GraphID
forall a. Seq a
Seq.empty (Maybe (Seq GraphID) -> NodeCluster GraphID a)
-> Maybe (Seq GraphID) -> NodeCluster GraphID a
forall a b. (a -> b) -> a -> b
$ (GraphID -> Map GraphID (Seq GraphID) -> Maybe (Seq GraphID)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`Map GraphID (Seq GraphID)
pM) (GraphID -> Maybe (Seq GraphID))
-> Maybe GraphID -> Maybe (Seq GraphID)
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 n -> Map n (NodeInfo n) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map n (NodeInfo n)
ns = Maybe (Context n, DotGraph n)
forall a. Maybe a
Nothing
  | Bool
otherwise          = (Context n, DotGraph n) -> Maybe (Context n, DotGraph n)
forall a. a -> Maybe a
Just (Context n
c, DotGraph n
dg')
  where
    ns :: Map n (NodeInfo n)
ns = DotGraph n -> Map n (NodeInfo n)
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
    (Just (NI Maybe GraphID
mc Attributes
as EdgeMap n
ps EdgeMap n
ss), Map n (NodeInfo n)
ns') = (n -> NodeInfo n -> Maybe (NodeInfo n))
-> n
-> Map n (NodeInfo n)
-> (Maybe (NodeInfo n), Map n (NodeInfo n))
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (Maybe (NodeInfo n) -> NodeInfo n -> Maybe (NodeInfo n)
forall a b. a -> b -> a
const (Maybe (NodeInfo n) -> NodeInfo n -> Maybe (NodeInfo n))
-> (n -> Maybe (NodeInfo n))
-> n
-> NodeInfo n
-> Maybe (NodeInfo n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NodeInfo n) -> n -> Maybe (NodeInfo n)
forall a b. a -> b -> a
const Maybe (NodeInfo n)
forall a. Maybe a
Nothing) n
n Map n (NodeInfo n)
ns

    c :: Context n
c = n
-> Maybe GraphID
-> Attributes
-> [(n, Attributes)]
-> [(n, Attributes)]
-> Context n
forall n.
n
-> Maybe GraphID
-> Attributes
-> [(n, Attributes)]
-> [(n, Attributes)]
-> Context n
Cntxt n
n Maybe GraphID
mc Attributes
as (EdgeMap n -> [(n, Attributes)]
forall n. EdgeMap n -> [(n, Attributes)]
fromMap (EdgeMap n -> [(n, Attributes)]) -> EdgeMap n -> [(n, Attributes)]
forall a b. (a -> b) -> a -> b
$ n
n n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` EdgeMap n
ps) (EdgeMap n -> [(n, Attributes)]
forall n. EdgeMap n -> [(n, Attributes)]
fromMap EdgeMap n
ss)
    dg' :: DotGraph n
dg' = DotGraph n
dg { values = delSucc n ps . delPred n ss $ 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
  | DotGraph n -> Bool
forall n. DotGraph n -> Bool
isEmpty DotGraph n
dg = Maybe (Context n, DotGraph n)
forall a. Maybe a
Nothing
  | Bool
otherwise  = n -> DotGraph n -> Maybe (Context n, DotGraph n)
forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose ((n, NodeInfo n) -> n
forall a b. (a, b) -> a
fst ((n, NodeInfo n) -> n)
-> (Map n (NodeInfo n) -> (n, NodeInfo n))
-> Map n (NodeInfo n)
-> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map n (NodeInfo n) -> (n, NodeInfo n)
forall k a. Map k a -> (k, a)
M.findMin (Map n (NodeInfo n) -> n) -> Map n (NodeInfo n) -> n
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Map n (NodeInfo n)
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 = (DotGraph n -> Maybe (Context n, DotGraph n))
-> DotGraph n -> [Context n]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr DotGraph n -> Maybe (Context n, DotGraph n)
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 = ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
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
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 = ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
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
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 = (NodeMap n -> n -> NodeMap n) -> NodeMap n -> [n] -> NodeMap n
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NodeMap n -> n -> NodeMap n
forall {k}. Ord k => Map k (NodeInfo n) -> k -> Map k (NodeInfo n)
delE NodeMap n
nm ([n] -> NodeMap n) -> [n] -> NodeMap n
forall a b. (a -> b) -> a -> b
$ EdgeMap n -> [n]
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 = (NodeInfo n -> NodeInfo n)
-> k -> Map k (NodeInfo n) -> Map k (NodeInfo n)
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 ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
forall a b. (a -> b) -> a -> b
$ n -> EdgeMap n -> EdgeMap n
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 = DotGraph n
-> ((Context n, DotGraph n) -> DotGraph n)
-> Maybe (Context n, DotGraph n)
-> DotGraph n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DotGraph n
dg (Context n, DotGraph n) -> DotGraph n
forall a b. (a, b) -> b
snd (Maybe (Context n, DotGraph n) -> DotGraph n)
-> Maybe (Context n, DotGraph n) -> DotGraph n
forall a b. (a -> b) -> a -> b
$ n -> DotGraph n -> Maybe (Context n, DotGraph n)
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 = (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues (n -> n -> NodeMap n -> NodeMap n
forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delAE n
n1 n
n2 (NodeMap n -> NodeMap n)
-> (NodeMap n -> NodeMap n) -> NodeMap n -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> NodeMap n -> NodeMap n
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 = n -> EdgeMap n -> NodeMap n -> NodeMap n
forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc n
f EdgeMap n
forall {a}. Map n [a]
t' (NodeMap n -> NodeMap n)
-> (NodeMap n -> NodeMap n) -> NodeMap n -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> EdgeMap n -> NodeMap n -> NodeMap n
forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred n
f EdgeMap n
forall {a}. Map n [a]
t'
      where
        t' :: Map n [a]
t' = n -> [a] -> Map n [a]
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 = (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
delEs DotGraph n
dg
  where
    delE :: n -> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
delE n
f n
t = (NodeInfo n -> NodeInfo n)
-> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (UpdateEdgeMap n
forall n. UpdateEdgeMap n
niSucc UpdateEdgeMap n -> UpdateEdgeMap n
forall a b. (a -> b) -> a -> b
$ ([Attributes] -> [Attributes])
-> n -> Map n [Attributes] -> Map n [Attributes]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Attributes -> [Attributes] -> [Attributes]
forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
t) n
f
               (Map n (NodeInfo n) -> Map n (NodeInfo n))
-> (Map n (NodeInfo n) -> Map n (NodeInfo n))
-> Map n (NodeInfo n)
-> Map n (NodeInfo n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo n -> NodeInfo n)
-> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (UpdateEdgeMap n
forall n. UpdateEdgeMap n
niPred UpdateEdgeMap n -> UpdateEdgeMap n
forall a b. (a -> b) -> a -> b
$ ([Attributes] -> [Attributes])
-> n -> Map n [Attributes] -> Map n [Attributes]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Attributes -> [Attributes] -> [Attributes]
forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
f) n
t

    delEs :: NodeMap n -> NodeMap n
delEs | DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = n -> n -> NodeMap n -> NodeMap n
forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2
          | Bool
otherwise        = n -> n -> NodeMap n -> NodeMap n
forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2 (NodeMap n -> NodeMap n)
-> (NodeMap n -> NodeMap n) -> NodeMap n -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> NodeMap n -> NodeMap n
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) = n -> n -> Attributes -> DotGraph n -> DotGraph n
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 = (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues ((NodeInfo n -> NodeInfo n) -> NodeMap n -> NodeMap n
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> NodeInfo n
forall {n}. NodeInfo n -> NodeInfo n
adjNode)
                     (DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters ((ClusterInfo -> ClusterInfo)
-> Map GraphID ClusterInfo -> Map GraphID ClusterInfo
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> ClusterInfo
adjCluster (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> Map GraphID ClusterInfo
-> Map GraphID ClusterInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphID -> Map GraphID ClusterInfo -> Map GraphID ClusterInfo
forall k a. Ord k => k -> Map k a -> Map k a
M.delete GraphID
c)
                     (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall a b. (a -> b) -> a -> b
$ DotGraph n
dg
  where
    p :: Maybe GraphID
p = ClusterInfo -> Maybe GraphID
parentCluster (ClusterInfo -> Maybe GraphID)
-> Maybe ClusterInfo -> Maybe GraphID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GraphID
c GraphID -> Map GraphID ClusterInfo -> Maybe ClusterInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg

    adjParent :: Maybe GraphID -> Maybe GraphID
adjParent Maybe GraphID
p'
      | Maybe GraphID
p' Maybe GraphID -> Maybe GraphID -> Bool
forall a. Eq a => a -> a -> Bool
== GraphID -> Maybe GraphID
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 = adjParent $ _inCluster ni }

    adjCluster :: ClusterInfo -> ClusterInfo
adjCluster ClusterInfo
ci = ClusterInfo
ci { parentCluster = adjParent $ parentCluster 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 = cM' }
  where
    cM :: Map GraphID ClusterInfo
cM = DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
    cM' :: Map GraphID ClusterInfo
cM' = (Map GraphID ClusterInfo
cM Map GraphID ClusterInfo
-> Map GraphID [GraphID] -> Map GraphID ClusterInfo
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map GraphID [GraphID]
invCs) Map GraphID ClusterInfo
-> Map GraphID [n] -> Map GraphID ClusterInfo
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 = Map GraphID (Maybe GraphID) -> Map GraphID [GraphID]
forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn (Map GraphID (Maybe GraphID) -> Map GraphID [GraphID])
-> Map GraphID (Maybe GraphID) -> Map GraphID [GraphID]
forall a b. (a -> b) -> a -> b
$ (ClusterInfo -> Maybe GraphID)
-> Map GraphID ClusterInfo -> Map GraphID (Maybe GraphID)
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 = Map n (Maybe GraphID) -> Map GraphID [n]
forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn (Map n (Maybe GraphID) -> Map GraphID [n])
-> (Map n (NodeInfo n) -> Map n (Maybe GraphID))
-> Map n (NodeInfo n)
-> Map GraphID [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo n -> Maybe GraphID)
-> Map n (NodeInfo n) -> Map n (Maybe GraphID)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> Maybe GraphID
forall n. NodeInfo n -> Maybe GraphID
_inCluster (Map n (NodeInfo n) -> Map GraphID [n])
-> Map n (NodeInfo n) -> Map GraphID [n]
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Map n (NodeInfo n)
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg

    usedClustsIn :: Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn = [(GraphID, [b])] -> Map GraphID [b]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
                   ([(GraphID, [b])] -> Map GraphID [b])
-> (Map b (Maybe GraphID) -> [(GraphID, [b])])
-> Map b (Maybe GraphID)
-> Map GraphID [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(GraphID, b)] -> (GraphID, [b]))
-> [[(GraphID, b)]] -> [(GraphID, [b])]
forall a b. (a -> b) -> [a] -> [b]
map ((,) (GraphID -> [b] -> (GraphID, [b]))
-> ([(GraphID, b)] -> GraphID)
-> [(GraphID, b)]
-> [b]
-> (GraphID, [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GraphID, b) -> GraphID
forall a b. (a, b) -> a
fst ((GraphID, b) -> GraphID)
-> ([(GraphID, b)] -> (GraphID, b)) -> [(GraphID, b)] -> GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(GraphID, b)] -> (GraphID, b)
forall a. HasCallStack => [a] -> a
head ([(GraphID, b)] -> [b] -> (GraphID, [b]))
-> ([(GraphID, b)] -> [b]) -> [(GraphID, b)] -> (GraphID, [b])
forall a b.
([(GraphID, b)] -> a -> b)
-> ([(GraphID, b)] -> a) -> [(GraphID, b)] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((GraphID, b) -> b) -> [(GraphID, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (GraphID, b) -> b
forall a b. (a, b) -> b
snd)
                   ([[(GraphID, b)]] -> [(GraphID, [b])])
-> (Map b (Maybe GraphID) -> [[(GraphID, b)]])
-> Map b (Maybe GraphID)
-> [(GraphID, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GraphID, b) -> GraphID) -> [(GraphID, b)] -> [[(GraphID, b)]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy (GraphID, b) -> GraphID
forall a b. (a, b) -> a
fst
                   ([(GraphID, b)] -> [[(GraphID, b)]])
-> (Map b (Maybe GraphID) -> [(GraphID, b)])
-> Map b (Maybe GraphID)
-> [[(GraphID, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Maybe GraphID) -> Maybe (GraphID, b))
-> [(b, Maybe GraphID)] -> [(GraphID, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((b -> Maybe GraphID -> Maybe (GraphID, b))
-> (b, Maybe GraphID) -> Maybe (GraphID, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((GraphID -> (GraphID, b)) -> Maybe GraphID -> Maybe (GraphID, b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GraphID -> (GraphID, b)) -> Maybe GraphID -> Maybe (GraphID, b))
-> (b -> GraphID -> (GraphID, b))
-> b
-> Maybe GraphID
-> Maybe (GraphID, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphID -> b -> (GraphID, b)) -> b -> GraphID -> (GraphID, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)))
                   ([(b, Maybe GraphID)] -> [(GraphID, b)])
-> (Map b (Maybe GraphID) -> [(b, Maybe GraphID)])
-> Map b (Maybe GraphID)
-> [(GraphID, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map b (Maybe GraphID) -> [(b, Maybe GraphID)]
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 = Map n (NodeInfo n) -> Bool
forall k a. Map k a -> Bool
M.null (Map n (NodeInfo n) -> Bool)
-> (DotGraph n -> Map n (NodeInfo n)) -> DotGraph n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> Map n (NodeInfo n)
forall n. DotGraph n -> NodeMap n
values

-- | Does this graph have any clusters?
hasClusters :: DotGraph n -> Bool
hasClusters :: forall n. DotGraph n -> Bool
hasClusters = Map GraphID ClusterInfo -> Bool
forall k a. Map k a -> Bool
M.null (Map GraphID ClusterInfo -> Bool)
-> (DotGraph n -> Map GraphID ClusterInfo) -> DotGraph n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> Map GraphID ClusterInfo
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 = (Bool -> Bool -> Bool)
-> (DotGraph n -> Bool)
-> (DotGraph n -> Bool)
-> DotGraph n
-> Bool
forall a b c.
(a -> b -> c)
-> (DotGraph n -> a) -> (DotGraph n -> b) -> DotGraph n -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) DotGraph n -> Bool
forall n. DotGraph n -> Bool
isEmpty (Bool -> Bool
not (Bool -> Bool) -> (DotGraph n -> Bool) -> DotGraph n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> Bool
forall n. DotGraph n -> Bool
hasClusters)

graphAttributes :: DotGraph n -> [GlobalAttributes]
graphAttributes :: forall n. DotGraph n -> [GlobalAttributes]
graphAttributes = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs (GlobAttrs -> [GlobalAttributes])
-> (DotGraph n -> GlobAttrs) -> DotGraph n -> [GlobalAttributes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> GlobAttrs
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 = NodeInfo n -> Maybe GraphID
forall n. NodeInfo n -> Maybe GraphID
_inCluster (NodeInfo n -> Maybe GraphID) -> NodeInfo n -> Maybe GraphID
forall a b. (a -> b) -> a -> b
$ DotGraph n -> NodeMap n
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg NodeMap n -> n -> NodeInfo n
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 = NodeInfo n -> Attributes
forall n. NodeInfo n -> Attributes
_attributes (NodeInfo n -> Attributes) -> NodeInfo n -> Attributes
forall a b. (a -> b) -> a -> b
$ DotGraph n -> NodeMap n
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg NodeMap n -> n -> NodeInfo n
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
  | DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
t)
                       (EdgeMap n -> [DotEdge n])
-> (NodeInfo n -> EdgeMap n) -> NodeInfo n -> [DotEdge n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo n -> EdgeMap n
forall n. NodeInfo n -> EdgeMap n
_predecessors (NodeInfo n -> [DotEdge n]) -> NodeInfo n -> [DotEdge n]
forall a b. (a -> b) -> a -> b
$ DotGraph n -> NodeMap n
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg NodeMap n -> n -> NodeInfo n
forall k a. Ord k => Map k a -> k -> a
M.! n
t
  | Bool
otherwise        = DotGraph n -> n -> [DotEdge n]
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
  | DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f)
                       (EdgeMap n -> [DotEdge n])
-> (NodeInfo n -> EdgeMap n) -> NodeInfo n -> [DotEdge n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo n -> EdgeMap n
forall n. NodeInfo n -> EdgeMap n
_successors (NodeInfo n -> [DotEdge n]) -> NodeInfo n -> [DotEdge n]
forall a b. (a -> b) -> a -> b
$ DotGraph n -> NodeMap n
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg NodeMap n -> n -> NodeInfo n
forall k a. Ord k => Map k a -> k -> a
M.! n
f
  | Bool
otherwise        = DotGraph n -> n -> [DotEdge n]
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 [DotEdge n] -> [DotEdge n] -> [DotEdge n]
forall a. [a] -> [a] -> [a]
++ [DotEdge n]
preds
  where
    ni :: NodeInfo n
ni = DotGraph n -> NodeMap n
forall n. DotGraph n -> NodeMap n
values DotGraph n
dg NodeMap n -> n -> NodeInfo n
forall k a. Ord k => Map k a -> k -> a
M.! n
n
    sucs :: [DotEdge n]
sucs = (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) (EdgeMap n -> [DotEdge n]) -> EdgeMap n -> [DotEdge n]
forall a b. (a -> b) -> a -> b
$ NodeInfo n -> EdgeMap n
forall n. NodeInfo n -> EdgeMap n
_successors NodeInfo n
ni
    preds :: [DotEdge n]
preds = (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) (EdgeMap n -> [DotEdge n]) -> EdgeMap n -> [DotEdge n]
forall a b. (a -> b) -> a -> b
$ n
n n -> EdgeMap n -> EdgeMap n
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` NodeInfo n -> EdgeMap n
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 = ((n, Attributes) -> DotEdge n) -> [(n, Attributes)] -> [DotEdge n]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> Attributes -> DotEdge n) -> (n, Attributes) -> DotEdge n
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry n -> Attributes -> DotEdge n
f) ([(n, Attributes)] -> [DotEdge n])
-> (EdgeMap n -> [(n, Attributes)]) -> EdgeMap n -> [DotEdge n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EdgeMap n -> [(n, Attributes)]
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 (ClusterInfo -> Maybe GraphID) -> ClusterInfo -> Maybe GraphID
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg Map GraphID ClusterInfo -> GraphID -> ClusterInfo
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 (GlobAttrs -> [GlobalAttributes])
-> (ClusterInfo -> GlobAttrs) -> ClusterInfo -> [GlobalAttributes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClusterInfo -> GlobAttrs
clusterAttrs (ClusterInfo -> [GlobalAttributes])
-> ClusterInfo -> [GlobalAttributes]
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg Map GraphID ClusterInfo -> GraphID -> ClusterInfo
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 = DotGraph n -> DotGraph n
forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr

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

  setID :: GraphID -> DotGraph n -> DotGraph n
setID GraphID
i DotGraph n
g = DotGraph n
g { graphID = Just i }

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

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

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

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

  mapDotGraph :: forall n'.
DotRepr DotGraph n' =>
(n -> n') -> DotGraph n -> DotGraph n'
mapDotGraph = (n -> n') -> DotGraph n -> DotGraph n'
forall n' n. Ord n' => (n -> n') -> DotGraph n -> DotGraph n'
mapNs

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

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

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

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

instance (Ord n) => G.FromGeneralisedDot DotGraph n where
  fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = DotGraph n -> DotGraph n
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 = DotGraph n -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot (DotGraph n -> DotCode)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> DotGraph n
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 (DotGraph n -> DotGraph n)
-> Parser GraphvizState (DotGraph n) -> Parse (DotGraph n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState (DotGraph n)
forall a. ParseDot a => Parse a
parseUnqt
    where
      -- fromGDot :: G.DotGraph n -> DotGraph n
      fromGDot :: DotGraph n -> DotGraph n
fromGDot = DotGraph n -> DotGraph n
forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr (DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n) -> DotGraph n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotGraph n -> DotGraph n -> DotGraph n
forall a. a -> a -> a
`asTypeOf` (DotGraph n
forall {n}. DotGraph n
forall a. HasCallStack => a
undefined :: G.DotGraph n))

  parse :: Parse (DotGraph n)
parse = Parse (DotGraph n)
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 = DotGraph n -> DotGraph n
forall n. Ord n => DotGraph n -> DotGraph n
unsafeFromCanonical (DotGraph n -> DotGraph n)
-> (dg n -> DotGraph n) -> dg n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicaliseOptions -> dg n -> DotGraph n
forall (dg :: * -> *) n.
DotRepr dg n =>
CanonicaliseOptions -> dg n -> DotGraph n
canonicaliseOptions CanonicaliseOptions
cOptions (dg n -> DotGraph n) -> (dg n -> dg n) -> dg n -> DotGraph n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. dg n -> dg n
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   = DotGraph n -> Bool
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 = DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
C.graphStatements DotGraph n
dg
    mgid :: Maybe GraphID
mgid = DotGraph n -> Maybe GraphID
forall n. DotGraph n -> Maybe GraphID
C.graphID DotGraph n
dg
    dirGraph :: Bool
dirGraph = DotGraph n -> Bool
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 Maybe GraphID
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 ([GlobalAttributes] -> GlobAttrs)
-> [GlobalAttributes] -> GlobAttrs
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [GlobalAttributes]
forall n. DotStatements n -> [GlobalAttributes]
C.attrStmts DotStatements n
stmts'
        (Map GraphID ClusterInfo
cs', NodeMap n
sgNs) = ([Map GraphID ClusterInfo] -> Map GraphID ClusterInfo
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map GraphID ClusterInfo] -> Map GraphID ClusterInfo)
-> ([NodeMap n] -> NodeMap n)
-> ([Map GraphID ClusterInfo], [NodeMap n])
-> (Map GraphID ClusterInfo, NodeMap n)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [NodeMap n] -> NodeMap n
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions) (([Map GraphID ClusterInfo], [NodeMap n])
 -> (Map GraphID ClusterInfo, NodeMap n))
-> ([DotSubGraph n] -> ([Map GraphID ClusterInfo], [NodeMap n]))
-> [DotSubGraph n]
-> (Map GraphID ClusterInfo, NodeMap n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Map GraphID ClusterInfo, NodeMap n)]
-> ([Map GraphID ClusterInfo], [NodeMap n])
forall a b. [(a, b)] -> ([a], [b])
unzip
                      ([(Map GraphID ClusterInfo, NodeMap n)]
 -> ([Map GraphID ClusterInfo], [NodeMap n]))
-> ([DotSubGraph n] -> [(Map GraphID ClusterInfo, NodeMap n)])
-> [DotSubGraph n]
-> ([Map GraphID ClusterInfo], [NodeMap n])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n))
-> [DotSubGraph n] -> [(Map GraphID ClusterInfo, NodeMap n)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID
-> DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n)
fCSG Maybe GraphID
p) ([DotSubGraph n] -> (Map GraphID ClusterInfo, NodeMap n))
-> [DotSubGraph n] -> (Map GraphID ClusterInfo, NodeMap n)
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [DotSubGraph n]
forall n. DotStatements n -> [DotSubGraph n]
C.subGraphs DotStatements n
stmts'
        nNs :: NodeMap n
nNs = [(n, NodeInfo n)] -> NodeMap n
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(n, NodeInfo n)] -> NodeMap n)
-> ([DotNode n] -> [(n, NodeInfo n)]) -> [DotNode n] -> NodeMap n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotNode n -> (n, NodeInfo n)) -> [DotNode n] -> [(n, NodeInfo n)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID -> DotNode n -> (n, NodeInfo n)
fDN Maybe GraphID
p) ([DotNode n] -> NodeMap n) -> [DotNode n] -> NodeMap n
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [DotNode n]
forall n. DotStatements n -> [DotNode n]
C.nodeStmts DotStatements n
stmts'
        ns' :: NodeMap n
ns' = NodeMap n
sgNs NodeMap n -> NodeMap n -> NodeMap n
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 = (GraphID
-> ClusterInfo
-> Map GraphID ClusterInfo
-> Map GraphID ClusterInfo
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) = DotSubGraph n -> Maybe GraphID
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 (DotStatements n
 -> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n))
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> DotStatements n
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 = n -> Map n (EdgeMap n) -> EdgeMap n
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   = n -> Map n (EdgeMap n) -> EdgeMap n
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 = DotStatements n -> [DotEdge n]
forall n. DotStatements n -> [DotEdge n]
C.edgeStmts DotStatements n
stmts
    fEs :: Map n (EdgeMap n)
fEs = (DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap DotEdge n -> n
forall n. DotEdge n -> n
fromNode DotEdge n -> n
forall n. DotEdge n -> n
toNode [DotEdge n]
es
    tEs :: Map n (EdgeMap n)
tEs = Map n (EdgeMap n) -> Map n (EdgeMap n)
forall {a}. Map n (Map n a) -> Map n (Map n a)
delLoops (Map n (EdgeMap n) -> Map n (EdgeMap n))
-> Map n (EdgeMap n) -> Map n (EdgeMap n)
forall a b. (a -> b) -> a -> b
$ (DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap DotEdge n -> n
forall n. DotEdge n -> n
toNode DotEdge n -> n
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' = Map k a -> Maybe (Map k a) -> Map k a
forall a. a -> Maybe a -> a
fromMaybe Map k a
forall k a. Map k a
M.empty (Maybe (Map k a) -> Map k a) -> Maybe (Map k a) -> Map k a
forall a b. (a -> b) -> a -> b
$ k
n k -> Map k (Map k a) -> Maybe (Map k a)
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 = (n -> Map n a -> Map n a) -> Map n (Map n a) -> Map n (Map n a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey n -> Map n a -> Map n a
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 = ([(n, Attributes)] -> EdgeMap n)
-> Map n [(n, Attributes)] -> Map n (EdgeMap n)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [(n, Attributes)] -> EdgeMap n
forall {c}. [(n, c)] -> Map n [c]
eM (Map n [(n, Attributes)] -> Map n (EdgeMap n))
-> ([DotEdge n] -> Map n [(n, Attributes)])
-> [DotEdge n]
-> Map n (EdgeMap n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(n, [(n, Attributes)])] -> Map n [(n, Attributes)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(n, [(n, Attributes)])] -> Map n [(n, Attributes)])
-> ([DotEdge n] -> [(n, [(n, Attributes)])])
-> [DotEdge n]
-> Map n [(n, Attributes)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotEdge n -> n)
-> (DotEdge n -> (n, Attributes))
-> [DotEdge n]
-> [(n, [(n, Attributes)])]
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' = (n -> Attributes -> (n, Attributes))
-> (DotEdge n -> n)
-> (DotEdge n -> Attributes)
-> DotEdge n
-> (n, Attributes)
forall a b c.
(a -> b -> c)
-> (DotEdge n -> a) -> (DotEdge n -> b) -> DotEdge n -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) DotEdge n -> n
t DotEdge n -> Attributes
forall n. DotEdge n -> Attributes
edgeAttributes
    eM :: [(n, c)] -> Map n [c]
eM = [(n, [c])] -> Map n [c]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(n, [c])] -> Map n [c])
-> ([(n, c)] -> [(n, [c])]) -> [(n, c)] -> Map n [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((n, c) -> n) -> ((n, c) -> c) -> [(n, c)] -> [(n, [c])]
forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy (n, c) -> n
forall a b. (a, b) -> a
fst (n, c) -> c
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) = Bool
-> Bool
-> GlobAttrs
-> Maybe GraphID
-> Map GraphID ClusterInfo
-> NodeMap n'
-> DotGraph n'
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
                                 (NodeMap n' -> DotGraph n') -> NodeMap n' -> DotGraph n'
forall a b. (a -> b) -> a -> b
$ NodeMap n -> NodeMap n'
mapNM NodeMap n
vs
  where
    mapNM :: NodeMap n -> NodeMap n'
mapNM = (NodeInfo n -> NodeInfo n') -> Map n' (NodeInfo n) -> NodeMap n'
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> NodeInfo n'
mapNI (Map n' (NodeInfo n) -> NodeMap n')
-> (NodeMap n -> Map n' (NodeInfo n)) -> NodeMap n -> NodeMap n'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeMap n -> Map n' (NodeInfo n)
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) = Maybe GraphID
-> Attributes -> EdgeMap n' -> EdgeMap n' -> NodeInfo n'
forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as' (EdgeMap n -> EdgeMap n'
forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ps) (EdgeMap n -> EdgeMap n'
forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ss)
    mpM :: Map n a -> Map n' a
mpM = (n -> n') -> Map n a -> Map n' a
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 (Attributes -> GlobalAttributes)
-> (SAttrs -> Attributes) -> SAttrs -> GlobalAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
    (GlobalAttributes
gas, Map GraphID GlobalAttributes
cgs) = (SAttrs -> GlobalAttributes
toGA (SAttrs -> GlobalAttributes)
-> (Map GraphID SAttrs -> Map GraphID GlobalAttributes)
-> (SAttrs, Map GraphID SAttrs)
-> (GlobalAttributes, Map GraphID GlobalAttributes)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (SAttrs -> GlobalAttributes)
-> Map GraphID SAttrs -> Map GraphID GlobalAttributes
forall a b k. (a -> b) -> Map k a -> Map k b
M.map SAttrs -> GlobalAttributes
toGA) ((SAttrs, Map GraphID SAttrs)
 -> (GlobalAttributes, Map GraphID GlobalAttributes))
-> (SAttrs, Map GraphID SAttrs)
-> (GlobalAttributes, Map GraphID GlobalAttributes)
forall a b. (a -> b) -> a -> b
$ (GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
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 = (Seq (Maybe GraphID) -> Seq (Maybe GraphID))
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Seq (Maybe GraphID) -> Seq (Maybe GraphID)
forall {a}. Seq a -> Seq a
pInit (Map (Maybe GraphID) (Seq (Maybe GraphID))
 -> Map (Maybe GraphID) (Seq (Maybe GraphID)))
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg

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

    addPath :: Maybe GraphID -> b -> ([Seq (Maybe GraphID)], b)
addPath Maybe GraphID
c b
as = ( Maybe (Seq (Maybe GraphID)) -> [Seq (Maybe GraphID)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Seq (Maybe GraphID)) -> [Seq (Maybe GraphID)])
-> Maybe (Seq (Maybe GraphID)) -> [Seq (Maybe GraphID)]
forall a b. (a -> b) -> a -> b
$ Maybe GraphID
c Maybe GraphID
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
-> Maybe (Seq (Maybe GraphID))
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 Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
p of
                (Seq a
p' Seq.:> a
_) -> Seq a
p'
                ViewR a
_             -> Seq 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 = (NodeInfo n -> (Seq (Maybe GraphID), Attributes))
-> Map n (NodeInfo n) -> Map n (Seq (Maybe GraphID), Attributes)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> (Seq (Maybe GraphID), Attributes)
forall {n}. NodeInfo n -> (Seq (Maybe GraphID), Attributes)
toLookup Map n (NodeInfo n)
ns
  where
    (SAttrs
gGlob, Map GraphID SAttrs
aM) = (GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
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 = DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg

    ns :: Map n (NodeInfo n)
ns = DotGraph n -> Map n (NodeInfo n)
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 = NodeInfo n -> Attributes
forall n. NodeInfo n -> Attributes
_attributes NodeInfo n
ni
        mp :: Maybe GraphID
mp = NodeInfo n -> Maybe GraphID
forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni
        pth :: Seq (Maybe GraphID)
pth = Seq (Maybe GraphID)
-> Maybe (Seq (Maybe GraphID)) -> Seq (Maybe GraphID)
forall a. a -> Maybe a -> a
fromMaybe Seq (Maybe GraphID)
forall a. Seq a
Seq.empty (Maybe (Seq (Maybe GraphID)) -> Seq (Maybe GraphID))
-> Maybe (Seq (Maybe GraphID)) -> Seq (Maybe GraphID)
forall a b. (a -> b) -> a -> b
$ Maybe GraphID
mp Maybe GraphID
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
-> Maybe (Seq (Maybe GraphID))
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe GraphID) (Seq (Maybe GraphID))
pM
        pAs :: SAttrs
pAs = SAttrs -> Maybe SAttrs -> SAttrs
forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob (Maybe SAttrs -> SAttrs) -> Maybe SAttrs -> SAttrs
forall a b. (a -> b) -> a -> b
$ (GraphID -> Map GraphID SAttrs -> Maybe SAttrs
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) (GraphID -> Maybe SAttrs) -> Maybe GraphID -> Maybe SAttrs
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
mp
        as' :: Attributes
as' | Bool
withGlob  = SAttrs -> Attributes
unSame (SAttrs -> Attributes) -> SAttrs -> Attributes
forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as SAttrs -> SAttrs -> SAttrs
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 = ((n, (n, [Attributes])) -> [DotEdge n])
-> [(n, (n, [Attributes]))] -> [DotEdge n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((n -> (n, [Attributes]) -> [DotEdge n])
-> (n, (n, [Attributes])) -> [DotEdge n]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry n -> (n, [Attributes]) -> [DotEdge n]
forall {n}. n -> (n, [Attributes]) -> [DotEdge n]
mkDotEdges) [(n, (n, [Attributes]))]
es
  where
    gGlob :: SAttrs
gGlob = GlobAttrs -> SAttrs
edgeAs (GlobAttrs -> SAttrs) -> GlobAttrs -> SAttrs
forall a b. (a -> b) -> a -> b
$ DotGraph n -> GlobAttrs
forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg

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

    addGlob :: Attributes -> Attributes
addGlob Attributes
as
      | Bool
withGlob  = SAttrs -> Attributes
unSame (SAttrs -> Attributes) -> SAttrs -> Attributes
forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as SAttrs -> SAttrs -> SAttrs
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) = (Attributes -> DotEdge n) -> [Attributes] -> [DotEdge n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> n -> Attributes -> DotEdge n
forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f n
t (Attributes -> DotEdge n)
-> (Attributes -> Attributes) -> Attributes -> DotEdge n
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 (GlobAttrs -> SAttrs) -> GlobAttrs -> SAttrs
forall a b. (a -> b) -> a -> b
$ DotGraph n -> GlobAttrs
forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg

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

    aM :: Map GraphID SAttrs
aM = (ClusterInfo -> SAttrs)
-> Map GraphID ClusterInfo -> Map GraphID SAttrs
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 SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
pAs
      where
        as :: SAttrs
as = GlobAttrs -> SAttrs
af (GlobAttrs -> SAttrs) -> GlobAttrs -> SAttrs
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 = SAttrs -> Maybe SAttrs -> SAttrs
forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob (Maybe SAttrs -> SAttrs) -> Maybe SAttrs -> SAttrs
forall a b. (a -> b) -> a -> b
$ (GraphID -> Map GraphID SAttrs -> Maybe SAttrs
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) (GraphID -> Maybe SAttrs) -> Maybe GraphID -> Maybe SAttrs
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 = (GraphID -> Maybe GraphID)
-> Map GraphID (Seq (Maybe GraphID))
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just (Map GraphID (Seq (Maybe GraphID))
 -> Map (Maybe GraphID) (Seq (Maybe GraphID)))
-> (DotGraph n -> Map GraphID (Seq (Maybe GraphID)))
-> DotGraph n
-> Map (Maybe GraphID) (Seq (Maybe GraphID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq GraphID -> Seq (Maybe GraphID))
-> Map GraphID (Seq GraphID) -> Map GraphID (Seq (Maybe GraphID))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((GraphID -> Maybe GraphID) -> Seq GraphID -> Seq (Maybe GraphID)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just) (Map GraphID (Seq GraphID) -> Map GraphID (Seq (Maybe GraphID)))
-> (DotGraph n -> Map GraphID (Seq GraphID))
-> DotGraph n
-> Map GraphID (Seq (Maybe GraphID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> Map GraphID (Seq GraphID)
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 = DotGraph n -> Map GraphID ClusterInfo
forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg

    pM :: Map GraphID (Seq GraphID)
pM = (GraphID -> ClusterInfo -> Seq GraphID)
-> Map GraphID ClusterInfo -> Map GraphID (Seq GraphID)
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 Seq GraphID -> GraphID -> Seq GraphID
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 = Seq GraphID -> Maybe (Seq GraphID) -> Seq GraphID
forall a. a -> Maybe a -> a
fromMaybe Seq GraphID
forall a. Seq a
Seq.empty (Maybe (Seq GraphID) -> Seq GraphID)
-> Maybe (Seq GraphID) -> Seq GraphID
forall a b. (a -> b) -> a -> b
$ (GraphID -> Map GraphID (Seq GraphID) -> Maybe (Seq GraphID)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID (Seq GraphID)
pM) (GraphID -> Maybe (Seq GraphID))
-> Maybe GraphID -> Maybe (Seq GraphID)
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 = f $ values 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 = f $ clusters dg }

toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs = (Attributes, Attributes, Attributes) -> GlobAttrs
mkGA ((Attributes, Attributes, Attributes) -> GlobAttrs)
-> ([GlobalAttributes] -> (Attributes, Attributes, Attributes))
-> [GlobalAttributes]
-> GlobAttrs
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) = (GlobalAttributes -> Bool)
-> [GlobalAttributes] -> [GlobalAttributes]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (GlobalAttributes -> Bool) -> GlobalAttributes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Attributes -> Bool)
-> (GlobalAttributes -> Attributes) -> GlobalAttributes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAttributes -> Attributes
attrs)
                              [ Attributes -> GlobalAttributes
GraphAttrs (Attributes -> GlobalAttributes) -> Attributes -> GlobalAttributes
forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
ga
                              , Attributes -> GlobalAttributes
NodeAttrs  (Attributes -> GlobalAttributes) -> Attributes -> GlobalAttributes
forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
na
                              , Attributes -> GlobalAttributes
EdgeAttrs  (Attributes -> GlobalAttributes) -> Attributes -> GlobalAttributes
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 = f $ _successors ni }

niPred      :: UpdateEdgeMap n
niPred :: forall n. UpdateEdgeMap n
niPred EdgeMap n -> EdgeMap n
f NodeInfo n
ni = NodeInfo n
ni { _predecessors = f $ _predecessors 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 = [(n, [Attributes])] -> Map n [Attributes]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([(n, [Attributes])] -> Map n [Attributes])
-> ([(n, Attributes)] -> [(n, [Attributes])])
-> [(n, Attributes)]
-> Map n [Attributes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((n, Attributes) -> n)
-> ((n, Attributes) -> Attributes)
-> [(n, Attributes)]
-> [(n, [Attributes])]
forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy (n, Attributes) -> n
forall a b. (a, b) -> a
fst (n, Attributes) -> Attributes
forall a b. (a, b) -> b
snd

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