{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}
module Data.GraphViz.Types.Graph
( DotGraph
, GraphID(..)
, Context(..)
, toCanonical
, unsafeFromCanonical
, fromDotRepr
, isEmpty
, hasClusters
, isEmptyGraph
, graphAttributes
, parentOf
, clusterAttributes
, foundInCluster
, attributesOf
, predecessorsOf
, successorsOf
, adjacentTo
, adjacent
, mkGraph
, emptyGraph
, (&)
, composeList
, addNode
, DotNode(..)
, addDotNode
, addEdge
, DotEdge(..)
, addDotEdge
, addCluster
, setClusterParent
, setClusterAttributes
, 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
data DotGraph n = DG { forall n. DotGraph n -> Bool
strictGraph :: !Bool
, forall n. DotGraph n -> Bool
directedGraph :: !Bool
, forall n. DotGraph n -> GlobAttrs
graphAttrs :: !GlobAttrs
, forall n. DotGraph n -> Maybe GraphID
graphID :: !(Maybe GraphID)
, forall n. DotGraph n -> Map GraphID ClusterInfo
clusters :: !(Map GraphID ClusterInfo)
, forall n. DotGraph n -> NodeMap n
values :: !(NodeMap n)
}
deriving (DotGraph n -> DotGraph n -> Bool
forall n. Eq n => DotGraph n -> DotGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotGraph n -> DotGraph n -> Bool
$c/= :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
== :: DotGraph n -> DotGraph n -> Bool
$c== :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
Eq, DotGraph n -> DotGraph n -> Bool
DotGraph n -> DotGraph n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (DotGraph n)
forall n. Ord n => DotGraph n -> DotGraph n -> Bool
forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
min :: DotGraph n -> DotGraph n -> DotGraph n
$cmin :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
max :: DotGraph n -> DotGraph n -> DotGraph n
$cmax :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
>= :: DotGraph n -> DotGraph n -> Bool
$c>= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
> :: DotGraph n -> DotGraph n -> Bool
$c> :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
<= :: DotGraph n -> DotGraph n -> Bool
$c<= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
< :: DotGraph n -> DotGraph n -> Bool
$c< :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
compare :: DotGraph n -> DotGraph n -> Ordering
$ccompare :: forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
Ord)
instance (Show n) => Show (DotGraph n) where
showsPrec :: Int -> DotGraph n -> ShowS
showsPrec Int
d DotGraph n
dg = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromCanonical " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall n. DotGraph n -> DotGraph n
toCanonical DotGraph n
dg)
instance (Ord n, Read n) => Read (DotGraph n) where
readPrec :: ReadPrec (DotGraph n)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
forall a b. (a -> b) -> a -> b
$ do Ident String
"fromCanonical" <- ReadPrec Lexeme
lexP
DotGraph n
cdg <- forall a. Read a => ReadPrec a
readPrec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (dg :: * -> *) n. DotRepr dg n => DotGraph n -> dg n
fromCanonical DotGraph n
cdg
data GlobAttrs = GA { GlobAttrs -> SAttrs
graphAs :: !SAttrs
, GlobAttrs -> SAttrs
nodeAs :: !SAttrs
, GlobAttrs -> SAttrs
edgeAs :: !SAttrs
}
deriving (GlobAttrs -> GlobAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobAttrs -> GlobAttrs -> Bool
$c/= :: GlobAttrs -> GlobAttrs -> Bool
== :: GlobAttrs -> GlobAttrs -> Bool
$c== :: GlobAttrs -> GlobAttrs -> Bool
Eq, Eq GlobAttrs
GlobAttrs -> GlobAttrs -> Bool
GlobAttrs -> GlobAttrs -> Ordering
GlobAttrs -> GlobAttrs -> GlobAttrs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlobAttrs -> GlobAttrs -> GlobAttrs
$cmin :: GlobAttrs -> GlobAttrs -> GlobAttrs
max :: GlobAttrs -> GlobAttrs -> GlobAttrs
$cmax :: GlobAttrs -> GlobAttrs -> GlobAttrs
>= :: GlobAttrs -> GlobAttrs -> Bool
$c>= :: GlobAttrs -> GlobAttrs -> Bool
> :: GlobAttrs -> GlobAttrs -> Bool
$c> :: GlobAttrs -> GlobAttrs -> Bool
<= :: GlobAttrs -> GlobAttrs -> Bool
$c<= :: GlobAttrs -> GlobAttrs -> Bool
< :: GlobAttrs -> GlobAttrs -> Bool
$c< :: GlobAttrs -> GlobAttrs -> Bool
compare :: GlobAttrs -> GlobAttrs -> Ordering
$ccompare :: GlobAttrs -> GlobAttrs -> Ordering
Ord, Int -> GlobAttrs -> ShowS
[GlobAttrs] -> ShowS
GlobAttrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobAttrs] -> ShowS
$cshowList :: [GlobAttrs] -> ShowS
show :: GlobAttrs -> String
$cshow :: GlobAttrs -> String
showsPrec :: Int -> GlobAttrs -> ShowS
$cshowsPrec :: Int -> GlobAttrs -> ShowS
Show, ReadPrec [GlobAttrs]
ReadPrec GlobAttrs
Int -> ReadS GlobAttrs
ReadS [GlobAttrs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlobAttrs]
$creadListPrec :: ReadPrec [GlobAttrs]
readPrec :: ReadPrec GlobAttrs
$creadPrec :: ReadPrec GlobAttrs
readList :: ReadS [GlobAttrs]
$creadList :: ReadS [GlobAttrs]
readsPrec :: Int -> ReadS GlobAttrs
$creadsPrec :: Int -> ReadS GlobAttrs
Read)
data NodeInfo n = NI { forall n. NodeInfo n -> Maybe GraphID
_inCluster :: !(Maybe GraphID)
, forall n. NodeInfo n -> Attributes
_attributes :: !Attributes
, forall n. NodeInfo n -> EdgeMap n
_predecessors :: !(EdgeMap n)
, forall n. NodeInfo n -> EdgeMap n
_successors :: !(EdgeMap n)
}
deriving (NodeInfo n -> NodeInfo n -> Bool
forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfo n -> NodeInfo n -> Bool
$c/= :: forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
== :: NodeInfo n -> NodeInfo n -> Bool
$c== :: forall n. Eq n => NodeInfo n -> NodeInfo n -> Bool
Eq, NodeInfo n -> NodeInfo n -> Bool
NodeInfo n -> NodeInfo n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (NodeInfo n)
forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
forall n. Ord n => NodeInfo n -> NodeInfo n -> Ordering
forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
min :: NodeInfo n -> NodeInfo n -> NodeInfo n
$cmin :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
max :: NodeInfo n -> NodeInfo n -> NodeInfo n
$cmax :: forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
>= :: NodeInfo n -> NodeInfo n -> Bool
$c>= :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
> :: NodeInfo n -> NodeInfo n -> Bool
$c> :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
<= :: NodeInfo n -> NodeInfo n -> Bool
$c<= :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
< :: NodeInfo n -> NodeInfo n -> Bool
$c< :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Bool
compare :: NodeInfo n -> NodeInfo n -> Ordering
$ccompare :: forall n. Ord n => NodeInfo n -> NodeInfo n -> Ordering
Ord, Int -> NodeInfo n -> ShowS
forall n. Show n => Int -> NodeInfo n -> ShowS
forall n. Show n => [NodeInfo n] -> ShowS
forall n. Show n => NodeInfo n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo n] -> ShowS
$cshowList :: forall n. Show n => [NodeInfo n] -> ShowS
show :: NodeInfo n -> String
$cshow :: forall n. Show n => NodeInfo n -> String
showsPrec :: Int -> NodeInfo n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> NodeInfo n -> ShowS
Show, ReadPrec [NodeInfo n]
ReadPrec (NodeInfo n)
ReadS [NodeInfo n]
forall n. (Ord n, Read n) => ReadPrec [NodeInfo n]
forall n. (Ord n, Read n) => ReadPrec (NodeInfo n)
forall n. (Ord n, Read n) => Int -> ReadS (NodeInfo n)
forall n. (Ord n, Read n) => ReadS [NodeInfo n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeInfo n]
$creadListPrec :: forall n. (Ord n, Read n) => ReadPrec [NodeInfo n]
readPrec :: ReadPrec (NodeInfo n)
$creadPrec :: forall n. (Ord n, Read n) => ReadPrec (NodeInfo n)
readList :: ReadS [NodeInfo n]
$creadList :: forall n. (Ord n, Read n) => ReadS [NodeInfo n]
readsPrec :: Int -> ReadS (NodeInfo n)
$creadsPrec :: forall n. (Ord n, Read n) => Int -> ReadS (NodeInfo n)
Read)
data ClusterInfo = CI { ClusterInfo -> Maybe GraphID
parentCluster :: !(Maybe GraphID)
, ClusterInfo -> GlobAttrs
clusterAttrs :: !GlobAttrs
}
deriving (ClusterInfo -> ClusterInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterInfo -> ClusterInfo -> Bool
$c/= :: ClusterInfo -> ClusterInfo -> Bool
== :: ClusterInfo -> ClusterInfo -> Bool
$c== :: ClusterInfo -> ClusterInfo -> Bool
Eq, Eq ClusterInfo
ClusterInfo -> ClusterInfo -> Bool
ClusterInfo -> ClusterInfo -> Ordering
ClusterInfo -> ClusterInfo -> ClusterInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClusterInfo -> ClusterInfo -> ClusterInfo
$cmin :: ClusterInfo -> ClusterInfo -> ClusterInfo
max :: ClusterInfo -> ClusterInfo -> ClusterInfo
$cmax :: ClusterInfo -> ClusterInfo -> ClusterInfo
>= :: ClusterInfo -> ClusterInfo -> Bool
$c>= :: ClusterInfo -> ClusterInfo -> Bool
> :: ClusterInfo -> ClusterInfo -> Bool
$c> :: ClusterInfo -> ClusterInfo -> Bool
<= :: ClusterInfo -> ClusterInfo -> Bool
$c<= :: ClusterInfo -> ClusterInfo -> Bool
< :: ClusterInfo -> ClusterInfo -> Bool
$c< :: ClusterInfo -> ClusterInfo -> Bool
compare :: ClusterInfo -> ClusterInfo -> Ordering
$ccompare :: ClusterInfo -> ClusterInfo -> Ordering
Ord, Int -> ClusterInfo -> ShowS
[ClusterInfo] -> ShowS
ClusterInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterInfo] -> ShowS
$cshowList :: [ClusterInfo] -> ShowS
show :: ClusterInfo -> String
$cshow :: ClusterInfo -> String
showsPrec :: Int -> ClusterInfo -> ShowS
$cshowsPrec :: Int -> ClusterInfo -> ShowS
Show, ReadPrec [ClusterInfo]
ReadPrec ClusterInfo
Int -> ReadS ClusterInfo
ReadS [ClusterInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterInfo]
$creadListPrec :: ReadPrec [ClusterInfo]
readPrec :: ReadPrec ClusterInfo
$creadPrec :: ReadPrec ClusterInfo
readList :: ReadS [ClusterInfo]
$creadList :: ReadS [ClusterInfo]
readsPrec :: Int -> ReadS ClusterInfo
$creadsPrec :: Int -> ReadS ClusterInfo
Read)
type NodeMap n = Map n (NodeInfo n)
type EdgeMap n = Map n [Attributes]
data Context n = Cntxt { forall n. Context n -> n
node :: !n
, forall n. Context n -> Maybe GraphID
inCluster :: !(Maybe GraphID)
, forall n. Context n -> Attributes
attributes :: !Attributes
, forall n. Context n -> [(n, Attributes)]
predecessors :: ![(n, Attributes)]
, forall n. Context n -> [(n, Attributes)]
successors :: ![(n, Attributes)]
}
deriving (Context n -> Context n -> Bool
forall n. Eq n => Context n -> Context n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context n -> Context n -> Bool
$c/= :: forall n. Eq n => Context n -> Context n -> Bool
== :: Context n -> Context n -> Bool
$c== :: forall n. Eq n => Context n -> Context n -> Bool
Eq, Context n -> Context n -> Bool
Context n -> Context n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (Context n)
forall n. Ord n => Context n -> Context n -> Bool
forall n. Ord n => Context n -> Context n -> Ordering
forall n. Ord n => Context n -> Context n -> Context n
min :: Context n -> Context n -> Context n
$cmin :: forall n. Ord n => Context n -> Context n -> Context n
max :: Context n -> Context n -> Context n
$cmax :: forall n. Ord n => Context n -> Context n -> Context n
>= :: Context n -> Context n -> Bool
$c>= :: forall n. Ord n => Context n -> Context n -> Bool
> :: Context n -> Context n -> Bool
$c> :: forall n. Ord n => Context n -> Context n -> Bool
<= :: Context n -> Context n -> Bool
$c<= :: forall n. Ord n => Context n -> Context n -> Bool
< :: Context n -> Context n -> Bool
$c< :: forall n. Ord n => Context n -> Context n -> Bool
compare :: Context n -> Context n -> Ordering
$ccompare :: forall n. Ord n => Context n -> Context n -> Ordering
Ord, Int -> Context n -> ShowS
forall n. Show n => Int -> Context n -> ShowS
forall n. Show n => [Context n] -> ShowS
forall n. Show n => Context n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context n] -> ShowS
$cshowList :: forall n. Show n => [Context n] -> ShowS
show :: Context n -> String
$cshow :: forall n. Show n => Context n -> String
showsPrec :: Int -> Context n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Context n -> ShowS
Show, ReadPrec [Context n]
ReadPrec (Context n)
ReadS [Context n]
forall n. Read n => ReadPrec [Context n]
forall n. Read n => ReadPrec (Context n)
forall n. Read n => Int -> ReadS (Context n)
forall n. Read n => ReadS [Context n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Context n]
$creadListPrec :: forall n. Read n => ReadPrec [Context n]
readPrec :: ReadPrec (Context n)
$creadPrec :: forall n. Read n => ReadPrec (Context n)
readList :: ReadS [Context n]
$creadList :: forall n. Read n => ReadS [Context n]
readsPrec :: Int -> ReadS (Context n)
$creadsPrec :: forall n. Read n => Int -> ReadS (Context n)
Read)
adjacent :: Context n -> [DotEdge n]
adjacent :: forall n. Context n -> [DotEdge n]
adjacent Context n
c = forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) (forall n. Context n -> [(n, Attributes)]
predecessors Context n
c)
forall a. [a] -> [a] -> [a]
++ forall {a} {b} {b}. (a -> b -> b) -> [(a, b)] -> [b]
mapU (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) (forall n. Context n -> [(n, Attributes)]
successors Context n
c)
where
n :: n
n = forall n. Context n -> n
node Context n
c
mapU :: (a -> b -> b) -> [(a, b)] -> [b]
mapU = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
emptyGraph :: DotGraph n
emptyGraph :: forall n. DotGraph n
emptyGraph = DG { strictGraph :: Bool
strictGraph = Bool
False
, directedGraph :: Bool
directedGraph = Bool
True
, graphID :: Maybe GraphID
graphID = forall a. Maybe a
Nothing
, graphAttrs :: GlobAttrs
graphAttrs = GlobAttrs
emptyGA
, clusters :: Map GraphID ClusterInfo
clusters = forall k a. Map k a
M.empty
, values :: NodeMap n
values = forall k a. Map k a
M.empty
}
emptyGA :: GlobAttrs
emptyGA :: GlobAttrs
emptyGA = SAttrs -> SAttrs -> SAttrs -> GlobAttrs
GA forall a. Set a
S.empty forall a. Set a
S.empty forall a. Set a
S.empty
(&) :: (Ord n) => Context n -> DotGraph n -> DotGraph n
(Cntxt n
n Maybe GraphID
mc Attributes
as [(n, Attributes)]
ps [(n, Attributes)]
ss) & :: forall n. Ord n => Context n -> DotGraph n -> DotGraph n
& DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues Map n (NodeInfo n) -> Map n (NodeInfo n)
merge DotGraph n
dg'
where
ps' :: EdgeMap n
ps' = forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ps
ps'' :: [(n, Attributes)]
ps'' = forall n. EdgeMap n -> [(n, Attributes)]
fromMap (forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ps')
ss' :: EdgeMap n
ss' = forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap [(n, Attributes)]
ss
ss'' :: [(n, Attributes)]
ss'' = forall n. EdgeMap n -> [(n, Attributes)]
fromMap (forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
n EdgeMap n
ss')
dg' :: DotGraph n
dg' = forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n Maybe GraphID
mc Attributes
as DotGraph n
dg
merge :: Map n (NodeInfo n) -> Map n (NodeInfo n)
merge = forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev n
n [(n, Attributes)]
ps'' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev n
n [(n, Attributes)]
ss''
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\NodeInfo n
ni -> NodeInfo n
ni { _predecessors :: EdgeMap n
_predecessors = EdgeMap n
ps', _successors :: EdgeMap n
_successors = EdgeMap n
ss' }) n
n
infixr 5 &
composeList :: (Ord n) => [Context n] -> DotGraph n
composeList :: forall n. Ord n => [Context n] -> DotGraph n
composeList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall n. Ord n => Context n -> DotGraph n -> DotGraph n
(&) forall n. DotGraph n
emptyGraph
addSuccRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev :: forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addSuccRev = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSkip forall n. UpdateEdgeMap n
niSucc
addPredRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev :: forall n. Ord n => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addPredRev = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSkip forall n. UpdateEdgeMap n
niPred
addEdgeLinks :: (Ord n) => UpdateEdgeMap n -> UpdateEdgeMap n
-> n -> [(n, Attributes)] -> NodeMap n -> NodeMap n
addEdgeLinks :: forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks UpdateEdgeMap n
fwd UpdateEdgeMap n
rev n
f [(n, Attributes)]
tas = NodeMap n -> NodeMap n
updRev forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeMap n -> NodeMap n
updFwd
where
updFwd :: NodeMap n -> NodeMap n
updFwd = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust NodeInfo n -> NodeInfo n
addFwd n
f
addFwd :: NodeInfo n -> NodeInfo n
addFwd NodeInfo n
ni = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NodeInfo n
ni' (n
t,Attributes
as) -> UpdateEdgeMap n
fwd (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) n
t [Attributes
as]) NodeInfo n
ni') NodeInfo n
ni [(n, Attributes)]
tas
updRev :: NodeMap n -> NodeMap n
updRev NodeMap n
nm = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NodeMap n
nm' (n
t,Attributes
as) -> forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Attributes -> NodeInfo n -> NodeInfo n
addRev Attributes
as) n
t NodeMap n
nm') NodeMap n
nm [(n, Attributes)]
tas
addRev :: Attributes -> NodeInfo n -> NodeInfo n
addRev Attributes
as = UpdateEdgeMap n
rev (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) n
f [Attributes
as])
addNode :: (Ord n)
=> n
-> Maybe GraphID
-> Attributes
-> DotGraph n
-> DotGraph n
addNode :: forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n Maybe GraphID
mc Attributes
as DotGraph n
dg = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mc forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { values :: NodeMap n
values = NodeMap n
ns' }
where
ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
ns' :: NodeMap n
ns' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall n. Ord n => NodeInfo n -> NodeInfo n -> NodeInfo n
mergeLogic n
n (forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as forall k a. Map k a
M.empty forall k a. Map k a
M.empty) NodeMap n
ns
mergeLogic :: NodeInfo n -> NodeInfo n -> NodeInfo n
mergeLogic (NI Maybe GraphID
newClust Attributes
newAttrs EdgeMap n
newPreds EdgeMap n
newSuccs) (NI Maybe GraphID
oldClust Attributes
oldAttrs EdgeMap n
oldPreds EdgeMap n
oldSuccs) =
forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
resClust Attributes
resAttrs EdgeMap n
resPreds EdgeMap n
resSuccs
where
resClust :: Maybe GraphID
resClust = Maybe GraphID
newClust forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe GraphID
oldClust
resAttrs :: Attributes
resAttrs = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union (Attributes -> SAttrs
toSAttr Attributes
newAttrs) (Attributes -> SAttrs
toSAttr Attributes
oldAttrs)
resPreds :: EdgeMap n
resPreds = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) EdgeMap n
newPreds EdgeMap n
oldPreds
resSuccs :: EdgeMap n
resSuccs = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) EdgeMap n
newSuccs EdgeMap n
oldSuccs
addDotNode :: (Ord n) => DotNode n -> DotGraph n -> DotGraph n
addDotNode :: forall n. Ord n => DotNode n -> DotGraph n -> DotGraph n
addDotNode (DotNode n
n Attributes
as) = forall n.
Ord n =>
n -> Maybe GraphID -> Attributes -> DotGraph n -> DotGraph n
addNode n
n forall a. Maybe a
Nothing Attributes
as
addEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge :: forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge n
f n
t Attributes
as = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
merge
where
merge :: NodeMap n -> NodeMap n
merge = forall n.
Ord n =>
UpdateEdgeMap n
-> UpdateEdgeMap n
-> n
-> [(n, Attributes)]
-> NodeMap n
-> NodeMap n
addEdgeLinks forall n. UpdateEdgeMap n
niSucc forall n. UpdateEdgeMap n
niPred n
f [(n
t,Attributes
as)]
addDotEdge :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge :: forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge (DotEdge n
f n
t Attributes
as) = forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
addEdge n
f n
t Attributes
as
addCluster :: GraphID
-> Maybe GraphID
-> [GlobalAttributes]
-> DotGraph n
-> DotGraph n
addCluster :: forall n.
GraphID
-> Maybe GraphID -> [GlobalAttributes] -> DotGraph n -> DotGraph n
addCluster GraphID
c Maybe GraphID
mp [GlobalAttributes]
gas DotGraph n
dg
| GraphID
c forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map GraphID ClusterInfo
cs = forall a. HasCallStack => String -> a
error String
"Cluster already exists in the graph"
| Bool
otherwise = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
mp
forall a b. (a -> b) -> a -> b
$ DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert GraphID
c ClusterInfo
ci Map GraphID ClusterInfo
cs }
where
cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
ci :: ClusterInfo
ci = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
mp forall a b. (a -> b) -> a -> b
$ [GlobalAttributes] -> GlobAttrs
toGlobAttrs [GlobalAttributes]
gas
addEmptyCluster :: Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster :: forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a}. GraphID -> a -> Map GraphID a -> Map GraphID a
`dontReplace` ClusterInfo
defCI))
where
dontReplace :: GraphID -> a -> Map GraphID a -> Map GraphID a
dontReplace = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (forall a b. a -> b -> a
const forall a. a -> a
id)
defCI :: ClusterInfo
defCI = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI forall a. Maybe a
Nothing GlobAttrs
emptyGA
setClusterParent :: GraphID -> Maybe GraphID -> DotGraph n -> DotGraph n
setClusterParent :: forall n. GraphID -> Maybe GraphID -> DotGraph n -> DotGraph n
setClusterParent GraphID
c Maybe GraphID
p = forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setP GraphID
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. DotGraph n -> DotGraph n
addCs
where
addCs :: DotGraph n -> DotGraph n
addCs = forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster Maybe GraphID
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (forall a. a -> Maybe a
Just GraphID
c)
setP :: ClusterInfo -> ClusterInfo
setP ClusterInfo
ci = ClusterInfo
ci { parentCluster :: Maybe GraphID
parentCluster = Maybe GraphID
p }
setClusterAttributes :: GraphID -> [GlobalAttributes]
-> DotGraph n -> DotGraph n
setClusterAttributes :: forall n. GraphID -> [GlobalAttributes] -> DotGraph n -> DotGraph n
setClusterAttributes GraphID
c [GlobalAttributes]
gas = forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ClusterInfo -> ClusterInfo
setAs GraphID
c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Maybe GraphID -> DotGraph n -> DotGraph n
addEmptyCluster (forall a. a -> Maybe a
Just GraphID
c)
where
setAs :: ClusterInfo -> ClusterInfo
setAs ClusterInfo
ci = ClusterInfo
ci { clusterAttrs :: GlobAttrs
clusterAttrs = [GlobalAttributes] -> GlobAttrs
toGlobAttrs [GlobalAttributes]
gas }
mkGraph :: (Ord n) => [DotNode n] -> [DotEdge n] -> DotGraph n
mkGraph :: forall n. Ord n => [DotNode n] -> [DotEdge n] -> DotGraph n
mkGraph [DotNode n]
ns [DotEdge n]
es = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
addDotEdge) [DotEdge n]
es
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Ord n => DotNode n -> DotGraph n -> DotGraph n
addDotNode) forall n. DotGraph n
emptyGraph [DotNode n]
ns
toCanonical :: DotGraph n -> C.DotGraph n
toCanonical :: forall n. DotGraph n -> DotGraph n
toCanonical DotGraph n
dg = C.DotGraph { strictGraph :: Bool
C.strictGraph = forall n. DotGraph n -> Bool
strictGraph DotGraph n
dg
, directedGraph :: Bool
C.directedGraph = forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg
, graphID :: Maybe GraphID
C.graphID = forall n. DotGraph n -> Maybe GraphID
graphID DotGraph n
dg
, graphStatements :: DotStatements n
C.graphStatements = DotStatements n
stmts
}
where
stmts :: DotStatements n
stmts = C.DotStmts { attrStmts :: [GlobalAttributes]
C.attrStmts = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg
, subGraphs :: [DotSubGraph n]
C.subGraphs = [DotSubGraph n]
cs
, nodeStmts :: [DotNode n]
C.nodeStmts = [DotNode n]
ns
, edgeStmts :: [DotEdge n]
C.edgeStmts = forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo Bool
False DotGraph n
dg
}
cls :: Map GraphID ClusterInfo
cls = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
pM :: Map GraphID (Seq GraphID)
pM = forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath' DotGraph n
dg
clustAs :: GraphID -> [GlobalAttributes]
clustAs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClusterInfo -> GlobAttrs
clusterAttrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`Map GraphID ClusterInfo
cls)
lns :: [(n, (Maybe GraphID, Attributes))]
lns = forall a b. (a -> b) -> [a] -> [b]
map (\ (n
n,NodeInfo n
ni) -> (n
n,(forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni, forall n. NodeInfo n -> Attributes
_attributes NodeInfo n
ni)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
([DotSubGraph n]
cs,[DotNode n]
ns) = forall c n a l.
Ord c =>
((n, a) -> NodeCluster c (n, l))
-> (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> [(n, a)]
-> ([DotSubGraph n], [DotNode n])
clustersToNodes forall {a} {b}.
(a, (Maybe GraphID, b)) -> NodeCluster GraphID (a, b)
pathOf (forall a b. a -> b -> a
const Bool
True) forall a. a -> a
id GraphID -> [GlobalAttributes]
clustAs forall a b. (a, b) -> b
snd [(n, (Maybe GraphID, Attributes))]
lns
pathOf :: (a, (Maybe GraphID, b)) -> NodeCluster GraphID (a, b)
pathOf (a
n,(Maybe GraphID
c,b
as)) = forall {a}. Maybe GraphID -> a -> NodeCluster GraphID a
pathFrom Maybe GraphID
c (a
n,b
as)
pathFrom :: Maybe GraphID -> a -> NodeCluster GraphID a
pathFrom Maybe GraphID
c a
ln = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall c a. c -> NodeCluster c a -> NodeCluster c a
C (forall c a. a -> NodeCluster c a
N a
ln) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`Map GraphID (Seq GraphID)
pM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
c
decompose :: (Ord n) => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose :: forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose n
n DotGraph n
dg
| n
n forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` NodeMap n
ns = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Context n
c, DotGraph n
dg')
where
ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
(Just (NI Maybe GraphID
mc Attributes
as EdgeMap n
ps EdgeMap n
ss), NodeMap n
ns') = forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a. Maybe a
Nothing) n
n NodeMap n
ns
c :: Context n
c = forall n.
n
-> Maybe GraphID
-> Attributes
-> [(n, Attributes)]
-> [(n, Attributes)]
-> Context n
Cntxt n
n Maybe GraphID
mc Attributes
as (forall n. EdgeMap n -> [(n, Attributes)]
fromMap forall a b. (a -> b) -> a -> b
$ n
n forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` EdgeMap n
ps) (forall n. EdgeMap n -> [(n, Attributes)]
fromMap EdgeMap n
ss)
dg' :: DotGraph n
dg' = DotGraph n
dg { values :: NodeMap n
values = forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc n
n EdgeMap n
ps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred n
n EdgeMap n
ss forall a b. (a -> b) -> a -> b
$ NodeMap n
ns' }
decomposeAny :: (Ord n) => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny :: forall n. Ord n => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny DotGraph n
dg
| forall n. DotGraph n -> Bool
isEmpty DotGraph n
dg = forall a. Maybe a
Nothing
| Bool
otherwise = forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> (k, a)
M.findMin forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg) DotGraph n
dg
decomposeList :: (Ord n) => DotGraph n -> [Context n]
decomposeList :: forall n. Ord n => DotGraph n -> [Context n]
decomposeList = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall n. Ord n => DotGraph n -> Maybe (Context n, DotGraph n)
decomposeAny
delSucc :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc :: forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc = forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS forall n. UpdateEdgeMap n
niSucc
delPred :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred :: forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred = forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS forall n. UpdateEdgeMap n
niPred
delPS :: (Ord n) => ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS :: forall n.
Ord n =>
((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)
-> n -> EdgeMap n -> NodeMap n -> NodeMap n
delPS (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
fni n
t EdgeMap n
fm NodeMap n
nm = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {k}. Ord k => Map k (NodeInfo n) -> k -> Map k (NodeInfo n)
delE NodeMap n
nm forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys EdgeMap n
fm
where
delE :: Map k (NodeInfo n) -> k -> Map k (NodeInfo n)
delE Map k (NodeInfo n)
nm' k
f = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
fni forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete n
t) k
f Map k (NodeInfo n)
nm'
deleteNode :: (Ord n) => n -> DotGraph n -> DotGraph n
deleteNode :: forall n. Ord n => n -> DotGraph n -> DotGraph n
deleteNode n
n DotGraph n
dg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe DotGraph n
dg forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall n. Ord n => n -> DotGraph n -> Maybe (Context n, DotGraph n)
decompose n
n DotGraph n
dg
deleteAllEdges :: (Ord n) => n -> n -> DotGraph n -> DotGraph n
deleteAllEdges :: forall n. Ord n => n -> n -> DotGraph n -> DotGraph n
deleteAllEdges n
n1 n
n2 = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues (forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delAE n
n1 n
n2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delAE n
n2 n
n1)
where
delAE :: n -> n -> NodeMap n -> NodeMap n
delAE n
f n
t = forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delSucc n
f forall {a}. Map n [a]
t' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> EdgeMap n -> NodeMap n -> NodeMap n
delPred n
f forall {a}. Map n [a]
t'
where
t' :: Map n [a]
t' = forall k a. k -> a -> Map k a
M.singleton n
t []
deleteEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge :: forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge n
n1 n
n2 Attributes
as DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues Map n (NodeInfo n) -> Map n (NodeInfo n)
delEs DotGraph n
dg
where
delE :: n -> n -> Map n (NodeInfo n) -> Map n (NodeInfo n)
delE n
f n
t = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall n. UpdateEdgeMap n
niSucc forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
t) n
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall n. UpdateEdgeMap n
niPred forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. Eq a => a -> [a] -> [a]
delete Attributes
as) n
f) n
t
delEs :: Map n (NodeInfo n) -> Map n (NodeInfo n)
delEs | forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2
| Bool
otherwise = forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n1 n
n2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. Ord n => n -> n -> NodeMap n -> NodeMap n
delE n
n2 n
n1
deleteDotEdge :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n
deleteDotEdge :: forall n. Ord n => DotEdge n -> DotGraph n -> DotGraph n
deleteDotEdge (DotEdge n
n1 n
n2 Attributes
as) = forall n. Ord n => n -> n -> Attributes -> DotGraph n -> DotGraph n
deleteEdge n
n1 n
n2 Attributes
as
deleteCluster :: GraphID -> DotGraph n -> DotGraph n
deleteCluster :: forall n. GraphID -> DotGraph n -> DotGraph n
deleteCluster GraphID
c DotGraph n
dg = forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues (forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {n}. NodeInfo n -> NodeInfo n
adjNode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters (forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> ClusterInfo
adjCluster forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete GraphID
c)
forall a b. (a -> b) -> a -> b
$ DotGraph n
dg
where
p :: Maybe GraphID
p = ClusterInfo -> Maybe GraphID
parentCluster forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GraphID
c forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
adjParent :: Maybe GraphID -> Maybe GraphID
adjParent Maybe GraphID
p'
| Maybe GraphID
p' forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just GraphID
c = Maybe GraphID
p
| Bool
otherwise = Maybe GraphID
p'
adjNode :: NodeInfo n -> NodeInfo n
adjNode NodeInfo n
ni = NodeInfo n
ni { _inCluster :: Maybe GraphID
_inCluster = Maybe GraphID -> Maybe GraphID
adjParent forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni }
adjCluster :: ClusterInfo -> ClusterInfo
adjCluster ClusterInfo
ci = ClusterInfo
ci { parentCluster :: Maybe GraphID
parentCluster = Maybe GraphID -> Maybe GraphID
adjParent forall a b. (a -> b) -> a -> b
$ ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci }
removeEmptyClusters :: DotGraph n -> DotGraph n
removeEmptyClusters :: forall {n}. DotGraph n -> DotGraph n
removeEmptyClusters DotGraph n
dg = DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = Map GraphID ClusterInfo
cM' }
where
cM :: Map GraphID ClusterInfo
cM = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
cM' :: Map GraphID ClusterInfo
cM' = (Map GraphID ClusterInfo
cM forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map GraphID [GraphID]
invCs) forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map GraphID [n]
invNs
invCs :: Map GraphID [GraphID]
invCs = forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> Maybe GraphID
parentCluster Map GraphID ClusterInfo
cM
invNs :: Map GraphID [n]
invNs = forall {b}. Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall n. NodeInfo n -> Maybe GraphID
_inCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
usedClustsIn :: Map b (Maybe GraphID) -> Map GraphID [b]
usedClustsIn = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs
isEmpty :: DotGraph n -> Bool
isEmpty :: forall n. DotGraph n -> Bool
isEmpty = forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> NodeMap n
values
hasClusters :: DotGraph n -> Bool
hasClusters :: forall n. DotGraph n -> Bool
hasClusters = forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Map GraphID ClusterInfo
clusters
isEmptyGraph :: DotGraph n -> Bool
isEmptyGraph :: forall n. DotGraph n -> Bool
isEmptyGraph = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) forall n. DotGraph n -> Bool
isEmpty (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Bool
hasClusters)
graphAttributes :: DotGraph n -> [GlobalAttributes]
graphAttributes :: forall n. DotGraph n -> [GlobalAttributes]
graphAttributes = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> GlobAttrs
graphAttrs
foundInCluster :: (Ord n) => DotGraph n -> n -> Maybe GraphID
foundInCluster :: forall n. Ord n => DotGraph n -> n -> Maybe GraphID
foundInCluster DotGraph n
dg n
n = forall n. NodeInfo n -> Maybe GraphID
_inCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n
attributesOf :: (Ord n) => DotGraph n -> n -> Attributes
attributesOf :: forall n. Ord n => DotGraph n -> n -> Attributes
attributesOf DotGraph n
dg n
n = forall n. NodeInfo n -> Attributes
_attributes forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n
predecessorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]
predecessorsOf :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
predecessorsOf DotGraph n
dg n
t
| forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_predecessors forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
t
| Bool
otherwise = forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
t
successorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]
successorsOf :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
successorsOf DotGraph n
dg n
f
| forall n. DotGraph n -> Bool
directedGraph DotGraph n
dg = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_successors forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
f
| Bool
otherwise = forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
f
adjacentTo :: (Ord n) => DotGraph n -> n -> [DotEdge n]
adjacentTo :: forall n. Ord n => DotGraph n -> n -> [DotEdge n]
adjacentTo DotGraph n
dg n
n = [DotEdge n]
sucs forall a. [a] -> [a] -> [a]
++ [DotEdge n]
preds
where
ni :: NodeInfo n
ni = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! n
n
sucs :: [DotEdge n]
sucs = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
n) forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_successors NodeInfo n
ni
preds :: [DotEdge n]
preds = forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE (forall n. n -> n -> Attributes -> DotEdge n
`DotEdge` n
n) forall a b. (a -> b) -> a -> b
$ n
n forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` forall n. NodeInfo n -> EdgeMap n
_predecessors NodeInfo n
ni
emToDE :: (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE :: forall n.
(n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n]
emToDE n -> Attributes -> DotEdge n
f = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry n -> Attributes -> DotEdge n
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. EdgeMap n -> [(n, Attributes)]
fromMap
parentOf :: DotGraph n -> GraphID -> Maybe GraphID
parentOf :: forall n. DotGraph n -> GraphID -> Maybe GraphID
parentOf DotGraph n
dg GraphID
c = ClusterInfo -> Maybe GraphID
parentCluster forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! GraphID
c
clusterAttributes :: DotGraph n -> GraphID -> [GlobalAttributes]
clusterAttributes :: forall n. DotGraph n -> GraphID -> [GlobalAttributes]
clusterAttributes DotGraph n
dg GraphID
c = GlobAttrs -> [GlobalAttributes]
fromGlobAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClusterInfo -> GlobAttrs
clusterAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg forall k a. Ord k => Map k a -> k -> a
M.! GraphID
c
instance (Ord n) => DotRepr DotGraph n where
fromCanonical :: DotGraph n -> DotGraph n
fromCanonical = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr
getID :: DotGraph n -> Maybe GraphID
getID = forall n. DotGraph n -> Maybe GraphID
graphID
setID :: GraphID -> DotGraph n -> DotGraph n
setID GraphID
i DotGraph n
g = DotGraph n
g { graphID :: Maybe GraphID
graphID = forall a. a -> Maybe a
Just GraphID
i }
graphIsDirected :: DotGraph n -> Bool
graphIsDirected = forall n. DotGraph n -> Bool
directedGraph
setIsDirected :: Bool -> DotGraph n -> DotGraph n
setIsDirected Bool
d DotGraph n
g = DotGraph n
g { directedGraph :: Bool
directedGraph = Bool
d }
graphIsStrict :: DotGraph n -> Bool
graphIsStrict = forall n. DotGraph n -> Bool
strictGraph
setStrictness :: Bool -> DotGraph n -> DotGraph n
setStrictness Bool
s DotGraph n
g = DotGraph n
g { strictGraph :: Bool
strictGraph = Bool
s }
mapDotGraph :: forall n'.
DotRepr DotGraph n' =>
(n -> n') -> DotGraph n -> DotGraph n'
mapDotGraph = forall n' n. Ord n' => (n -> n') -> DotGraph n -> DotGraph n'
mapNs
graphStructureInformation :: DotGraph n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation = forall n. DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo
nodeInformation :: Bool -> DotGraph n -> NodeLookup n
nodeInformation = forall n. Bool -> DotGraph n -> NodeLookup n
getNodeInfo
edgeInformation :: Bool -> DotGraph n -> [DotEdge n]
edgeInformation = forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo
unAnonymise :: DotGraph n -> DotGraph n
unAnonymise = forall a. a -> a
id
instance (Ord n) => G.FromGeneralisedDot DotGraph n where
fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr
instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n
instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n
instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n
instance (PrintDot n) => PrintDot (DotGraph n) where
unqtDot :: DotGraph n -> DotCode
unqtDot = forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotGraph n
toCanonical
instance (Ord n, ParseDot n) => ParseDot (DotGraph n) where
parseUnqt :: Parse (DotGraph n)
parseUnqt = DotGraph n -> DotGraph n
fromGDot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
where
fromGDot :: DotGraph n -> DotGraph n
fromGDot = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a -> a
`asTypeOf` (forall a. HasCallStack => a
undefined :: G.DotGraph n))
parse :: Parse (DotGraph n)
parse = forall a. ParseDot a => Parse a
parseUnqt
cOptions :: CanonicaliseOptions
cOptions :: CanonicaliseOptions
cOptions = COpts { edgesInClusters :: Bool
edgesInClusters = Bool
False
, groupAttributes :: Bool
groupAttributes = Bool
True
}
fromDotRepr :: (DotRepr dg n) => dg n -> DotGraph n
fromDotRepr :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
fromDotRepr = forall n. Ord n => DotGraph n -> DotGraph n
unsafeFromCanonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n.
DotRepr dg n =>
CanonicaliseOptions -> dg n -> DotGraph n
canonicaliseOptions CanonicaliseOptions
cOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (dg :: * -> *) n. DotRepr dg n => dg n -> dg n
unAnonymise
unsafeFromCanonical :: (Ord n) => C.DotGraph n -> DotGraph n
unsafeFromCanonical :: forall n. Ord n => DotGraph n -> DotGraph n
unsafeFromCanonical DotGraph n
dg = DG { strictGraph :: Bool
strictGraph = forall n. DotGraph n -> Bool
C.strictGraph DotGraph n
dg
, directedGraph :: Bool
directedGraph = Bool
dirGraph
, graphAttrs :: GlobAttrs
graphAttrs = GlobAttrs
as
, graphID :: Maybe GraphID
graphID = Maybe GraphID
mgid
, clusters :: Map GraphID ClusterInfo
clusters = Map GraphID ClusterInfo
cs
, values :: NodeMap n
values = NodeMap n
ns
}
where
stmts :: DotStatements n
stmts = forall n. DotGraph n -> DotStatements n
C.graphStatements DotGraph n
dg
mgid :: Maybe GraphID
mgid = forall n. DotGraph n -> Maybe GraphID
C.graphID DotGraph n
dg
dirGraph :: Bool
dirGraph = forall n. DotGraph n -> Bool
C.directedGraph DotGraph n
dg
(GlobAttrs
as, Map GraphID ClusterInfo
cs, NodeMap n
ns) = Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt forall a. Maybe a
Nothing DotStatements n
stmts
fCStmt :: Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt Maybe GraphID
p DotStatements n
stmts' = (GlobAttrs
sgAs, Map GraphID ClusterInfo
cs', NodeMap n
ns')
where
sgAs :: GlobAttrs
sgAs = [GlobalAttributes] -> GlobAttrs
toGlobAttrs forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
C.attrStmts DotStatements n
stmts'
(Map GraphID ClusterInfo
cs', NodeMap n
sgNs) = (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID
-> DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n)
fCSG Maybe GraphID
p) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
C.subGraphs DotStatements n
stmts'
nNs :: NodeMap n
nNs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Maybe GraphID -> DotNode n -> (n, NodeInfo n)
fDN Maybe GraphID
p) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotNode n]
C.nodeStmts DotStatements n
stmts'
ns' :: NodeMap n
ns' = NodeMap n
sgNs forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` NodeMap n
nNs
fCSG :: Maybe GraphID
-> DotSubGraph n -> (Map GraphID ClusterInfo, NodeMap n)
fCSG Maybe GraphID
p DotSubGraph n
sg = (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert GraphID
sgid ClusterInfo
ci Map GraphID ClusterInfo
cs', NodeMap n
ns')
where
msgid :: Maybe GraphID
msgid@(Just GraphID
sgid) = forall n. DotSubGraph n -> Maybe GraphID
C.subGraphID DotSubGraph n
sg
(GlobAttrs
as', Map GraphID ClusterInfo
cs', NodeMap n
ns') = Maybe GraphID
-> DotStatements n
-> (GlobAttrs, Map GraphID ClusterInfo, NodeMap n)
fCStmt Maybe GraphID
msgid forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
C.subGraphStmts DotSubGraph n
sg
ci :: ClusterInfo
ci = Maybe GraphID -> GlobAttrs -> ClusterInfo
CI Maybe GraphID
p GlobAttrs
as'
fDN :: Maybe GraphID -> DotNode n -> (n, NodeInfo n)
fDN Maybe GraphID
p (DotNode n
n Attributes
as') = ( n
n
, NI { _inCluster :: Maybe GraphID
_inCluster = Maybe GraphID
p
, _attributes :: Attributes
_attributes = Attributes
as'
, _predecessors :: EdgeMap n
_predecessors = forall {k} {k} {a}. Ord k => k -> Map k (Map k a) -> Map k a
eSel n
n Map n (EdgeMap n)
tEs
, _successors :: EdgeMap n
_successors = forall {k} {k} {a}. Ord k => k -> Map k (Map k a) -> Map k a
eSel n
n Map n (EdgeMap n)
fEs
}
)
es :: [DotEdge n]
es = forall n. DotStatements n -> [DotEdge n]
C.edgeStmts DotStatements n
stmts
fEs :: Map n (EdgeMap n)
fEs = forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap forall n. DotEdge n -> n
fromNode forall n. DotEdge n -> n
toNode [DotEdge n]
es
tEs :: Map n (EdgeMap n)
tEs = forall {a}. Map n (Map n a) -> Map n (Map n a)
delLoops forall a b. (a -> b) -> a -> b
$ forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap forall n. DotEdge n -> n
toNode forall n. DotEdge n -> n
fromNode [DotEdge n]
es
eSel :: k -> Map k (Map k a) -> Map k a
eSel k
n Map k (Map k a)
es' = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ k
n forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map k (Map k a)
es'
delLoops :: Map n (Map n a) -> Map n (Map n a)
delLoops = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey forall k a. Ord k => k -> Map k a -> Map k a
M.delete
toEdgeMap :: (Ord n) => (DotEdge n -> n) -> (DotEdge n -> n) -> [DotEdge n]
-> Map n (EdgeMap n)
toEdgeMap :: forall n.
Ord n =>
(DotEdge n -> n)
-> (DotEdge n -> n) -> [DotEdge n] -> Map n (EdgeMap n)
toEdgeMap DotEdge n -> n
f DotEdge n -> n
t = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {c}. [(n, c)] -> Map n [c]
eM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy DotEdge n -> n
f DotEdge n -> (n, Attributes)
t'
where
t' :: DotEdge n -> (n, Attributes)
t' = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) DotEdge n -> n
t forall n. DotEdge n -> Attributes
edgeAttributes
eM :: [(n, c)] -> Map n [c]
eM = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd
mapNs :: (Ord n') => (n -> n') -> DotGraph n -> DotGraph n'
mapNs :: forall n' n. Ord n' => (n -> n') -> DotGraph n -> DotGraph n'
mapNs n -> n'
f (DG Bool
st Bool
d GlobAttrs
as Maybe GraphID
mid Map GraphID ClusterInfo
cs NodeMap n
vs) = forall n.
Bool
-> Bool
-> GlobAttrs
-> Maybe GraphID
-> Map GraphID ClusterInfo
-> NodeMap n
-> DotGraph n
DG Bool
st Bool
d GlobAttrs
as Maybe GraphID
mid Map GraphID ClusterInfo
cs
forall a b. (a -> b) -> a -> b
$ NodeMap n -> Map n' (NodeInfo n')
mapNM NodeMap n
vs
where
mapNM :: NodeMap n -> Map n' (NodeInfo n')
mapNM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map NodeInfo n -> NodeInfo n'
mapNI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Map n a -> Map n' a
mpM
mapNI :: NodeInfo n -> NodeInfo n'
mapNI (NI Maybe GraphID
mc Attributes
as' EdgeMap n
ps EdgeMap n
ss) = forall n.
Maybe GraphID -> Attributes -> EdgeMap n -> EdgeMap n -> NodeInfo n
NI Maybe GraphID
mc Attributes
as' (forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ps) (forall {a}. Map n a -> Map n' a
mpM EdgeMap n
ss)
mpM :: Map n a -> Map n' a
mpM = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys n -> n'
f
getGraphInfo :: DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo :: forall n. DotGraph n -> (GlobalAttributes, ClusterLookup)
getGraphInfo DotGraph n
dg = (GlobalAttributes
gas, ClusterLookup
cl)
where
toGA :: SAttrs -> GlobalAttributes
toGA = Attributes -> GlobalAttributes
GraphAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
(GlobalAttributes
gas, Map GraphID GlobalAttributes
cgs) = (SAttrs -> GlobalAttributes
toGA forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b k. (a -> b) -> Map k a -> Map k b
M.map SAttrs -> GlobalAttributes
toGA) forall a b. (a -> b) -> a -> b
$ forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
graphAs DotGraph n
dg
pM :: Map (Maybe GraphID) (Seq (Maybe GraphID))
pM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a}. Seq a -> Seq a
pInit forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg
cl :: ClusterLookup
cl = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey forall {b}. Maybe GraphID -> b -> ([Seq (Maybe GraphID)], b)
addPath forall a b. (a -> b) -> a -> b
$ forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic forall a. a -> Maybe a
Just Map GraphID GlobalAttributes
cgs
addPath :: Maybe GraphID -> b -> ([Seq (Maybe GraphID)], b)
addPath Maybe GraphID
c b
as = ( forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Maybe GraphID
c forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe GraphID) (Seq (Maybe GraphID))
pM
, b
as
)
pInit :: Seq a -> Seq a
pInit Seq a
p = case forall a. Seq a -> ViewR a
Seq.viewr Seq a
p of
(Seq a
p' Seq.:> a
_) -> Seq a
p'
ViewR a
_ -> forall a. Seq a
Seq.empty
getNodeInfo :: Bool -> DotGraph n -> NodeLookup n
getNodeInfo :: forall n. Bool -> DotGraph n -> NodeLookup n
getNodeInfo Bool
withGlob DotGraph n
dg = forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {n}. NodeInfo n -> (Seq (Maybe GraphID), Attributes)
toLookup NodeMap n
ns
where
(SAttrs
gGlob, Map GraphID SAttrs
aM) = forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
nodeAs DotGraph n
dg
pM :: Map (Maybe GraphID) (Seq (Maybe GraphID))
pM = forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath DotGraph n
dg
ns :: NodeMap n
ns = forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
toLookup :: NodeInfo n -> (Seq (Maybe GraphID), Attributes)
toLookup NodeInfo n
ni = (Seq (Maybe GraphID)
pth, Attributes
as')
where
as :: Attributes
as = forall n. NodeInfo n -> Attributes
_attributes NodeInfo n
ni
mp :: Maybe GraphID
mp = forall n. NodeInfo n -> Maybe GraphID
_inCluster NodeInfo n
ni
pth :: Seq (Maybe GraphID)
pth = forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ Maybe GraphID
mp forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe GraphID) (Seq (Maybe GraphID))
pM
pAs :: SAttrs
pAs = forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
mp
as' :: Attributes
as' | Bool
withGlob = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
pAs
| Bool
otherwise = Attributes
as
getEdgeInfo :: Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo :: forall n. Bool -> DotGraph n -> [DotEdge n]
getEdgeInfo Bool
withGlob DotGraph n
dg = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {n}. n -> (n, [Attributes]) -> [DotEdge n]
mkDotEdges) [(n, (n, [Attributes]))]
es
where
gGlob :: SAttrs
gGlob = GlobAttrs -> SAttrs
edgeAs forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg
es :: [(n, (n, [Attributes]))]
es = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall k a. Map k a -> [(k, a)]
M.assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NodeInfo n -> EdgeMap n
_successors)
forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg
addGlob :: Attributes -> Attributes
addGlob Attributes
as
| Bool
withGlob = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ Attributes -> SAttrs
toSAttr Attributes
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
gGlob
| Bool
otherwise = Attributes
as
mkDotEdges :: n -> (n, [Attributes]) -> [DotEdge n]
mkDotEdges n
f (n
t, [Attributes]
ass) = forall a b. (a -> b) -> [a] -> [b]
map (forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f n
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attributes
addGlob) [Attributes]
ass
globAttrMap :: (GlobAttrs -> SAttrs) -> DotGraph n
-> (SAttrs, Map GraphID SAttrs)
globAttrMap :: forall n.
(GlobAttrs -> SAttrs) -> DotGraph n -> (SAttrs, Map GraphID SAttrs)
globAttrMap GlobAttrs -> SAttrs
af DotGraph n
dg = (SAttrs
gGlob, Map GraphID SAttrs
aM)
where
gGlob :: SAttrs
gGlob = GlobAttrs -> SAttrs
af forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> GlobAttrs
graphAttrs DotGraph n
dg
cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
aM :: Map GraphID SAttrs
aM = forall a b k. (a -> b) -> Map k a -> Map k b
M.map ClusterInfo -> SAttrs
attrsFor Map GraphID ClusterInfo
cs
attrsFor :: ClusterInfo -> SAttrs
attrsFor ClusterInfo
ci = SAttrs
as forall a. Ord a => Set a -> Set a -> Set a
`S.union` SAttrs
pAs
where
as :: SAttrs
as = GlobAttrs -> SAttrs
af forall a b. (a -> b) -> a -> b
$ ClusterInfo -> GlobAttrs
clusterAttrs ClusterInfo
ci
p :: Maybe GraphID
p = ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci
pAs :: SAttrs
pAs = forall a. a -> Maybe a -> a
fromMaybe SAttrs
gGlob forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID SAttrs
aM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
p
clusterPath :: DotGraph n -> Map (Maybe GraphID) St.Path
clusterPath :: forall n. DotGraph n -> Map (Maybe GraphID) (Seq (Maybe GraphID))
clusterPath = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath'
clusterPath' :: DotGraph n -> Map GraphID (Seq.Seq GraphID)
clusterPath' :: forall n. DotGraph n -> Map GraphID (Seq GraphID)
clusterPath' DotGraph n
dg = Map GraphID (Seq GraphID)
pM
where
cs :: Map GraphID ClusterInfo
cs = forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg
pM :: Map GraphID (Seq GraphID)
pM = forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey GraphID -> ClusterInfo -> Seq GraphID
pathOf Map GraphID ClusterInfo
cs
pathOf :: GraphID -> ClusterInfo -> Seq GraphID
pathOf GraphID
c ClusterInfo
ci = Seq GraphID
pPth forall a. Seq a -> a -> Seq a
Seq.|> GraphID
c
where
mp :: Maybe GraphID
mp = ClusterInfo -> Maybe GraphID
parentCluster ClusterInfo
ci
pPth :: Seq GraphID
pPth = forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map GraphID (Seq GraphID)
pM) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe GraphID
mp
withValues :: (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues :: forall n. (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n
withValues NodeMap n -> NodeMap n
f DotGraph n
dg = DotGraph n
dg { values :: NodeMap n
values = NodeMap n -> NodeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> NodeMap n
values DotGraph n
dg }
withClusters :: (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters :: forall n.
(Map GraphID ClusterInfo -> Map GraphID ClusterInfo)
-> DotGraph n -> DotGraph n
withClusters Map GraphID ClusterInfo -> Map GraphID ClusterInfo
f DotGraph n
dg = DotGraph n
dg { clusters :: Map GraphID ClusterInfo
clusters = Map GraphID ClusterInfo -> Map GraphID ClusterInfo
f forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Map GraphID ClusterInfo
clusters DotGraph n
dg }
toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs :: [GlobalAttributes] -> GlobAttrs
toGlobAttrs = (Attributes, Attributes, Attributes) -> GlobAttrs
mkGA forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalAttributes] -> (Attributes, Attributes, Attributes)
partitionGlobal
where
mkGA :: (Attributes, Attributes, Attributes) -> GlobAttrs
mkGA (Attributes
ga,Attributes
na,Attributes
ea) = SAttrs -> SAttrs -> SAttrs -> GlobAttrs
GA (Attributes -> SAttrs
toSAttr Attributes
ga) (Attributes -> SAttrs
toSAttr Attributes
na) (Attributes -> SAttrs
toSAttr Attributes
ea)
fromGlobAttrs :: GlobAttrs -> [GlobalAttributes]
fromGlobAttrs :: GlobAttrs -> [GlobalAttributes]
fromGlobAttrs (GA SAttrs
ga SAttrs
na SAttrs
ea) = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAttributes -> Attributes
attrs)
[ Attributes -> GlobalAttributes
GraphAttrs forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
ga
, Attributes -> GlobalAttributes
NodeAttrs forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
na
, Attributes -> GlobalAttributes
EdgeAttrs forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes
unSame SAttrs
ea
]
type UpdateEdgeMap n = (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n
niSucc :: UpdateEdgeMap n
niSucc :: forall n. UpdateEdgeMap n
niSucc EdgeMap n -> EdgeMap n
f NodeInfo n
ni = NodeInfo n
ni { _successors :: EdgeMap n
_successors = EdgeMap n -> EdgeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_successors NodeInfo n
ni }
niPred :: UpdateEdgeMap n
niPred :: forall n. UpdateEdgeMap n
niPred EdgeMap n -> EdgeMap n
f NodeInfo n
ni = NodeInfo n
ni { _predecessors :: EdgeMap n
_predecessors = EdgeMap n -> EdgeMap n
f forall a b. (a -> b) -> a -> b
$ forall n. NodeInfo n -> EdgeMap n
_predecessors NodeInfo n
ni }
niSkip :: UpdateEdgeMap n
niSkip :: forall n. UpdateEdgeMap n
niSkip EdgeMap n -> EdgeMap n
_ NodeInfo n
ni = NodeInfo n
ni
toMap :: (Ord n) => [(n, Attributes)] -> EdgeMap n
toMap :: forall n. Ord n => [(n, Attributes)] -> EdgeMap n
toMap = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd
fromMap :: EdgeMap n -> [(n, Attributes)]
fromMap :: forall n. EdgeMap n -> [(n, Attributes)]
fromMap = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList