{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.GraphViz.Types.State
   Description : Create lookups for 'Attribute's.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module provides functions to assist with building 'Attribute'
   lookups.
-}
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 { forall a. StateValue a -> SAttrs
globalAttrs :: SAttrs
                       , forall a. StateValue a -> Bool
useGlobals  :: Bool
                       , forall a. StateValue a -> Path
globalPath  :: Path
                       , forall a. StateValue a -> a
value       :: a
                       }
                  deriving (StateValue a -> StateValue a -> Bool
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, StateValue a -> StateValue a -> Bool
StateValue a -> StateValue a -> 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 {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
Ord, Int -> StateValue a -> ShowS
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)
ReadS [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)

-- | The path of clusters that must be traversed to reach this spot.
type Path = Seq (Maybe GraphID)

modifyGlobal   :: (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal :: forall s. (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal SAttrs -> SAttrs
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 :: forall s. (s -> s) -> GVState s ()
modifyValue s -> s
f = 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 :: forall s. Attributes -> GVState s ()
addGlobals Attributes
as = do Bool
addG <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. StateValue a -> Bool
useGlobals
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addG forall a b. (a -> b) -> a -> b
$ forall s. (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal (SAttrs -> Attributes -> SAttrs
`unionWith` Attributes
as)

getGlobals :: GVState s SAttrs
getGlobals :: forall s. GVState s SAttrs
getGlobals = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. StateValue a -> SAttrs
globalAttrs

getPath :: GVState s Path
getPath :: forall s. GVState s Path
getPath = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. StateValue a -> Path
globalPath

modifyPath   :: (Path -> Path) -> GVState s ()
modifyPath :: forall s. (Path -> Path) -> GVState s ()
modifyPath Path -> Path
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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}

-- When calling recursively, back-up and restore the global attrs
-- since they shouldn't change.
--
-- Outer Maybe: Nothing for subgraphs, Just for clusters
recursiveCall      :: Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall :: forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall Maybe (Maybe GraphID)
mc GVState s ()
s = do SAttrs
gas <- forall s. GVState s SAttrs
getGlobals
                        Path
p   <- forall s. GVState s Path
getPath
                        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall s. (Path -> Path) -> GVState s ()
modifyPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Seq a -> a -> Seq a
(|>)) Maybe (Maybe GraphID)
mc
                        GVState s ()
s
                        forall s. (SAttrs -> SAttrs) -> GVState s ()
modifyGlobal (forall a b. a -> b -> a
const SAttrs
gas)
                        forall s. (Path -> Path) -> GVState s ()
modifyPath (forall a b. a -> b -> a
const Path
p)

unionWith        :: SAttrs -> Attributes -> SAttrs
unionWith :: SAttrs -> Attributes -> SAttrs
unionWith SAttrs
sas Attributes
as = Attributes -> SAttrs
toSAttr Attributes
as forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
sas

-- -----------------------------------------------------------------------------
-- Dealing with sub-graphs

type GraphState a = GVState ClusterLookup' a

-- | The available information for each cluster; the @['Path']@
--   denotes all locations where that particular cluster is located
--   (more than one location can indicate possible problems).
type ClusterLookup = Map (Maybe GraphID) ([Path], GlobalAttributes)

type ClusterLookup' = Map (Maybe GraphID) ClusterInfo

type ClusterInfo = (DList Path, SAttrs)

getGraphInfo :: GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo :: forall a. GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo = ((SAttrs -> GlobalAttributes
graphGlobal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StateValue a -> SAttrs
globalAttrs) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall {k}.
Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StateValue a -> a
value))
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. State s a -> s -> s
`execState` forall {k} {a}. StateValue (Map k a)
initState)
  where
    convert :: Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
convert = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([Path] -> [Path]
uniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DList.toList) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByClusters forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
    graphGlobal :: SAttrs -> GlobalAttributes
graphGlobal = Attributes -> GlobalAttributes
GraphAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Attribute -> Bool
usedByGraphs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAttrs -> Attributes
unSame
    initState :: StateValue (Map k a)
initState = forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV forall a. Set a
Set.empty Bool
True forall a. Seq a
Seq.empty forall k a. Map k a
Map.empty
    uniq :: [Path] -> [Path]
uniq = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList

