{-# OPTIONS_HADDOCK hide #-}
module Data.GraphViz.Types.State
( Path
, recursiveCall
, GraphState
, ClusterLookup
, getGraphInfo
, addSubGraph
, addGraphGlobals
, NodeState
, NodeLookup
, getNodeLookup
, toDotNodes
, addNodeGlobals
, addNode
, addEdgeNodes
, EdgeState
, getDotEdges
, addEdgeGlobals
, addEdge
) where
import Data.GraphViz.Attributes.Complete (Attributes, usedByClusters,
usedByGraphs)
import Data.GraphViz.Attributes.Same
import Data.GraphViz.Types.Internal.Common
import Control.Arrow ((&&&), (***))
import Control.Monad (when)
import Control.Monad.State (State, execState, gets, modify)
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Function (on)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq, ViewL(..), (|>))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
type GVState s a = State (StateValue s) a
data StateValue a = SV { StateValue a -> SAttrs
globalAttrs :: SAttrs
, StateValue a -> Bool
useGlobals :: Bool
, StateValue a -> Path
globalPath :: Path
, StateValue a -> a
value :: a
}
deriving (StateValue a -> StateValue a -> Bool
(StateValue a -> StateValue a -> Bool)
-> (StateValue a -> StateValue a -> Bool) -> Eq (StateValue a)
forall a. Eq a => StateValue a -> StateValue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateValue a -> StateValue a -> Bool
$c/= :: forall a. Eq a => StateValue a -> StateValue a -> Bool
== :: StateValue a -> StateValue a -> Bool
$c== :: forall a. Eq a => StateValue a -> StateValue a -> Bool
Eq, Eq (StateValue a)
Eq (StateValue a) =>
(StateValue a -> StateValue a -> Ordering)
-> (StateValue a -> StateValue a -> Bool)
-> (StateValue a -> StateValue a -> Bool)
-> (StateValue a -> StateValue a -> Bool)
-> (StateValue a -> StateValue a -> Bool)
-> (StateValue a -> StateValue a -> StateValue a)
-> (StateValue a -> StateValue a -> StateValue a)
-> Ord (StateValue a)
StateValue a -> StateValue a -> Bool
StateValue a -> StateValue a -> Ordering
StateValue a -> StateValue a -> StateValue a
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 a. Ord a => Eq (StateValue a)
forall a. Ord a => StateValue a -> StateValue a -> Bool
forall a. Ord a => StateValue a -> StateValue a -> Ordering
forall a. Ord a => StateValue a -> StateValue a -> StateValue a
min :: StateValue a -> StateValue a -> StateValue a
$cmin :: forall a. Ord a => StateValue a -> StateValue a -> StateValue a
max :: StateValue a -> StateValue a -> StateValue a
$cmax :: forall a. Ord a => StateValue a -> StateValue a -> StateValue a
>= :: StateValue a -> StateValue a -> Bool
$c>= :: forall a. Ord a => StateValue a -> StateValue a -> Bool
> :: StateValue a -> StateValue a -> Bool
$c> :: forall a. Ord a => StateValue a -> StateValue a -> Bool
<= :: StateValue a -> StateValue a -> Bool
$c<= :: forall a. Ord a => StateValue a -> StateValue a -> Bool
< :: StateValue a -> StateValue a -> Bool
$c< :: forall a. Ord a => StateValue a -> StateValue a -> Bool
compare :: StateValue a -> StateValue a -> Ordering
$ccompare :: forall a. Ord a => StateValue a -> StateValue a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (StateValue a)
Ord, Int -> StateValue a -> ShowS
[StateValue a] -> ShowS
StateValue a -> String
(Int -> StateValue a -> ShowS)
-> (StateValue a -> String)
-> ([StateValue a] -> ShowS)
-> Show (StateValue a)
forall a. Show a => Int -> StateValue a -> ShowS
forall a. Show a => [StateValue a] -> ShowS
forall a. Show a => StateValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateValue a] -> ShowS
$cshowList :: forall a. Show a => [StateValue a] -> ShowS
show :: StateValue a -> String
$cshow :: forall a. Show a => StateValue a -> String
showsPrec :: Int -> StateValue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StateValue a -> ShowS
Show, ReadPrec [StateValue a]
ReadPrec (StateValue a)
Int -> ReadS (StateValue a)
ReadS [StateValue a]
(Int -> ReadS (StateValue a))
-> ReadS [StateValue a]
-> ReadPrec (StateValue a)
-> ReadPrec [StateValue a]
-> Read (StateValue a)
forall a. Read a => ReadPrec [StateValue a]
forall a. Read a => ReadPrec (StateValue a)
forall a. Read a => Int -> ReadS (StateValue a)
forall a. Read a => ReadS [StateValue a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StateValue a]
$creadListPrec :: forall a. Read a => ReadPrec [StateValue a]
readPrec :: ReadPrec (StateValue a)
$creadPrec :: forall a. Read a => ReadPrec (StateValue a)
readList :: ReadS [StateValue a]
$creadList :: forall a. Read a => ReadS [StateValue a]
readsPrec :: Int -> ReadS (StateValue a)
$creadsPrec :: forall a. Read a => Int -> ReadS (StateValue a)
Read)
type Path = Seq (Maybe GraphID)
modifyGlobal :: (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal :: (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal f :: SAttrs -> SAttrs
f = (StateValue s -> StateValue s) -> GVState s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify StateValue s -> StateValue s
forall a. StateValue a -> StateValue a
f'
where
f' :: StateValue a -> StateValue a
f' sv :: StateValue a
sv@(SV{globalAttrs :: forall a. StateValue a -> SAttrs
globalAttrs = SAttrs
gas}) = StateValue a
sv{globalAttrs :: SAttrs
globalAttrs = SAttrs -> SAttrs
f SAttrs
gas}
modifyValue :: (s -> s) -> GVState s ()
modifyValue :: (s -> s) -> GVState s ()
modifyValue f :: s -> s
f = (StateValue s -> StateValue s) -> GVState s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify StateValue s -> StateValue s
f'
where
f' :: StateValue s -> StateValue s
f' sv :: StateValue s
sv@(SV{value :: forall a. StateValue a -> a
value = s
s}) = StateValue s
sv{value :: s
value = s -> s
f s
s}
addGlobals :: Attributes -> GVState s ()
addGlobals :: Attributes -> GVState s ()
addGlobals as :: Attributes
as = do Bool
addG <- (StateValue s -> Bool) -> StateT (StateValue s) Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets StateValue s -> Bool
forall a. StateValue a -> Bool
useGlobals
Bool -> GVState s () -> GVState s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addG (GVState s () -> GVState s ()) -> GVState s () -> GVState s ()
forall a b. (a -> b) -> a -> b
$ (SAttrs -> SAttrs) -> GVState s ()
forall s. (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal (SAttrs -> Attributes -> SAttrs
`unionWith` Attributes
as)
getGlobals :: GVState s SAttrs
getGlobals :: GVState s SAttrs
getGlobals = (StateValue s -> SAttrs) -> GVState s SAttrs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets StateValue s -> SAttrs
forall a. StateValue a -> SAttrs
globalAttrs
getPath :: GVState s Path
getPath :: GVState s Path
getPath = (StateValue s -> Path) -> GVState s Path
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets StateValue s -> Path
forall a. StateValue a -> Path
globalPath
modifyPath :: (Path -> Path) -> GVState s ()
modifyPath :: (Path -> Path) -> GVState s ()
modifyPath f :: Path -> Path
f = (StateValue s -> StateValue s) -> GVState s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify StateValue s -> StateValue s
forall a. StateValue a -> StateValue a
f'
where
f' :: StateValue a -> StateValue a
f' sv :: StateValue a
sv@(SV{globalPath :: forall a. StateValue a -> Path
globalPath = Path
p}) = StateValue a
sv{globalPath :: Path
globalPath = Path -> Path
f Path
p}
recursiveCall :: Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall :: Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall mc :: Maybe (Maybe GraphID)
mc s :: GVState s ()
s = do SAttrs
gas <- GVState s SAttrs
forall s. GVState s SAttrs
getGlobals
Path
p <- GVState s Path
forall s. GVState s Path
getPath
GVState s ()
-> (Maybe GraphID -> GVState s ())
-> Maybe (Maybe GraphID)
-> GVState s ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> GVState s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((Path -> Path) -> GVState s ()
forall s. (Path -> Path) -> GVState s ()
modifyPath ((Path -> Path) -> GVState s ())
-> (Maybe GraphID -> Path -> Path) -> Maybe GraphID -> GVState s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Maybe GraphID -> Path) -> Maybe GraphID -> Path -> Path
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Maybe GraphID -> Path
forall a. Seq a -> a -> Seq a
(|>)) Maybe (Maybe GraphID)
mc
GVState s ()
s
(SAttrs -> SAttrs) -> GVState s ()
forall s. (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal (SAttrs -> SAttrs -> SAttrs
forall a b. a -> b -> a
const SAttrs
gas)
(Path -> Path) -> GVState s ()
forall s. (Path -> Path) -> GVState s ()
modifyPath (Path -> Path -> Path
forall a b. a -> b -> a
const Path
p)
unionWith :: SAttrs -> Attributes -> SAttrs
unionWith :: SAttrs -> Attributes -> SAttrs
unionWith sas :: SAttrs
sas as :: Attributes
as = Attributes -> SAttrs
toSAttr Attributes
as SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
sas
type GraphState a = GVState ClusterLookup' a
type ClusterLookup = Map (Maybe GraphID) ([Path], GlobalAttributes)
type ClusterLookup' = Map (Maybe GraphID) ClusterInfo
type ClusterInfo = (DList Path, SAttrs)
getGraphInfo :: GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo :: GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo = ((SAttrs -> GlobalAttributes
graphGlobal (SAttrs -> GlobalAttributes)
-> (StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> SAttrs)
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> GlobalAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateValue (Map (Maybe GraphID) (DList Path, SAttrs)) -> SAttrs
forall a. StateValue a -> SAttrs
globalAttrs) (StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> GlobalAttributes)
-> (StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> ClusterLookup)
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> (GlobalAttributes, ClusterLookup)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Map (Maybe GraphID) (DList Path, SAttrs) -> ClusterLookup
forall k.
Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
convert (Map (Maybe GraphID) (DList Path, SAttrs) -> ClusterLookup)
-> (StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> Map (Maybe GraphID) (DList Path, SAttrs))
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> ClusterLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> Map (Maybe GraphID) (DList Path, SAttrs)
forall a. StateValue a -> a
value))
(StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> (GlobalAttributes, ClusterLookup))
-> (GraphState a
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs)))
-> GraphState a
-> (GlobalAttributes, ClusterLookup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphState a
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
-> StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
forall s a. State s a -> s -> s
`execState` StateValue (Map (Maybe GraphID) (DList Path, SAttrs))
forall k a. StateValue (Map k a)
initState)
where
convert :: Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
convert = ((DList Path, SAttrs) -> ([Path], GlobalAttributes))
-> Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([Path] -> [Path]
uniq ([Path] -> [Path])
-> (DList Path -> [Path]) -> DList Path -> [Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList Path -> [Path]
forall a. DList a -> [a]
DList.toList) (DList Path -> [Path])
-> (SAttrs -> GlobalAttributes)
-> (DList Path, SAttrs)
-> ([Path], GlobalAttributes)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** SAttrs -> GlobalAttributes
toGlobal)
toGlobal :: SAttrs -> GlobalAttributes
toGlobal = Attributes -> GlobalAttributes
GraphAttrs (Attributes -> GlobalAttributes)
-> (SAttrs -> Attributes) -> SAttrs -> GlobalAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Bool) -> Attributes -> Attributes
forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByClusters (Attributes -> Attributes)
-> (SAttrs -> Attributes) -> SAttrs -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
graphGlobal :: SAttrs -> GlobalAttributes
graphGlobal = Attributes -> GlobalAttributes
GraphAttrs (Attributes -> GlobalAttributes)
-> (SAttrs -> Attributes) -> SAttrs -> GlobalAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Bool) -> Attributes -> Attributes
forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByGraphs (Attributes -> Attributes)
-> (SAttrs -> Attributes) -> SAttrs -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
initState :: StateValue (Map k a)
initState = SAttrs -> Bool -> Path -> Map k a -> StateValue (Map k a)
forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV SAttrs
forall a. Set a
Set.empty Bool
True Path
forall a. Seq a
Seq.empty Map k a
forall k a. Map k a
Map.empty
uniq :: [Path] -> [Path]
uniq = Set Path -> [Path]
forall a. Set a -> [a]
Set.toList (Set Path -> [Path]) -> ([Path] -> Set Path) -> [Path] -> [Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path] -> Set Path
forall a. Ord a => [a] -> Set a
Set.fromList
mergeCInfos :: ClusterInfo -> ClusterInfo -> ClusterInfo
mergeCInfos :: (DList Path, SAttrs)
-> (DList Path, SAttrs) -> (DList Path, SAttrs)
mergeCInfos (p1 :: DList Path
p1,as1 :: SAttrs
as1) = DList Path -> DList Path -> DList Path
forall a. DList a -> DList a -> DList a
DList.append DList Path
p1 (DList Path -> DList Path)
-> (SAttrs -> SAttrs)
-> (DList Path, SAttrs)
-> (DList Path, SAttrs)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
Set.union SAttrs
as1
addCluster :: Maybe (Maybe GraphID) -> Path -> SAttrs
-> GraphState ()
addCluster :: Maybe (Maybe GraphID) -> Path -> SAttrs -> GraphState ()
addCluster Nothing _ _ = () -> GraphState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addCluster (Just gid :: Maybe GraphID
gid) p :: Path
p as :: SAttrs
as = (Map (Maybe GraphID) (DList Path, SAttrs)
-> Map (Maybe GraphID) (DList Path, SAttrs))
-> GraphState ()
forall s. (s -> s) -> GVState s ()
modifyValue ((Map (Maybe GraphID) (DList Path, SAttrs)
-> Map (Maybe GraphID) (DList Path, SAttrs))
-> GraphState ())
-> (Map (Maybe GraphID) (DList Path, SAttrs)
-> Map (Maybe GraphID) (DList Path, SAttrs))
-> GraphState ()
forall a b. (a -> b) -> a -> b
$ ((DList Path, SAttrs)
-> (DList Path, SAttrs) -> (DList Path, SAttrs))
-> Maybe GraphID
-> (DList Path, SAttrs)
-> Map (Maybe GraphID) (DList Path, SAttrs)
-> Map (Maybe GraphID) (DList Path, SAttrs)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (DList Path, SAttrs)
-> (DList Path, SAttrs) -> (DList Path, SAttrs)
mergeCInfos Maybe GraphID
gid (DList Path, SAttrs)
ci
where
ci :: (DList Path, SAttrs)
ci = (Path -> DList Path
forall a. a -> DList a
DList.singleton Path
p, SAttrs
as)
addSubGraph :: Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph :: Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph mid :: Maybe (Maybe GraphID)
mid cntns :: GraphState a
cntns = do Path
pth <- GVState (Map (Maybe GraphID) (DList Path, SAttrs)) Path
forall s. GVState s Path
getPath
Maybe (Maybe GraphID) -> GraphState () -> GraphState ()
forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall Maybe (Maybe GraphID)
mid (GraphState () -> GraphState ()) -> GraphState () -> GraphState ()
forall a b. (a -> b) -> a -> b
$ do GraphState a
cntns
SAttrs
gas <- GVState (Map (Maybe GraphID) (DList Path, SAttrs)) SAttrs
forall s. GVState s SAttrs
getGlobals
Maybe (Maybe GraphID) -> Path -> SAttrs -> GraphState ()
addCluster Maybe (Maybe GraphID)
mid Path
pth SAttrs
gas
addGraphGlobals :: GlobalAttributes -> GraphState ()
addGraphGlobals :: GlobalAttributes -> GraphState ()
addGraphGlobals (GraphAttrs as :: Attributes
as) = Attributes -> GraphState ()
forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addGraphGlobals _ = () -> GraphState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
type NodeLookup n = Map n (Path, Attributes)
type NodeLookup' n = Map n NodeInfo
data NodeInfo = NI { NodeInfo -> SAttrs
atts :: SAttrs
, NodeInfo -> SAttrs
gAtts :: SAttrs
, NodeInfo -> Path
location :: Path
}
deriving (NodeInfo -> NodeInfo -> Bool
(NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfo -> NodeInfo -> Bool
$c/= :: NodeInfo -> NodeInfo -> Bool
== :: NodeInfo -> NodeInfo -> Bool
$c== :: NodeInfo -> NodeInfo -> Bool
Eq, Eq NodeInfo
Eq NodeInfo =>
(NodeInfo -> NodeInfo -> Ordering)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> NodeInfo)
-> (NodeInfo -> NodeInfo -> NodeInfo)
-> Ord NodeInfo
NodeInfo -> NodeInfo -> Bool
NodeInfo -> NodeInfo -> Ordering
NodeInfo -> NodeInfo -> NodeInfo
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 :: NodeInfo -> NodeInfo -> NodeInfo
$cmin :: NodeInfo -> NodeInfo -> NodeInfo
max :: NodeInfo -> NodeInfo -> NodeInfo
$cmax :: NodeInfo -> NodeInfo -> NodeInfo
>= :: NodeInfo -> NodeInfo -> Bool
$c>= :: NodeInfo -> NodeInfo -> Bool
> :: NodeInfo -> NodeInfo -> Bool
$c> :: NodeInfo -> NodeInfo -> Bool
<= :: NodeInfo -> NodeInfo -> Bool
$c<= :: NodeInfo -> NodeInfo -> Bool
< :: NodeInfo -> NodeInfo -> Bool
$c< :: NodeInfo -> NodeInfo -> Bool
compare :: NodeInfo -> NodeInfo -> Ordering
$ccompare :: NodeInfo -> NodeInfo -> Ordering
$cp1Ord :: Eq NodeInfo
Ord, Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> String
(Int -> NodeInfo -> ShowS)
-> (NodeInfo -> String) -> ([NodeInfo] -> ShowS) -> Show NodeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo] -> ShowS
$cshowList :: [NodeInfo] -> ShowS
show :: NodeInfo -> String
$cshow :: NodeInfo -> String
showsPrec :: Int -> NodeInfo -> ShowS
$cshowsPrec :: Int -> NodeInfo -> ShowS
Show, ReadPrec [NodeInfo]
ReadPrec NodeInfo
Int -> ReadS NodeInfo
ReadS [NodeInfo]
(Int -> ReadS NodeInfo)
-> ReadS [NodeInfo]
-> ReadPrec NodeInfo
-> ReadPrec [NodeInfo]
-> Read NodeInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeInfo]
$creadListPrec :: ReadPrec [NodeInfo]
readPrec :: ReadPrec NodeInfo
$creadPrec :: ReadPrec NodeInfo
readList :: ReadS [NodeInfo]
$creadList :: ReadS [NodeInfo]
readsPrec :: Int -> ReadS NodeInfo
$creadsPrec :: Int -> ReadS NodeInfo
Read)
type NodeState n a = GVState (NodeLookup' n) a
toDotNodes :: NodeLookup n -> [DotNode n]
toDotNodes :: NodeLookup n -> [DotNode n]
toDotNodes = ((n, (Path, Attributes)) -> DotNode n)
-> [(n, (Path, Attributes))] -> [DotNode n]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: n
n,(_,as :: Attributes
as)) -> n -> Attributes -> DotNode n
forall n. n -> Attributes -> DotNode n
DotNode n
n Attributes
as) ([(n, (Path, Attributes))] -> [DotNode n])
-> (NodeLookup n -> [(n, (Path, Attributes))])
-> NodeLookup n
-> [DotNode n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLookup n -> [(n, (Path, Attributes))]
forall k a. Map k a -> [(k, a)]
Map.assocs
getNodeLookup :: Bool -> NodeState n a -> NodeLookup n
getNodeLookup :: Bool -> NodeState n a -> NodeLookup n
getNodeLookup addGs :: Bool
addGs = (NodeInfo -> (Path, Attributes)) -> Map n NodeInfo -> NodeLookup n
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map NodeInfo -> (Path, Attributes)
combine (Map n NodeInfo -> NodeLookup n)
-> (NodeState n a -> Map n NodeInfo)
-> NodeState n a
-> NodeLookup n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateValue (Map n NodeInfo) -> Map n NodeInfo
forall a. StateValue a -> a
value (StateValue (Map n NodeInfo) -> Map n NodeInfo)
-> (NodeState n a -> StateValue (Map n NodeInfo))
-> NodeState n a
-> Map n NodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeState n a
-> StateValue (Map n NodeInfo) -> StateValue (Map n NodeInfo)
forall s a. State s a -> s -> s
`execState` StateValue (Map n NodeInfo)
forall k a. StateValue (Map k a)
initState)
where
initState :: StateValue (Map k a)
initState = SAttrs -> Bool -> Path -> Map k a -> StateValue (Map k a)
forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV SAttrs
forall a. Set a
Set.empty Bool
addGs Path
forall a. Seq a
Seq.empty Map k a
forall k a. Map k a
Map.empty
combine :: NodeInfo -> (Path, Attributes)
combine ni :: NodeInfo
ni = (NodeInfo -> Path
location NodeInfo
ni, SAttrs -> Attributes
unSame (SAttrs -> Attributes) -> SAttrs -> Attributes
forall a b. (a -> b) -> a -> b
$ NodeInfo -> SAttrs
atts NodeInfo
ni SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` NodeInfo -> SAttrs
gAtts NodeInfo
ni)
mergeNInfos :: NodeInfo -> NodeInfo -> NodeInfo
mergeNInfos :: NodeInfo -> NodeInfo -> NodeInfo
mergeNInfos (NI a1 :: SAttrs
a1 ga1 :: SAttrs
ga1 p1 :: Path
p1) (NI a2 :: SAttrs
a2 ga2 :: SAttrs
ga2 p2 :: Path
p2) = SAttrs -> SAttrs -> Path -> NodeInfo
NI (SAttrs
a1 SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
a2)
(SAttrs
ga2 SAttrs -> SAttrs -> SAttrs
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
ga1)
(Path -> Path -> Path
mergePs Path
p2 Path
p1)
mergePs :: Path -> Path -> Path
mergePs :: Path -> Path -> Path
mergePs p1 :: Path
p1 p2 :: Path
p2 = Path -> Path -> Path
mrg' Path
p1 Path
p2
where
mrg' :: Path -> Path -> Path
mrg' = ViewL (Maybe GraphID) -> ViewL (Maybe GraphID) -> Path
mrg (ViewL (Maybe GraphID) -> ViewL (Maybe GraphID) -> Path)
-> (Path -> ViewL (Maybe GraphID)) -> Path -> Path -> Path
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Path -> ViewL (Maybe GraphID)
forall a. Seq a -> ViewL a
Seq.viewl
mrg :: ViewL (Maybe GraphID) -> ViewL (Maybe GraphID) -> Path
mrg EmptyL _ = Path
p2
mrg _ EmptyL = Path
p1
mrg (c1 :: Maybe GraphID
c1 :< p1' :: Path
p1') (c2 :: Maybe GraphID
c2 :< p2' :: Path
p2')
| Maybe GraphID
c1 Maybe GraphID -> Maybe GraphID -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe GraphID
c2 = Path -> Path -> Path
mrg' Path
p1' Path
p2'
| Bool
otherwise = Path
p1
addNodeGlobals :: GlobalAttributes -> NodeState n ()
addNodeGlobals :: GlobalAttributes -> NodeState n ()
addNodeGlobals (NodeAttrs as :: Attributes
as) = Attributes -> NodeState n ()
forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addNodeGlobals _ = () -> NodeState n ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mergeNode :: (Ord n) => n -> Attributes -> SAttrs -> Path
-> NodeState n ()
mergeNode :: n -> Attributes -> SAttrs -> Path -> NodeState n ()
mergeNode n :: n
n as :: Attributes
as gas :: SAttrs
gas p :: Path
p = (Map n NodeInfo -> Map n NodeInfo) -> NodeState n ()
forall s. (s -> s) -> GVState s ()
modifyValue ((Map n NodeInfo -> Map n NodeInfo) -> NodeState n ())
-> (Map n NodeInfo -> Map n NodeInfo) -> NodeState n ()
forall a b. (a -> b) -> a -> b
$ (NodeInfo -> NodeInfo -> NodeInfo)
-> n -> NodeInfo -> Map n NodeInfo -> Map n NodeInfo
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NodeInfo -> NodeInfo -> NodeInfo
mergeNInfos n
n NodeInfo
ni
where
ni :: NodeInfo
ni = SAttrs -> SAttrs -> Path -> NodeInfo
NI (Attributes -> SAttrs
toSAttr Attributes
as) SAttrs
gas Path
p
addNode :: (Ord n) => DotNode n -> NodeState n ()
addNode :: DotNode n -> NodeState n ()
addNode (DotNode n :: n
n as :: Attributes
as) = do SAttrs
gas <- GVState (NodeLookup' n) SAttrs
forall s. GVState s SAttrs
getGlobals
Path
p <- GVState (NodeLookup' n) Path
forall s. GVState s Path
getPath
n -> Attributes -> SAttrs -> Path -> NodeState n ()
forall n.
Ord n =>
n -> Attributes -> SAttrs -> Path -> NodeState n ()
mergeNode n
n Attributes
as SAttrs
gas Path
p
addEdgeNodes :: (Ord n) => DotEdge n -> NodeState n ()
addEdgeNodes :: DotEdge n -> NodeState n ()
addEdgeNodes (DotEdge f :: n
f t :: n
t _) = do SAttrs
gas <- GVState (NodeLookup' n) SAttrs
forall s. GVState s SAttrs
getGlobals
Path
p <- GVState (NodeLookup' n) Path
forall s. GVState s Path
getPath
n -> SAttrs -> Path -> NodeState n ()
forall n. Ord n => n -> SAttrs -> Path -> NodeState n ()
addEN n
f SAttrs
gas Path
p
n -> SAttrs -> Path -> NodeState n ()
forall n. Ord n => n -> SAttrs -> Path -> NodeState n ()
addEN n
t SAttrs
gas Path
p
where
addEN :: n -> SAttrs -> Path -> NodeState n ()
addEN n :: n
n = n -> Attributes -> SAttrs -> Path -> NodeState n ()
forall n.
Ord n =>
n -> Attributes -> SAttrs -> Path -> NodeState n ()
mergeNode n
n []
type EdgeState n a = GVState (DList (DotEdge n)) a
getDotEdges :: Bool -> EdgeState n a -> [DotEdge n]
getDotEdges :: Bool -> EdgeState n a -> [DotEdge n]
getDotEdges addGs :: Bool
addGs = DList (DotEdge n) -> [DotEdge n]
forall a. DList a -> [a]
DList.toList (DList (DotEdge n) -> [DotEdge n])
-> (EdgeState n a -> DList (DotEdge n))
-> EdgeState n a
-> [DotEdge n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateValue (DList (DotEdge n)) -> DList (DotEdge n)
forall a. StateValue a -> a
value (StateValue (DList (DotEdge n)) -> DList (DotEdge n))
-> (EdgeState n a -> StateValue (DList (DotEdge n)))
-> EdgeState n a
-> DList (DotEdge n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EdgeState n a
-> StateValue (DList (DotEdge n)) -> StateValue (DList (DotEdge n))
forall s a. State s a -> s -> s
`execState` StateValue (DList (DotEdge n))
forall a. StateValue (DList a)
initState)
where
initState :: StateValue (DList a)
initState = SAttrs -> Bool -> Path -> DList a -> StateValue (DList a)
forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV SAttrs
forall a. Set a
Set.empty Bool
addGs Path
forall a. Seq a
Seq.empty DList a
forall a. DList a
DList.empty
addEdgeGlobals :: GlobalAttributes -> EdgeState n ()
addEdgeGlobals :: GlobalAttributes -> EdgeState n ()
addEdgeGlobals (EdgeAttrs as :: Attributes
as) = Attributes -> EdgeState n ()
forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addEdgeGlobals _ = () -> EdgeState n ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addEdge :: DotEdge n -> EdgeState n ()
addEdge :: DotEdge n -> EdgeState n ()
addEdge de :: DotEdge n
de@DotEdge{edgeAttributes :: forall n. DotEdge n -> Attributes
edgeAttributes = Attributes
as}
= do SAttrs
gas <- GVState (DList (DotEdge n)) SAttrs
forall s. GVState s SAttrs
getGlobals
let de' :: DotEdge n
de' = DotEdge n
de { edgeAttributes :: Attributes
edgeAttributes = SAttrs -> Attributes
unSame (SAttrs -> Attributes) -> SAttrs -> Attributes
forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes -> SAttrs
unionWith SAttrs
gas Attributes
as }
(DList (DotEdge n) -> DList (DotEdge n)) -> EdgeState n ()
forall s. (s -> s) -> GVState s ()
modifyValue ((DList (DotEdge n) -> DList (DotEdge n)) -> EdgeState n ())
-> (DList (DotEdge n) -> DList (DotEdge n)) -> EdgeState n ()
forall a b. (a -> b) -> a -> b
$ (DList (DotEdge n) -> DotEdge n -> DList (DotEdge n)
forall a. DList a -> a -> DList a
`DList.snoc` DotEdge n
de')