    {-# 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
    (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
    $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
    /= :: 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
    $ccompare :: forall a. Ord a => StateValue a -> StateValue a -> Ordering
    compare :: StateValue a -> StateValue a -> Ordering
    $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
    >= :: StateValue a -> StateValue a -> Bool
    $cmax :: forall a. Ord a => StateValue a -> StateValue a -> StateValue a
    max :: StateValue a -> StateValue a -> StateValue a
    $cmin :: forall a. Ord a => StateValue a -> StateValue a -> StateValue a
    min :: StateValue a -> StateValue a -> 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
    $cshowsPrec :: forall a. Show a => Int -> StateValue a -> ShowS
    showsPrec :: Int -> StateValue a -> ShowS
    $cshow :: forall a. Show a => StateValue a -> String
    show :: StateValue a -> String
    $cshowList :: forall a. Show a => [StateValue a] -> ShowS
    showList :: [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
    $creadsPrec :: forall a. Read a => Int -> ReadS (StateValue a)
    readsPrec :: Int -> ReadS (StateValue a)
    $creadList :: forall a. Read a => ReadS [StateValue a]
    readList :: ReadS [StateValue a]
    $creadPrec :: forall a. Read a => ReadPrec (StateValue a)
    readPrec :: ReadPrec (StateValue a)
    $creadListPrec :: forall a. Read a => ReadPrec [StateValue a]
    readListPrec :: ReadPrec [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 = (StateValue s -> StateValue s) -> StateT (StateValue s) Identity ()
    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 = f gas}

    modifyValue   :: (s -> s) -> GVState s ()
    modifyValue :: forall s. (s -> s) -> GVState s ()
    modifyValue s -> s
    f = (StateValue s -> StateValue s) -> StateT (StateValue s) Identity ()
    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 = f s}

    addGlobals    :: Attributes -> GVState s ()
    addGlobals :: forall s. Attributes -> GVState s ()
    addGlobals Attributes
    as = do 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
                       when addG $ modifyGlobal (`unionWith` as)

    getGlobals :: GVState s SAttrs
    getGlobals :: forall s. GVState s SAttrs
    getGlobals = (StateValue s -> SAttrs) -> StateT (StateValue s) Identity 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 :: forall s. GVState s Path
    getPath = (StateValue s -> Path) -> StateT (StateValue s) Identity 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 :: forall s. (Path -> Path) -> GVState s ()
    modifyPath Path -> Path
    f = (StateValue s -> StateValue s) -> StateT (StateValue s) Identity ()
    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 = f 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 gas <- GVState s SAttrs
    forall s. GVState s SAttrs
    getGlobals
                            p   <- getPath
                            maybe (return ()) (modifyPath . flip (|>)) mc
                            s
                            modifyGlobal (const gas)
                            modifyPath (const p)

    unionWith        :: SAttrs -> Attributes -> SAttrs
    unionWith :: SAttrs -> Attributes -> SAttrs
    unionWith SAttrs
    sas Attributes
    as = Attributes -> SAttrs
    toSAttr Attributes
    as SAttrs -> SAttrs -> SAttrs
    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 (SAttrs -> GlobalAttributes)
    -> (StateValue ClusterLookup' -> SAttrs)
    -> StateValue ClusterLookup'
    -> GlobalAttributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateValue ClusterLookup' -> SAttrs
    forall a. StateValue a -> SAttrs
    globalAttrs) (StateValue ClusterLookup' -> GlobalAttributes)
    -> (StateValue ClusterLookup' -> ClusterLookup)
    -> StateValue ClusterLookup'
    -> (GlobalAttributes, ClusterLookup)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (ClusterLookup' -> ClusterLookup
    forall {k}.
    Map k (DList Path, SAttrs) -> Map k ([Path], GlobalAttributes)
    convert (ClusterLookup' -> ClusterLookup)
    -> (StateValue ClusterLookup' -> ClusterLookup')
    -> StateValue ClusterLookup'
    -> ClusterLookup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateValue ClusterLookup' -> ClusterLookup'
    forall a. StateValue a -> a
    value))
                   (StateValue ClusterLookup' -> (GlobalAttributes, ClusterLookup))
    -> (GraphState a -> StateValue ClusterLookup')
    -> GraphState a
    -> (GlobalAttributes, ClusterLookup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GraphState a
    -> StateValue ClusterLookup' -> StateValue ClusterLookup'
    forall s a. State s a -> s -> s
    `execState` StateValue ClusterLookup'
    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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** SAttrs -> GlobalAttributes
    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 (DList Path
    p1,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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** SAttrs -> 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 Maybe (Maybe GraphID)
    Nothing    Path
    _ SAttrs
    _  = () -> GraphState ()
    forall a. a -> StateT (StateValue ClusterLookup') Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    addCluster (Just Maybe GraphID
    gid) Path
    p SAttrs
    as = (ClusterLookup' -> ClusterLookup') -> GraphState ()
    forall s. (s -> s) -> GVState s ()
    modifyValue ((ClusterLookup' -> ClusterLookup') -> GraphState ())
    -> (ClusterLookup' -> ClusterLookup') -> GraphState ()
    forall a b. (a -> b) -> a -> b
    $ ((DList Path, SAttrs)
     -> (DList Path, SAttrs) -> (DList Path, SAttrs))
    -> Maybe GraphID
    -> (DList Path, SAttrs)
    -> ClusterLookup'
    -> ClusterLookup'
    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)

    -- 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 pth <- GVState ClusterLookup' Path
    forall s. GVState s Path
    getPath -- Want path before we add it...
                               recursiveCall mid $ do cntns
                                                      -- But want attrs after we
                                                      -- finish it.
                                                      gas <- getGlobals
                                                      addCluster mid pth gas

    addGraphGlobals                 :: GlobalAttributes -> GraphState ()
    addGraphGlobals :: GlobalAttributes -> GraphState ()
    addGraphGlobals (GraphAttrs Attributes
    as) = Attributes -> GraphState ()
    forall s. Attributes -> GVState s ()
    addGlobals Attributes
    as
    addGraphGlobals GlobalAttributes
    _               = () -> GraphState ()
    forall a. a -> StateT (StateValue ClusterLookup') Identity a
    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
    (NodeInfo -> NodeInfo -> Bool)
    -> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NodeInfo -> NodeInfo -> Bool
    == :: NodeInfo -> NodeInfo -> Bool
    $c/= :: NodeInfo -> NodeInfo -> Bool
    /= :: 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
    $ccompare :: NodeInfo -> NodeInfo -> Ordering
    compare :: NodeInfo -> NodeInfo -> Ordering
    $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
    >= :: NodeInfo -> NodeInfo -> Bool
    $cmax :: NodeInfo -> NodeInfo -> NodeInfo
    max :: NodeInfo -> NodeInfo -> NodeInfo
    $cmin :: NodeInfo -> NodeInfo -> NodeInfo
    min :: NodeInfo -> NodeInfo -> 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
    $cshowsPrec :: Int -> NodeInfo -> ShowS
    showsPrec :: Int -> NodeInfo -> ShowS
    $cshow :: NodeInfo -> String
    show :: NodeInfo -> String
    $cshowList :: [NodeInfo] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS NodeInfo
    readsPrec :: Int -> ReadS NodeInfo
    $creadList :: ReadS [NodeInfo]
    readList :: ReadS [NodeInfo]
    $creadPrec :: ReadPrec NodeInfo
    readPrec :: ReadPrec NodeInfo
    $creadListPrec :: ReadPrec [NodeInfo]
    readListPrec :: ReadPrec [NodeInfo]
    Read)

    type NodeState n a = GVState (NodeLookup' n) a

    toDotNodes :: NodeLookup n -> [DotNode n]
    toDotNodes :: forall n. 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,(Path
    _,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 :: forall n a. Bool -> NodeState n a -> NodeLookup n
    getNodeLookup Bool
    addGs = (NodeInfo -> (Path, Attributes))
    -> Map n NodeInfo -> Map n (Path, Attributes)
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map NodeInfo -> (Path, Attributes)
    combine (Map n NodeInfo -> Map n (Path, Attributes))
    -> (NodeState n a -> Map n NodeInfo)
    -> NodeState n a
    -> Map n (Path, Attributes)
    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 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)

    -- 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 SAttrs -> SAttrs -> SAttrs
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` SAttrs
    a2)
                                                    -- old one takes precendence
                                                   (SAttrs
    ga2 SAttrs -> SAttrs -> SAttrs
    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 (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 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 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 :: forall n. GlobalAttributes -> NodeState n ()
    addNodeGlobals (NodeAttrs Attributes
    as) = Attributes -> GVState (NodeLookup' n) ()
    forall s. Attributes -> GVState s ()
    addGlobals Attributes
    as
    addNodeGlobals GlobalAttributes
    _              = () -> GVState (NodeLookup' n) ()
    forall a. a -> StateT (StateValue (NodeLookup' n)) Identity a
    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 = (NodeLookup' n -> NodeLookup' n) -> GVState (NodeLookup' n) ()
    forall s. (s -> s) -> GVState s ()
    modifyValue ((NodeLookup' n -> NodeLookup' n) -> GVState (NodeLookup' n) ())
    -> (NodeLookup' n -> NodeLookup' n) -> GVState (NodeLookup' n) ()
    forall a b. (a -> b) -> a -> b
    $ (NodeInfo -> NodeInfo -> NodeInfo)
    -> n -> NodeInfo -> NodeLookup' n -> NodeLookup' n
    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 gas <- GVState (NodeLookup' n) SAttrs
    forall s. GVState s SAttrs
    getGlobals
                                p <- getPath
                                -- insertWith takes func (new -> old -> inserted)
                                mergeNode n as gas 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 gas <- GVState (NodeLookup' n) SAttrs
    forall s. GVState s SAttrs
    getGlobals
                                      p <- getPath
                                      addEN f gas p
                                      addEN t gas p
      where
        addEN :: n -> SAttrs -> Path -> NodeState n ()
    addEN n
    n = n -> Attributes -> SAttrs -> Path -> NodeState 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 = 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 :: forall n. GlobalAttributes -> EdgeState n ()
    addEdgeGlobals (EdgeAttrs Attributes
    as) = Attributes -> GVState (DList (DotEdge n)) ()
    forall s. Attributes -> GVState s ()
    addGlobals Attributes
    as
    addEdgeGlobals GlobalAttributes
    _              = () -> GVState (DList (DotEdge n)) ()
    forall a. a -> StateT (StateValue (DList (DotEdge n))) Identity a
    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 gas <- GVState (DList (DotEdge n)) SAttrs
    forall s. GVState s SAttrs
    getGlobals
           let de' = DotEdge n
    de { edgeAttributes = unSame $ unionWith gas as }
           modifyValue $ (`DList.snoc` de')