mergeCInfos          :: ClusterInfo -> ClusterInfo -> ClusterInfo
mergeCInfos :: (DList Path, SAttrs)
-> (DList Path, SAttrs) -> (DList Path, SAttrs)
mergeCInfos (DList Path
p1,SAttrs
as1) = forall a. DList a -> DList a -> DList a
DList.append DList Path
p1 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** 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 Maybe (Maybe GraphID)
Nothing    Path
_ SAttrs
_  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
addCluster (Just Maybe GraphID
gid) Path
p SAttrs
as = forall s. (s -> s) -> GVState s ()
modifyValue forall a b. (a -> b) -> a -> b
$ 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 = (forall a. a -> DList a
DList.singleton Path
p, SAttrs
as)

-- Use this instead of recursiveCall
addSubGraph           :: Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph :: forall a. Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph Maybe (Maybe GraphID)
mid GraphState a
cntns = do Path
pth <- forall s. GVState s Path
getPath -- Want path before we add it...
                           forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall Maybe (Maybe GraphID)
mid forall a b. (a -> b) -> a -> b
$ do GraphState a
cntns
                                                  -- But want attrs after we
                                                  -- finish it.
                                                  SAttrs
gas <- 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 Attributes
as) = forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addGraphGlobals GlobalAttributes
_               = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- -----------------------------------------------------------------------------
-- Dealing with DotNodes

-- | The available information on each 'DotNode' (both explicit and implicit).
type NodeLookup n = Map n (Path, Attributes)

type NodeLookup' n = Map n NodeInfo

data NodeInfo = NI { NodeInfo -> SAttrs
atts     :: SAttrs
                   , NodeInfo -> SAttrs
gAtts    :: SAttrs -- from globals
                   , NodeInfo -> Path
location :: Path
                   }
              deriving (NodeInfo -> NodeInfo -> Bool
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
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
Ord, Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> String
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]
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 :: forall n. NodeLookup n -> [DotNode n]
toDotNodes = forall a b. (a -> b) -> [a] -> [b]
map (\(n
n,(Path
_,Attributes
as)) -> forall n. n -> Attributes -> DotNode n
DotNode n
n Attributes
as) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.assocs

getNodeLookup       :: Bool -> NodeState n a -> NodeLookup n
getNodeLookup :: forall n a. Bool -> NodeState n a -> NodeLookup n
getNodeLookup Bool
addGs = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map NodeInfo -> (Path, Attributes)
combine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StateValue a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. State s a -> s -> s
`execState` forall {k} {a}. StateValue (Map k a)
initState)
  where
    initState :: StateValue (Map k a)
initState = forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV forall a. Set a
Set.empty Bool
addGs forall a. Seq a
Seq.empty forall k a. Map k a
Map.empty
    combine :: NodeInfo -> (Path, Attributes)
combine NodeInfo
ni = (NodeInfo -> Path
location NodeInfo
ni, SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ NodeInfo -> SAttrs
atts NodeInfo
ni forall a. Ord a => Set a -> Set a -> Set a
`Set.union` NodeInfo -> SAttrs
gAtts NodeInfo
ni)

-- New -> Old -> Inserted
--
-- For specific attributes, newer one takes precedence; for global
-- attributes and path, older one takes precedence.
mergeNInfos :: NodeInfo -> NodeInfo -> NodeInfo
mergeNInfos :: NodeInfo -> NodeInfo -> NodeInfo
mergeNInfos (NI SAttrs
a1 SAttrs
ga1 Path
p1) (NI SAttrs
a2 SAttrs
ga2 Path
p2) = SAttrs -> SAttrs -> Path -> NodeInfo
NI (SAttrs
a1 forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
a2)
                                                -- old one takes precendence
                                               (SAttrs
ga2 forall a. Ord a => Set a -> Set a -> Set a
`Set.union` SAttrs
ga1)
                                                -- old one takes precendence
                                               (Path -> Path -> Path
mergePs Path
p2 Path
p1)

-- | If one 'Path' is a prefix of another, then take the longer one;
--   otherwise, take the first 'Path'.
mergePs :: Path -> Path -> Path
mergePs :: Path -> Path -> Path
mergePs Path
p1 Path
p2 = Path -> Path -> Path
mrg' Path
p1 Path
p2
  where
    mrg' :: Path -> Path -> Path
mrg' = ViewL (Maybe GraphID) -> ViewL (Maybe GraphID) -> Path
mrg forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Seq a -> ViewL a
Seq.viewl
    mrg :: ViewL (Maybe GraphID) -> ViewL (Maybe GraphID) -> Path
mrg ViewL (Maybe GraphID)
EmptyL      ViewL (Maybe GraphID)
_           = Path
p2
    mrg ViewL (Maybe GraphID)
_           ViewL (Maybe GraphID)
EmptyL      = Path
p1
    mrg (Maybe GraphID
c1 :< Path
p1') (Maybe GraphID
c2 :< Path
p2')
      | Maybe GraphID
c1 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 :: forall n. GlobalAttributes -> NodeState n ()
addNodeGlobals (NodeAttrs Attributes
as) = forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addNodeGlobals GlobalAttributes
_              = forall (m :: * -> *) a. Monad m => a -> m a
return ()

mergeNode            :: (Ord n) => n -> Attributes -> SAttrs -> Path
                        -> NodeState n ()
mergeNode :: forall n.
Ord n =>
n -> Attributes -> SAttrs -> Path -> NodeState n ()
mergeNode n
n Attributes
as SAttrs
gas Path
p = forall s. (s -> s) -> GVState s ()
modifyValue forall a b. (a -> b) -> a -> b
$ 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 :: forall n. Ord n => DotNode n -> NodeState n ()
addNode (DotNode n
n Attributes
as) = do SAttrs
gas <- forall s. GVState s SAttrs
getGlobals
                            Path
p <- forall s. GVState s Path
getPath
                            -- insertWith takes func (new -> old -> inserted)
                            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 :: forall n. Ord n => DotEdge n -> NodeState n ()
addEdgeNodes (DotEdge n
f n
t Attributes
_) = do SAttrs
gas <- forall s. GVState s SAttrs
getGlobals
                                  Path
p <- forall s. GVState s Path
getPath
                                  forall {n}. Ord n => n -> SAttrs -> Path -> NodeState n ()
addEN n
f SAttrs
gas Path
p
                                  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 = forall n.
Ord n =>
n -> Attributes -> SAttrs -> Path -> NodeState n ()
mergeNode n
n []

-- -----------------------------------------------------------------------------
-- Dealing with DotEdges

type EdgeState n a = GVState (DList (DotEdge n)) a

getDotEdges       :: Bool -> EdgeState n a -> [DotEdge n]
getDotEdges :: forall n a. Bool -> EdgeState n a -> [DotEdge n]
getDotEdges Bool
addGs = forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StateValue a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. State s a -> s -> s
`execState` forall {a}. StateValue (DList a)
initState)
  where
    initState :: StateValue (DList a)
initState = forall a. SAttrs -> Bool -> Path -> a -> StateValue a
SV forall a. Set a
Set.empty Bool
addGs forall a. Seq a
Seq.empty forall a. DList a
DList.empty

addEdgeGlobals                :: GlobalAttributes -> EdgeState n ()
addEdgeGlobals :: forall n. GlobalAttributes -> EdgeState n ()
addEdgeGlobals (EdgeAttrs Attributes
as) = forall s. Attributes -> GVState s ()
addGlobals Attributes
as
addEdgeGlobals GlobalAttributes
_              = forall (m :: * -> *) a. Monad m => a -> m a
return ()

addEdge :: DotEdge n -> EdgeState n ()
addEdge :: forall n. DotEdge n -> EdgeState n ()
addEdge de :: DotEdge n
de@DotEdge{edgeAttributes :: forall n. DotEdge n -> Attributes
edgeAttributes = Attributes
as}
  = do SAttrs
gas <- forall s. GVState s SAttrs
getGlobals
       let de' :: DotEdge n
de' = DotEdge n
de { edgeAttributes :: Attributes
edgeAttributes = SAttrs -> Attributes
unSame forall a b. (a -> b) -> a -> b
$ SAttrs -> Attributes -> SAttrs
unionWith SAttrs
gas Attributes
as }
       forall s. (s -> s) -> GVState s ()
modifyValue forall a b. (a -> b) -> a -> b
$ (forall a. DList a -> a -> DList a
`DList.snoc` DotEdge n
de')