    {-# LANGUAGE MonadComprehensions, MultiParamTypeClasses #-}

    {- |
       Module      : Data.GraphViz.Algorithms
       Description : Various algorithms on Graphviz graphs.
       Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic
       License     : 3-Clause BSD-style
       Maintainer  : Ivan.Miljenovic@gmail.com

       Defines various algorithms for use on 'DotRepr' graphs.  These are
       typically re-implementations of behaviour found in existing Graphviz
       tools but without the I/O requirement.

       Note that one way that these algorithms differ from those found in
       Graphviz is that the order of clusters is /not/ maintained, which may
       affect layout in some cases.
     -}
    module Data.GraphViz.Algorithms
           ( -- * Canonicalisation Options
             -- $options
             CanonicaliseOptions(..)
           , defaultCanonOptions
           , dotLikeOptions
             -- * Canonicalisation
             -- $canonicalisation
           , canonicalise
           , canonicaliseOptions
             -- * Dealing with transitive edges
             -- $transitive
           , transitiveReduction
           , transitiveReductionOptions
           ) where

    import Data.GraphViz.Attributes.Complete   (Attributes, defaultAttributeValue)
    import Data.GraphViz.Attributes.Same
    import Data.GraphViz.Internal.Util         (bool)
    import Data.GraphViz.Types
    import Data.GraphViz.Types.Canonical
    import Data.GraphViz.Types.Internal.Common

    import           Control.Arrow       (first, second, (***))
    import           Control.Monad       (unless)
    import           Control.Monad.State (State, execState, gets, modify)
    import qualified Data.DList          as DList
    import qualified Data.Foldable       as F
    import           Data.Function       (on)
    import           Data.List           (deleteBy, groupBy, partition, sortBy,
                                          (\\))
    import           Data.Map            (Map)
    import qualified Data.Map            as Map
    import           Data.Maybe          (fromMaybe, listToMaybe, mapMaybe)
    import           Data.Set            (Set)
    import qualified Data.Set            as Set

    -- -----------------------------------------------------------------------------

    {- $options
       For simplicity, many algorithms end up using the canonicalisation
       functions to create the new 'DotGraph'.  'CanonicaliseOptions' allows
       you to configure how the output is generated.
     -}

    data CanonicaliseOptions = COpts { -- | Place edges in the clusters
                                       --   where their nodes are rather
                                       --   than in the top-level graph.
                                       CanonicaliseOptions -> Bool
    edgesInClusters :: Bool
                                       -- | Put common 'Attributes' as
                                       --   top-level 'GlobalAttributes'.
                                     , CanonicaliseOptions -> Bool
    groupAttributes :: Bool
                                     }
                             deriving (CanonicaliseOptions -> CanonicaliseOptions -> Bool
    (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> Eq CanonicaliseOptions
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    == :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    $c/= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    /= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    Eq, Eq CanonicaliseOptions
    Eq CanonicaliseOptions =>
    (CanonicaliseOptions -> CanonicaliseOptions -> Ordering)
    -> (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> (CanonicaliseOptions -> CanonicaliseOptions -> Bool)
    -> (CanonicaliseOptions
        -> CanonicaliseOptions -> CanonicaliseOptions)
    -> (CanonicaliseOptions
        -> CanonicaliseOptions -> CanonicaliseOptions)
    -> Ord CanonicaliseOptions
    CanonicaliseOptions -> CanonicaliseOptions -> Bool
    CanonicaliseOptions -> CanonicaliseOptions -> Ordering
    CanonicaliseOptions -> CanonicaliseOptions -> CanonicaliseOptions
    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 :: CanonicaliseOptions -> CanonicaliseOptions -> Ordering
    compare :: CanonicaliseOptions -> CanonicaliseOptions -> Ordering
    $c< :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    < :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    $c<= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    <= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    $c> :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    > :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    $c>= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    >= :: CanonicaliseOptions -> CanonicaliseOptions -> Bool
    $cmax :: CanonicaliseOptions -> CanonicaliseOptions -> CanonicaliseOptions
    max :: CanonicaliseOptions -> CanonicaliseOptions -> CanonicaliseOptions
    $cmin :: CanonicaliseOptions -> CanonicaliseOptions -> CanonicaliseOptions
    min :: CanonicaliseOptions -> CanonicaliseOptions -> CanonicaliseOptions
    Ord, Int -> CanonicaliseOptions -> ShowS
    [CanonicaliseOptions] -> ShowS
    CanonicaliseOptions -> String
    (Int -> CanonicaliseOptions -> ShowS)
    -> (CanonicaliseOptions -> String)
    -> ([CanonicaliseOptions] -> ShowS)
    -> Show CanonicaliseOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CanonicaliseOptions -> ShowS
    showsPrec :: Int -> CanonicaliseOptions -> ShowS
    $cshow :: CanonicaliseOptions -> String
    show :: CanonicaliseOptions -> String
    $cshowList :: [CanonicaliseOptions] -> ShowS
    showList :: [CanonicaliseOptions] -> ShowS
    Show, ReadPrec [CanonicaliseOptions]
    ReadPrec CanonicaliseOptions
    Int -> ReadS CanonicaliseOptions
    ReadS [CanonicaliseOptions]
    (Int -> ReadS CanonicaliseOptions)
    -> ReadS [CanonicaliseOptions]
    -> ReadPrec CanonicaliseOptions
    -> ReadPrec [CanonicaliseOptions]
    -> Read CanonicaliseOptions
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS CanonicaliseOptions
    readsPrec :: Int -> ReadS CanonicaliseOptions
    $creadList :: ReadS [CanonicaliseOptions]
    readList :: ReadS [CanonicaliseOptions]
    $creadPrec :: ReadPrec CanonicaliseOptions
    readPrec :: ReadPrec CanonicaliseOptions
    $creadListPrec :: ReadPrec [CanonicaliseOptions]
    readListPrec :: ReadPrec [CanonicaliseOptions]
    Read)

    defaultCanonOptions :: CanonicaliseOptions
    defaultCanonOptions :: CanonicaliseOptions
    defaultCanonOptions = COpts { edgesInClusters :: Bool
    edgesInClusters = Bool
    True
                                , groupAttributes :: Bool
    groupAttributes = Bool
    True
                                }

    -- | Options that are more like how @dot -Tcanon@ works.
    dotLikeOptions :: CanonicaliseOptions
    dotLikeOptions :: CanonicaliseOptions
    dotLikeOptions = COpts { edgesInClusters :: Bool
    edgesInClusters = Bool
    True
                           , groupAttributes :: Bool
    groupAttributes = Bool
    False
                           }

    -- -----------------------------------------------------------------------------

    {- $canonicalisation

    These functions implement similar functionality to @dot -Tcanon@
    (i.e. creates a canonical form of any 'DotRepr' graph).  without
    requiring IO.

    Note that due to implementation specifics the behaviour is not
    identical; in particular:

    * Any specified 'Attributes' that equal the defaults are stripped out
      (unless required to override a previous attribute that doesn't apply
      here).

    * Grouping of attributes (when @'groupAttributes = True'@) is much
      more conservative; only those node/edge attributes that are common to
      /all/ nodes and edges within that cluster (and within sub-clusters)
      are made global.

    * Sub-graphs aren't kept, only clusters.

    * 'ColorScheme' Attributes are removed (as all @Color@ values embed
      any needed color scheme anyway) as the output order of attributes may
      change (and this matters for the Haskell side of things).

    In particular, note that this function will create a single explicit
    definition for every node in the original graph and place it in the
    appropriate position in the cluster hierarchy.  All edges are found in
    the deepest cluster that contains both nodes.

    -}

    -- | Canonicalise with some sensible defaults.
    canonicalise :: (DotRepr dg n) => dg n -> DotGraph n
    canonicalise :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
    canonicalise = CanonicaliseOptions -> dg n -> DotGraph n
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    CanonicaliseOptions -> dg n -> DotGraph n
    canonicaliseOptions CanonicaliseOptions
    defaultCanonOptions

    -- | As with 'canonicalise', but allow custom 'CanonicaliseOptions'.
    canonicaliseOptions :: (DotRepr dg n) => CanonicaliseOptions
                           -> dg n -> DotGraph n
    canonicaliseOptions :: forall (dg :: * -> *) n.
    DotRepr dg n =>
    CanonicaliseOptions -> dg n -> DotGraph n
    canonicaliseOptions CanonicaliseOptions
    opts dg n
    dg = DotGraph n
    cdg { strictGraph   = graphIsStrict dg
                                      , directedGraph = graphIsDirected dg
                                      }
      where
        cdg :: DotGraph n
    cdg = CanonicaliseOptions
    -> Maybe GraphID
    -> GlobalAttributes
    -> ClusterLookup
    -> NodeLookup n
    -> [DotEdge n]
    -> DotGraph n
    forall n.
    Ord n =>
    CanonicaliseOptions
    -> Maybe GraphID
    -> GlobalAttributes
    -> ClusterLookup
    -> NodeLookup n
    -> [DotEdge n]
    -> DotGraph n
    createCanonical CanonicaliseOptions
    opts (dg n -> Maybe GraphID
    forall (dg :: * -> *) n. DotRepr dg n => dg n -> Maybe GraphID
    getID dg n
    dg) GlobalAttributes
    gas ClusterLookup
    cl NodeLookup n
    nl [DotEdge n]
    es

        (GlobalAttributes
    gas, ClusterLookup
    cl) = dg n -> (GlobalAttributes, ClusterLookup)
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    dg n -> (GlobalAttributes, ClusterLookup)
    graphStructureInformationClean dg n
    dg
        nl :: NodeLookup n
    nl = Bool -> dg n -> NodeLookup n
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    Bool -> dg n -> NodeLookup n
    nodeInformationClean Bool
    True dg n
    dg
        es :: [DotEdge n]
    es = Bool -> dg n -> [DotEdge n]
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    Bool -> dg n -> [DotEdge n]
    edgeInformationClean Bool
    True dg n
    dg

    type NodePath n = ([Maybe GraphID], DotNode n)
    type NodePaths n = [NodePath n]
    type EdgeClusters n = Map (Maybe GraphID) [DotEdge n]
    type EdgeLocations n = (EdgeClusters n, [DotEdge n])

    data CanonControl n = CC { forall n. CanonControl n -> CanonicaliseOptions
    cOpts    :: !CanonicaliseOptions
                             , forall n. CanonControl n -> Bool
    isGraph  :: !Bool
                             , forall n. CanonControl n -> ClusterLookup
    clusters :: !ClusterLookup
                             , forall n. CanonControl n -> EdgeLocations n
    clustEs  :: !(EdgeLocations n)
                             , forall n. CanonControl n -> Maybe GraphID
    topID    :: !(Maybe GraphID)
                             , forall n. CanonControl n -> Attributes
    topAttrs :: !Attributes
                             }

    createCanonical :: (Ord n) => CanonicaliseOptions -> Maybe GraphID -> GlobalAttributes
                       -> ClusterLookup -> NodeLookup n -> [DotEdge n] -> DotGraph n
    createCanonical :: forall n.
    Ord n =>
    CanonicaliseOptions
    -> Maybe GraphID
    -> GlobalAttributes
    -> ClusterLookup
    -> NodeLookup n
    -> [DotEdge n]
    -> DotGraph n
    createCanonical CanonicaliseOptions
    opts Maybe GraphID
    gid GlobalAttributes
    gas ClusterLookup
    cl NodeLookup n
    nl [DotEdge n]
    es = DotSubGraph n -> DotGraph n
    forall n. DotSubGraph n -> DotGraph n
    promoteDSG (DotSubGraph n -> DotGraph n) -> DotSubGraph n -> DotGraph n
    forall a b. (a -> b) -> a -> b
    $ CanonControl n -> NodePaths n -> DotSubGraph n
    forall n. CanonControl n -> NodePaths n -> DotSubGraph n
    makeGrouping CanonControl n
    cc NodePaths n
    ns
      where
        nUnlook :: (n, (t a, Attributes)) -> ([a], DotNode n)
    nUnlook (n
    n,(t a
    p,Attributes
    as)) = (t a -> [a]
    forall a. t a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList t a
    p, n -> Attributes -> DotNode n
    forall n. n -> Attributes -> DotNode n
    DotNode n
    n Attributes
    as)
        -- DotNodes paired and sorted by their paths
        ns :: NodePaths n
    ns = (([Maybe GraphID], DotNode n)
     -> ([Maybe GraphID], DotNode n) -> Ordering)
    -> NodePaths n -> NodePaths n
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ([Maybe GraphID] -> [Maybe GraphID] -> Ordering
    forall a. Ord a => [a] -> [a] -> Ordering
    compLists ([Maybe GraphID] -> [Maybe GraphID] -> Ordering)
    -> (([Maybe GraphID], DotNode n) -> [Maybe GraphID])
    -> ([Maybe GraphID], DotNode n)
    -> ([Maybe GraphID], DotNode n)
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ([Maybe GraphID], DotNode n) -> [Maybe GraphID]
    forall a b. (a, b) -> a
    fst) (NodePaths n -> NodePaths n)
    -> ([(n, (Seq (Maybe GraphID), Attributes))] -> NodePaths n)
    -> [(n, (Seq (Maybe GraphID), Attributes))]
    -> NodePaths n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((n, (Seq (Maybe GraphID), Attributes))
     -> ([Maybe GraphID], DotNode n))
    -> [(n, (Seq (Maybe GraphID), Attributes))] -> NodePaths n
    forall a b. (a -> b) -> [a] -> [b]
    map (n, (Seq (Maybe GraphID), Attributes))
    -> ([Maybe GraphID], DotNode n)
    forall {t :: * -> *} {n} {a}.
    Foldable t =>
    (n, (t a, Attributes)) -> ([a], DotNode n)
    nUnlook ([(n, (Seq (Maybe GraphID), Attributes))] -> NodePaths n)
    -> [(n, (Seq (Maybe GraphID), Attributes))] -> NodePaths n
    forall a b. (a -> b) -> a -> b
    $ NodeLookup n -> [(n, (Seq (Maybe GraphID), Attributes))]
    forall k a. Map k a -> [(k, a)]
    Map.toList NodeLookup n
    nl

        es' :: EdgeLocations n
    es' = if CanonicaliseOptions -> Bool
    edgesInClusters CanonicaliseOptions
    opts
              then NodeLookup n -> [DotEdge n] -> EdgeLocations n
    forall n. Ord n => NodeLookup n -> [DotEdge n] -> EdgeLocations n
    edgeClusters NodeLookup n
    nl [DotEdge n]
    es
              else (Map (Maybe GraphID) [DotEdge n]
    forall k a. Map k a
    Map.empty, [DotEdge n]
    es)

        cc :: CanonControl n
    cc = CC { cOpts :: CanonicaliseOptions
    cOpts    = CanonicaliseOptions
    opts
                , isGraph :: Bool
    isGraph  = Bool
    True
                , clusters :: ClusterLookup
    clusters = ClusterLookup
    cl
                , clustEs :: EdgeLocations n
    clustEs  = EdgeLocations n
    es'
                , topID :: Maybe GraphID
    topID    = Maybe GraphID
    gid
                , topAttrs :: Attributes
    topAttrs = GlobalAttributes -> Attributes
    attrs GlobalAttributes
    gas
                }

    thisLevel :: NodePaths n -> (NodePaths n, [DotNode n])
    thisLevel :: forall n. NodePaths n -> (NodePaths n, [DotNode n])
    thisLevel = ([([Maybe GraphID], DotNode n)] -> [DotNode n])
    -> ([([Maybe GraphID], DotNode n)], [([Maybe GraphID], DotNode n)])
    -> ([([Maybe GraphID], DotNode n)], [DotNode n])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((([Maybe GraphID], DotNode n) -> DotNode n)
    -> [([Maybe GraphID], DotNode n)] -> [DotNode n]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Maybe GraphID], DotNode n) -> DotNode n
    forall a b. (a, b) -> b
    snd) (([([Maybe GraphID], DotNode n)], [([Maybe GraphID], DotNode n)])
     -> ([([Maybe GraphID], DotNode n)], [DotNode n]))
    -> ([([Maybe GraphID], DotNode n)]
        -> ([([Maybe GraphID], DotNode n)],
            [([Maybe GraphID], DotNode n)]))
    -> [([Maybe GraphID], DotNode n)]
    -> ([([Maybe GraphID], DotNode n)], [DotNode n])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Maybe GraphID], DotNode n) -> Bool)
    -> [([Maybe GraphID], DotNode n)]
    -> ([([Maybe GraphID], DotNode n)], [([Maybe GraphID], DotNode n)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Bool -> Bool
    not (Bool -> Bool)
    -> (([Maybe GraphID], DotNode n) -> Bool)
    -> ([Maybe GraphID], DotNode n)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe GraphID] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Maybe GraphID] -> Bool)
    -> (([Maybe GraphID], DotNode n) -> [Maybe GraphID])
    -> ([Maybe GraphID], DotNode n)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Maybe GraphID], DotNode n) -> [Maybe GraphID]
    forall a b. (a, b) -> a
    fst)

    makeGrouping :: CanonControl n -> NodePaths n -> DotSubGraph n
    makeGrouping :: forall n. CanonControl n -> NodePaths n -> DotSubGraph n
    makeGrouping CanonControl n
    cc NodePaths n
    cns = DotSG { isCluster :: Bool
    isCluster = Bool
    True
                                , subGraphID :: Maybe GraphID
    subGraphID = Maybe GraphID
    cID
                                , subGraphStmts :: DotStatements n
    subGraphStmts = DotStatements n
    stmts
                                }
      where
        cID :: Maybe GraphID
    cID | CanonControl n -> Bool
    forall n. CanonControl n -> Bool
    isGraph CanonControl n
    cc = CanonControl n -> Maybe GraphID
    forall n. CanonControl n -> Maybe GraphID
    topID CanonControl n
    cc
            | Bool
    otherwise  = [Maybe GraphID] -> Maybe GraphID
    forall a. HasCallStack => [a] -> a
    head ([Maybe GraphID] -> Maybe GraphID)
    -> (NodePaths n -> [Maybe GraphID]) -> NodePaths n -> Maybe GraphID
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Maybe GraphID], DotNode n) -> [Maybe GraphID]
    forall a b. (a, b) -> a
    fst (([Maybe GraphID], DotNode n) -> [Maybe GraphID])
    -> (NodePaths n -> ([Maybe GraphID], DotNode n))
    -> NodePaths n
    -> [Maybe GraphID]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NodePaths n -> ([Maybe GraphID], DotNode n)
    forall a. HasCallStack => [a] -> a
    head (NodePaths n -> Maybe GraphID) -> NodePaths n -> Maybe GraphID
    forall a b. (a -> b) -> a -> b
    $ NodePaths n
    cns

        (NodePaths n
    nestedNs, [DotNode n]
    ns) = NodePaths n -> (NodePaths n, [DotNode n])
    forall n. NodePaths n -> (NodePaths n, [DotNode n])
    thisLevel
                         (NodePaths n -> (NodePaths n, [DotNode n]))
    -> (NodePaths n -> NodePaths n)
    -> NodePaths n
    -> (NodePaths n, [DotNode n])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NodePaths n -> NodePaths n)
    -> (NodePaths n -> NodePaths n)
    -> Bool
    -> NodePaths n
    -> NodePaths n
    forall a. a -> a -> Bool -> a
    bool ((([Maybe GraphID], DotNode n) -> ([Maybe GraphID], DotNode n))
    -> NodePaths n -> NodePaths n
    forall a b. (a -> b) -> [a] -> [b]
    map ((([Maybe GraphID], DotNode n) -> ([Maybe GraphID], DotNode n))
     -> NodePaths n -> NodePaths n)
    -> (([Maybe GraphID], DotNode n) -> ([Maybe GraphID], DotNode n))
    -> NodePaths n
    -> NodePaths n
    forall a b. (a -> b) -> a -> b
    $ ([Maybe GraphID] -> [Maybe GraphID])
    -> ([Maybe GraphID], DotNode n) -> ([Maybe GraphID], DotNode n)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first [Maybe GraphID] -> [Maybe GraphID]
    forall a. HasCallStack => [a] -> [a]
    tail) NodePaths n -> NodePaths n
    forall a. a -> a
    id (CanonControl n -> Bool
    forall n. CanonControl n -> Bool
    isGraph CanonControl n
    cc)
                         (NodePaths n -> (NodePaths n, [DotNode n]))
    -> NodePaths n -> (NodePaths n, [DotNode n])
    forall a b. (a -> b) -> a -> b
    $ NodePaths n
    cns

        es :: [DotEdge n]
    es = ((Map (Maybe GraphID) [DotEdge n], [DotEdge n]) -> [DotEdge n])
    -> ((Map (Maybe GraphID) [DotEdge n], [DotEdge n]) -> [DotEdge n])
    -> Bool
    -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])
    -> [DotEdge n]
    forall a. a -> a -> Bool -> a
    bool ([DotEdge n] -> Maybe [DotEdge n] -> [DotEdge n]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [DotEdge n] -> [DotEdge n])
    -> ((Map (Maybe GraphID) [DotEdge n], [DotEdge n])
        -> Maybe [DotEdge n])
    -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])
    -> [DotEdge n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe GraphID
    -> Map (Maybe GraphID) [DotEdge n] -> Maybe [DotEdge n]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Maybe GraphID
    cID (Map (Maybe GraphID) [DotEdge n] -> Maybe [DotEdge n])
    -> ((Map (Maybe GraphID) [DotEdge n], [DotEdge n])
        -> Map (Maybe GraphID) [DotEdge n])
    -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])
    -> Maybe [DotEdge n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map (Maybe GraphID) [DotEdge n], [DotEdge n])
    -> Map (Maybe GraphID) [DotEdge n]
    forall a b. (a, b) -> a
    fst) (Map (Maybe GraphID) [DotEdge n], [DotEdge n]) -> [DotEdge n]
    forall a b. (a, b) -> b
    snd (CanonControl n -> Bool
    forall n. CanonControl n -> Bool
    isGraph CanonControl n
    cc)
             ((Map (Maybe GraphID) [DotEdge n], [DotEdge n]) -> [DotEdge n])
    -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n]) -> [DotEdge n]
    forall a b. (a -> b) -> a -> b
    $ CanonControl n -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])
    forall n. CanonControl n -> EdgeLocations n
    clustEs CanonControl n
    cc

        gas :: Attributes
    gas | CanonControl n -> Bool
    forall n. CanonControl n -> Bool
    isGraph CanonControl n
    cc = CanonControl n -> Attributes
    forall n. CanonControl n -> Attributes
    topAttrs CanonControl n
    cc
            | Bool
    otherwise  = GlobalAttributes -> Attributes
    attrs (GlobalAttributes -> Attributes)
    -> (([Seq (Maybe GraphID)], GlobalAttributes) -> GlobalAttributes)
    -> ([Seq (Maybe GraphID)], GlobalAttributes)
    -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Seq (Maybe GraphID)], GlobalAttributes) -> GlobalAttributes
    forall a b. (a, b) -> b
    snd (([Seq (Maybe GraphID)], GlobalAttributes) -> Attributes)
    -> ([Seq (Maybe GraphID)], GlobalAttributes) -> Attributes
    forall a b. (a -> b) -> a -> b
    $ CanonControl n -> ClusterLookup
    forall n. CanonControl n -> ClusterLookup
    clusters CanonControl n
    cc ClusterLookup
    -> Maybe GraphID -> ([Seq (Maybe GraphID)], GlobalAttributes)
    forall k a. Ord k => Map k a -> k -> a
    Map.! Maybe GraphID
    cID

        subGs :: [DotSubGraph n]
    subGs = (NodePaths n -> DotSubGraph n) -> [NodePaths n] -> [DotSubGraph n]
    forall a b. (a -> b) -> [a] -> [b]
    map (CanonControl n -> NodePaths n -> DotSubGraph n
    forall n. CanonControl n -> NodePaths n -> DotSubGraph n
    makeGrouping (CanonControl n -> NodePaths n -> DotSubGraph n)
    -> CanonControl n -> NodePaths n -> DotSubGraph n
    forall a b. (a -> b) -> a -> b
    $ CanonControl n
    cc { isGraph = False })
                ([NodePaths n] -> [DotSubGraph n])
    -> (NodePaths n -> [NodePaths n]) -> NodePaths n -> [DotSubGraph n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Maybe GraphID], DotNode n)
     -> ([Maybe GraphID], DotNode n) -> Bool)
    -> NodePaths n -> [NodePaths n]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (Maybe (Maybe GraphID) -> Maybe (Maybe GraphID) -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Maybe (Maybe GraphID) -> Maybe (Maybe GraphID) -> Bool)
    -> (([Maybe GraphID], DotNode n) -> Maybe (Maybe GraphID))
    -> ([Maybe GraphID], DotNode n)
    -> ([Maybe GraphID], DotNode n)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ([Maybe GraphID] -> Maybe (Maybe GraphID)
    forall a. [a] -> Maybe a
    listToMaybe ([Maybe GraphID] -> Maybe (Maybe GraphID))
    -> (([Maybe GraphID], DotNode n) -> [Maybe GraphID])
    -> ([Maybe GraphID], DotNode n)
    -> Maybe (Maybe GraphID)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Maybe GraphID], DotNode n) -> [Maybe GraphID]
    forall a b. (a, b) -> a
    fst))
                (NodePaths n -> [DotSubGraph n]) -> NodePaths n -> [DotSubGraph n]
    forall a b. (a -> b) -> a -> b
    $ NodePaths n
    nestedNs

        stmts :: DotStatements n
    stmts = CanonicaliseOptions
    -> Attributes -> DotStatements n -> DotStatements n
    forall n.
    CanonicaliseOptions
    -> Attributes -> DotStatements n -> DotStatements n
    setGlobal (CanonControl n -> CanonicaliseOptions
    forall n. CanonControl n -> CanonicaliseOptions
    cOpts CanonControl n
    cc) Attributes
    gas
                (DotStatements n -> DotStatements n)
    -> DotStatements n -> DotStatements n
    forall a b. (a -> b) -> a -> b
    $ DotStmts { attrStmts :: [GlobalAttributes]
    attrStmts = []
                           , subGraphs :: [DotSubGraph n]
    subGraphs = [DotSubGraph n]
    subGs
                           , nodeStmts :: [DotNode n]
    nodeStmts = [DotNode n]
    ns
                           , edgeStmts :: [DotEdge n]
    edgeStmts = [DotEdge n]
    es
                           }

    setGlobal :: CanonicaliseOptions
                 -> Attributes -- Specified cluster attributes
                 -> DotStatements n
                 -> DotStatements n
    setGlobal :: forall n.
    CanonicaliseOptions
    -> Attributes -> DotStatements n -> DotStatements n
    setGlobal CanonicaliseOptions
    opts Attributes
    as DotStatements n
    stmts = DotStatements n
    stmts { attrStmts = globs'
                                    , subGraphs = sgs'
                                    , nodeStmts = ns'
                                    , edgeStmts = es'
                                    }
      where
        sgs :: [DotSubGraph n]
    sgs = DotStatements n -> [DotSubGraph n]
    forall n. DotStatements n -> [DotSubGraph n]
    subGraphs DotStatements n
    stmts
        sStmts :: [DotStatements n]
    sStmts = (DotSubGraph n -> DotStatements n)
    -> [DotSubGraph n] -> [DotStatements n]
    forall a b. (a -> b) -> [a] -> [b]
    map DotSubGraph n -> DotStatements n
    forall n. DotSubGraph n -> DotStatements n
    subGraphStmts [DotSubGraph n]
    sgs
        ns :: [DotNode n]
    ns = DotStatements n -> [DotNode n]
    forall n. DotStatements n -> [DotNode n]
    nodeStmts DotStatements n
    stmts
        es :: [DotEdge n]
    es = DotStatements n -> [DotEdge n]
    forall n. DotStatements n -> [DotEdge n]
    edgeStmts DotStatements n
    stmts

        sGlobs :: [(Attributes, Attributes, Attributes)]
    sGlobs = (DotStatements n -> (Attributes, Attributes, Attributes))
    -> [DotStatements n] -> [(Attributes, Attributes, Attributes)]
    forall a b. (a -> b) -> [a] -> [b]
    map ([GlobalAttributes] -> (Attributes, Attributes, Attributes)
    partitionGlobal ([GlobalAttributes] -> (Attributes, Attributes, Attributes))
    -> (DotStatements n -> [GlobalAttributes])
    -> DotStatements n
    -> (Attributes, Attributes, Attributes)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotStatements n -> [GlobalAttributes]
    forall n. DotStatements n -> [GlobalAttributes]
    attrStmts) [DotStatements n]
    sStmts

        ([Attributes]
    sgas,[Attributes]
    snas,[Attributes]
    seas) = [(Attributes, Attributes, Attributes)]
    -> ([Attributes], [Attributes], [Attributes])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 [(Attributes, Attributes, Attributes)]
    sGlobs

        gas' :: Attributes
    gas' = Attributes
    as -- Can't change graph attrs! Need these!
        nas' :: Attributes
    nas' = CanonicaliseOptions
    -> (DotStatements n -> [DotNode n])
    -> [Attributes]
    -> [DotStatements n]
    -> [Attributes]
    -> Attributes
    forall n a.
    CanonicaliseOptions
    -> (DotStatements n -> [a])
    -> [Attributes]
    -> [DotStatements n]
    -> [Attributes]
    -> Attributes
    getCommonGlobs CanonicaliseOptions
    opts DotStatements n -> [DotNode n]
    forall n. DotStatements n -> [DotNode n]
    nodeStmts [Attributes]
    snas [DotStatements n]
    sStmts ([Attributes] -> Attributes) -> [Attributes] -> Attributes
    forall a b. (a -> b) -> a -> b
    $ (DotNode n -> Attributes) -> [DotNode n] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map DotNode n -> Attributes
    forall n. DotNode n -> Attributes
    nodeAttributes [DotNode n]
    ns
        eas' :: Attributes
    eas' = CanonicaliseOptions
    -> (DotStatements n -> [DotEdge n])
    -> [Attributes]
    -> [DotStatements n]
    -> [Attributes]
    -> Attributes
    forall n a.
    CanonicaliseOptions
    -> (DotStatements n -> [a])
    -> [Attributes]
    -> [DotStatements n]
    -> [Attributes]
    -> Attributes
    getCommonGlobs CanonicaliseOptions
    opts DotStatements n -> [DotEdge n]
    forall n. DotStatements n -> [DotEdge n]
    edgeStmts [Attributes]
    seas [DotStatements n]
    sStmts ([Attributes] -> Attributes) -> [Attributes] -> Attributes
    forall a b. (a -> b) -> a -> b
    $ (DotEdge n -> Attributes) -> [DotEdge n] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map DotEdge n -> Attributes
    forall n. DotEdge n -> Attributes
    edgeAttributes [DotEdge n]
    es

        globs' :: [GlobalAttributes]
    globs' = [GlobalAttributes] -> [GlobalAttributes]
    nonEmptyGAs [ Attributes -> GlobalAttributes
    GraphAttrs Attributes
    gas'
                             , Attributes -> GlobalAttributes
    NodeAttrs  Attributes
    nas'
                             , Attributes -> GlobalAttributes
    EdgeAttrs  Attributes
    eas'
                             ]
        ns' :: [DotNode n]
    ns' = (DotNode n -> DotNode n) -> [DotNode n] -> [DotNode n]
    forall a b. (a -> b) -> [a] -> [b]
    map (\DotNode n
    dn -> DotNode n
    dn { nodeAttributes = nodeAttributes dn \\ nas' }) [DotNode n]
    ns
        es' :: [DotEdge n]
    es' = (DotEdge n -> DotEdge n) -> [DotEdge n] -> [DotEdge n]
    forall a b. (a -> b) -> [a] -> [b]
    map (\DotEdge n
    de -> DotEdge n
    de { edgeAttributes = edgeAttributes de \\ eas' }) [DotEdge n]
    es

        sgas' :: [Attributes]
    sgas' = Attributes -> [Attributes] -> [Attributes]
    updateGraphGlobs Attributes
    gas' [Attributes]
    sgas
        snas' :: [Attributes]
    snas' = (Attributes -> Attributes) -> [Attributes] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes -> Attributes -> Attributes
    forall a. Eq a => [a] -> [a] -> [a]
    \\ Attributes
    nas') [Attributes]
    snas
        seas' :: [Attributes]
    seas' = (Attributes -> Attributes) -> [Attributes] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes -> Attributes -> Attributes
    forall a. Eq a => [a] -> [a] -> [a]
    \\ Attributes
    eas') [Attributes]
    seas

        sGlobs' :: [(Attributes, Attributes, Attributes)]
    sGlobs' = [Attributes]
    -> [Attributes]
    -> [Attributes]
    -> [(Attributes, Attributes, Attributes)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Attributes]
    sgas' [Attributes]
    snas' [Attributes]
    seas'
        sStmts' :: [DotStatements n]
    sStmts' = (DotStatements n
     -> (Attributes, Attributes, Attributes) -> DotStatements n)
    -> [DotStatements n]
    -> [(Attributes, Attributes, Attributes)]
    -> [DotStatements n]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ DotStatements n
    sSt (Attributes, Attributes, Attributes)
    sGl -> DotStatements n
    sSt { attrStmts = nonEmptyGAs $ unPartitionGlobal sGl })
                          [DotStatements n]
    sStmts
                          [(Attributes, Attributes, Attributes)]
    sGlobs'

        sgs' :: [DotSubGraph n]
    sgs' = (DotSubGraph n -> DotStatements n -> DotSubGraph n)
    -> [DotSubGraph n] -> [DotStatements n] -> [DotSubGraph n]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ DotSubGraph n
    sg DotStatements n
    sSt -> DotSubGraph n
    sg { subGraphStmts = sSt }) [DotSubGraph n]
    sgs [DotStatements n]
    sStmts'

    updateGraphGlobs :: Attributes -> [Attributes] -> [Attributes]
    updateGraphGlobs :: Attributes -> [Attributes] -> [Attributes]
    updateGraphGlobs Attributes
    gas = (Attributes -> Attributes) -> [Attributes] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map Attributes -> Attributes
    go
      where
        gasS :: Set Attribute
    gasS = Attributes -> Set Attribute
    forall a. Ord a => [a] -> Set a
    Set.fromList Attributes
    gas

        override :: SAttrs
    override = Attributes -> SAttrs
    toSAttr (Attributes -> SAttrs) -> Attributes -> SAttrs
    forall a b. (a -> b) -> a -> b
    $ Attributes -> Attributes
    nonSameDefaults Attributes
    gas

        -- * Remove any identical values
        -- * Override any different values
        go :: Attributes -> Attributes
    go = Set Attribute -> Attributes
    forall a. Set a -> [a]
    Set.toList
             (Set Attribute -> Attributes)
    -> (Attributes -> Set Attribute) -> Attributes -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set Attribute -> Set Attribute -> Set Attribute
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set Attribute
    gasS) -- Remove identical values
             (Set Attribute -> Set Attribute)
    -> (Attributes -> Set Attribute) -> Attributes -> Set Attribute
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SAttrs -> Set Attribute
    unSameSet
             (SAttrs -> Set Attribute)
    -> (Attributes -> SAttrs) -> Attributes -> Set Attribute
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SAttrs -> SAttrs -> SAttrs
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` SAttrs
    override) -- Keeps existing values of constructors
             (SAttrs -> SAttrs)
    -> (Attributes -> SAttrs) -> Attributes -> SAttrs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attributes -> SAttrs
    toSAttr

    nonSameDefaults :: Attributes -> Attributes
    nonSameDefaults :: Attributes -> Attributes
    nonSameDefaults = (Attribute -> Maybe Attribute) -> Attributes -> Attributes
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\ Attribute
    a -> [ Attribute
    a' | Attribute
    a' <- Attribute -> Maybe Attribute
    defaultAttributeValue Attribute
    a, Attribute
    a' Attribute -> Attribute -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Attribute
    a] )

    getCommonGlobs :: CanonicaliseOptions
                      -> (DotStatements n -> [a])
                      -> [Attributes] -- ^ From sub-graphs
                      -> [DotStatements n] -- ^ Statements from the sub-graphs for testing.
                      -> [Attributes] -- ^ From nodes/edges
                      -> Attributes
    getCommonGlobs :: forall n a.
    CanonicaliseOptions
    -> (DotStatements n -> [a])
    -> [Attributes]
    -> [DotStatements n]
    -> [Attributes]
    -> Attributes
    getCommonGlobs CanonicaliseOptions
    opts DotStatements n -> [a]
    f [Attributes]
    sas [DotStatements n]
    stmts [Attributes]
    as
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ CanonicaliseOptions -> Bool
    groupAttributes CanonicaliseOptions
    opts = []
      | Bool
    otherwise = case [Attributes]
    sas' [Attributes] -> [Attributes] -> [Attributes]
    forall a. [a] -> [a] -> [a]
    ++ [Attributes]
    as of
                      []  -> []
                      [Attributes
    _] -> []
                      [Attributes]
    as' -> Set Attribute -> Attributes
    forall a. Set a -> [a]
    Set.toList (Set Attribute -> Attributes)
    -> ([Set Attribute] -> Set Attribute)
    -> [Set Attribute]
    -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set Attribute -> Set Attribute -> Set Attribute)
    -> [Set Attribute] -> Set Attribute
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Set Attribute -> Set Attribute -> Set Attribute
    forall a. Ord a => Set a -> Set a -> Set a
    Set.intersection
                             ([Set Attribute] -> Attributes) -> [Set Attribute] -> Attributes
    forall a b. (a -> b) -> a -> b
    $ (Attributes -> Set Attribute) -> [Attributes] -> [Set Attribute]
    forall a b. (a -> b) -> [a] -> [b]
    map Attributes -> Set Attribute
    forall a. Ord a => [a] -> Set a
    Set.fromList [Attributes]
    as'
      where
        sas' :: [Attributes]
    sas' = (DotStatements n -> [a])
    -> [Attributes] -> [DotStatements n] -> [Attributes]
    forall n a.
    (DotStatements n -> [a])
    -> [Attributes] -> [DotStatements n] -> [Attributes]
    keepIfAny DotStatements n -> [a]
    f [Attributes]
    sas [DotStatements n]
    stmts

    -- Used to distinguish between having empty list of global attributes
    -- for nodes or edges because there aren't any nodes/edges, or because
    -- there aren't any common attributes
    keepIfAny :: (DotStatements n -> [a]) -> [Attributes] -> [DotStatements n]
                 -> [Attributes]
    keepIfAny :: forall n a.
    (DotStatements n -> [a])
    -> [Attributes] -> [DotStatements n] -> [Attributes]
    keepIfAny DotStatements n -> [a]
    f [Attributes]
    sas = ((Attributes, Bool) -> Attributes)
    -> [(Attributes, Bool)] -> [Attributes]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes, Bool) -> Attributes
    forall a b. (a, b) -> a
    fst ([(Attributes, Bool)] -> [Attributes])
    -> ([DotStatements n] -> [(Attributes, Bool)])
    -> [DotStatements n]
    -> [Attributes]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Attributes, Bool) -> Bool)
    -> [(Attributes, Bool)] -> [(Attributes, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Attributes, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ([(Attributes, Bool)] -> [(Attributes, Bool)])
    -> ([DotStatements n] -> [(Attributes, Bool)])
    -> [DotStatements n]
    -> [(Attributes, Bool)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Attributes] -> [Bool] -> [(Attributes, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Attributes]
    sas ([Bool] -> [(Attributes, Bool)])
    -> ([DotStatements n] -> [Bool])
    -> [DotStatements n]
    -> [(Attributes, Bool)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DotStatements n -> Bool) -> [DotStatements n] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DotStatements n -> [a]) -> DotStatements n -> Bool
    forall n a. (DotStatements n -> [a]) -> DotStatements n -> Bool
    hasAny DotStatements n -> [a]
    f)

    hasAny      :: (DotStatements n -> [a]) -> DotStatements n -> Bool
    hasAny :: forall n a. (DotStatements n -> [a]) -> DotStatements n -> Bool
    hasAny DotStatements n -> [a]
    f DotStatements n
    ds = Bool -> Bool
    not ([a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([a] -> Bool) -> [a] -> Bool
    forall a b. (a -> b) -> a -> b
    $ DotStatements n -> [a]
    f DotStatements n
    ds) Bool -> Bool -> Bool
    || (DotSubGraph n -> Bool) -> [DotSubGraph n] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((DotStatements n -> [a]) -> DotStatements n -> Bool
    forall n a. (DotStatements n -> [a]) -> DotStatements n -> Bool
    hasAny DotStatements n -> [a]
    f (DotStatements n -> Bool)
    -> (DotSubGraph n -> DotStatements n) -> DotSubGraph n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotSubGraph n -> DotStatements n
    forall n. DotSubGraph n -> DotStatements n
    subGraphStmts) (DotStatements n -> [DotSubGraph n]
    forall n. DotStatements n -> [DotSubGraph n]
    subGraphs DotStatements n
    ds)

    promoteDSG     :: DotSubGraph n -> DotGraph n
    promoteDSG :: forall n. DotSubGraph n -> DotGraph n
    promoteDSG DotSubGraph n
    dsg = DotGraph { strictGraph :: Bool
    strictGraph     = Bool
    forall a. HasCallStack => a
    undefined
                              , directedGraph :: Bool
    directedGraph   = Bool
    forall a. HasCallStack => a
    undefined
                              , graphID :: Maybe GraphID
    graphID         = DotSubGraph n -> Maybe GraphID
    forall n. DotSubGraph n -> Maybe GraphID
    subGraphID DotSubGraph n
    dsg
                              , graphStatements :: DotStatements n
    graphStatements = DotSubGraph n -> DotStatements n
    forall n. DotSubGraph n -> DotStatements n
    subGraphStmts DotSubGraph n
    dsg
                              }

    -- Same as compare for lists, except shorter lists are GT
    compLists :: (Ord a) => [a] -> [a] -> Ordering
    compLists :: forall a. Ord a => [a] -> [a] -> Ordering
    compLists []     []     = Ordering
    EQ
    compLists []     [a]
    _      = Ordering
    GT
    compLists [a]
    _      []     = Ordering
    LT
    compLists (a
    x:[a]
    xs) (a
    y:[a]
    ys) = case a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    x a
    y of
                                Ordering
    EQ  -> [a] -> [a] -> Ordering
    forall a. Ord a => [a] -> [a] -> Ordering
    compLists [a]
    xs [a]
    ys
                                Ordering
    oth -> Ordering
    oth

    nonEmptyGAs :: [GlobalAttributes] -> [GlobalAttributes]
    nonEmptyGAs :: [GlobalAttributes] -> [GlobalAttributes]
    nonEmptyGAs = (GlobalAttributes -> Bool)
    -> [GlobalAttributes] -> [GlobalAttributes]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (GlobalAttributes -> Bool) -> GlobalAttributes -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attributes -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Attributes -> Bool)
    -> (GlobalAttributes -> Attributes) -> GlobalAttributes -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GlobalAttributes -> Attributes
    attrs)

    -- Assign each edge into the cluster it belongs in.
    edgeClusters    :: (Ord n) => NodeLookup n -> [DotEdge n]
                       -> EdgeLocations n
    edgeClusters :: forall n. Ord n => NodeLookup n -> [DotEdge n] -> EdgeLocations n
    edgeClusters NodeLookup n
    nl = ([([Maybe GraphID], DotEdge n)] -> EdgeClusters n
    forall {a}. [([Maybe GraphID], a)] -> Map (Maybe GraphID) [a]
    toM ([([Maybe GraphID], DotEdge n)] -> EdgeClusters n)
    -> ([([Maybe GraphID], DotEdge n)] -> [DotEdge n])
    -> ([([Maybe GraphID], DotEdge n)], [([Maybe GraphID], DotEdge n)])
    -> (EdgeClusters n, [DotEdge n])
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** (([Maybe GraphID], DotEdge n) -> DotEdge n)
    -> [([Maybe GraphID], DotEdge n)] -> [DotEdge n]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Maybe GraphID], DotEdge n) -> DotEdge n
    forall a b. (a, b) -> b
    snd) (([([Maybe GraphID], DotEdge n)], [([Maybe GraphID], DotEdge n)])
     -> (EdgeClusters n, [DotEdge n]))
    -> ([DotEdge n]
        -> ([([Maybe GraphID], DotEdge n)],
            [([Maybe GraphID], DotEdge n)]))
    -> [DotEdge n]
    -> (EdgeClusters n, [DotEdge n])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Maybe GraphID], DotEdge n) -> Bool)
    -> [([Maybe GraphID], DotEdge n)]
    -> ([([Maybe GraphID], DotEdge n)], [([Maybe GraphID], DotEdge n)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Bool -> Bool
    not (Bool -> Bool)
    -> (([Maybe GraphID], DotEdge n) -> Bool)
    -> ([Maybe GraphID], DotEdge n)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe GraphID] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Maybe GraphID] -> Bool)
    -> (([Maybe GraphID], DotEdge n) -> [Maybe GraphID])
    -> ([Maybe GraphID], DotEdge n)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Maybe GraphID], DotEdge n) -> [Maybe GraphID]
    forall a b. (a, b) -> a
    fst)
                      ([([Maybe GraphID], DotEdge n)]
     -> ([([Maybe GraphID], DotEdge n)],
         [([Maybe GraphID], DotEdge n)]))
    -> ([DotEdge n] -> [([Maybe GraphID], DotEdge n)])
    -> [DotEdge n]
    -> ([([Maybe GraphID], DotEdge n)], [([Maybe GraphID], DotEdge n)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DotEdge n -> ([Maybe GraphID], DotEdge n))
    -> [DotEdge n] -> [([Maybe GraphID], DotEdge n)]
    forall a b. (a -> b) -> [a] -> [b]
    map DotEdge n -> ([Maybe GraphID], DotEdge n)
    inClust
      where
        nl' :: Map n [Maybe GraphID]
    nl' = ((Seq (Maybe GraphID), Attributes) -> [Maybe GraphID])
    -> NodeLookup n -> Map n [Maybe GraphID]
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (Seq (Maybe GraphID) -> [Maybe GraphID]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (Seq (Maybe GraphID) -> [Maybe GraphID])
    -> ((Seq (Maybe GraphID), Attributes) -> Seq (Maybe GraphID))
    -> (Seq (Maybe GraphID), Attributes)
    -> [Maybe GraphID]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Seq (Maybe GraphID), Attributes) -> Seq (Maybe GraphID)
    forall a b. (a, b) -> a
    fst) NodeLookup n
    nl
        -- DotEdge n -> (Path, DotEdge n)
        inClust :: DotEdge n -> ([Maybe GraphID], DotEdge n)
    inClust de :: DotEdge n
    de@(DotEdge n
    n1 n
    n2 Attributes
    _) = (([Maybe GraphID] -> DotEdge n -> ([Maybe GraphID], DotEdge n))
    -> DotEdge n -> [Maybe GraphID] -> ([Maybe GraphID], DotEdge n)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) DotEdge n
    de)
                                       ([Maybe GraphID] -> ([Maybe GraphID], DotEdge n))
    -> ([(Maybe GraphID, Maybe GraphID)] -> [Maybe GraphID])
    -> [(Maybe GraphID, Maybe GraphID)]
    -> ([Maybe GraphID], DotEdge n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Maybe GraphID, Maybe GraphID) -> Maybe GraphID)
    -> [(Maybe GraphID, Maybe GraphID)] -> [Maybe GraphID]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe GraphID, Maybe GraphID) -> Maybe GraphID
    forall a b. (a, b) -> a
    fst ([(Maybe GraphID, Maybe GraphID)] -> [Maybe GraphID])
    -> ([(Maybe GraphID, Maybe GraphID)]
        -> [(Maybe GraphID, Maybe GraphID)])
    -> [(Maybe GraphID, Maybe GraphID)]
    -> [Maybe GraphID]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Maybe GraphID, Maybe GraphID) -> Bool)
    -> [(Maybe GraphID, Maybe GraphID)]
    -> [(Maybe GraphID, Maybe GraphID)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile ((Maybe GraphID -> Maybe GraphID -> Bool)
    -> (Maybe GraphID, Maybe GraphID) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Maybe GraphID -> Maybe GraphID -> Bool
    forall a. Eq a => a -> a -> Bool
    (==))
                                       ([(Maybe GraphID, Maybe GraphID)] -> ([Maybe GraphID], DotEdge n))
    -> [(Maybe GraphID, Maybe GraphID)] -> ([Maybe GraphID], DotEdge n)
    forall a b. (a -> b) -> a -> b
    $ [Maybe GraphID]
    -> [Maybe GraphID] -> [(Maybe GraphID, Maybe GraphID)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Map n [Maybe GraphID]
    nl' Map n [Maybe GraphID] -> n -> [Maybe GraphID]
    forall k a. Ord k => Map k a -> k -> a
    Map.! n
    n1) (Map n [Maybe GraphID]
    nl' Map n [Maybe GraphID] -> n -> [Maybe GraphID]
    forall k a. Ord k => Map k a -> k -> a
    Map.! n
    n2)
        toM :: [([Maybe GraphID], a)] -> Map (Maybe GraphID) [a]
    toM = (DList a -> [a])
    -> Map (Maybe GraphID) (DList a) -> Map (Maybe GraphID) [a]
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map DList a -> [a]
    forall a. DList a -> [a]
    DList.toList
              (Map (Maybe GraphID) (DList a) -> Map (Maybe GraphID) [a])
    -> ([([Maybe GraphID], a)] -> Map (Maybe GraphID) (DList a))
    -> [([Maybe GraphID], a)]
    -> Map (Maybe GraphID) [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DList a -> DList a -> DList a)
    -> [(Maybe GraphID, DList a)] -> Map (Maybe GraphID) (DList a)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith ((DList a -> DList a -> DList a) -> DList a -> DList a -> DList a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip DList a -> DList a -> DList a
    forall a. DList a -> DList a -> DList a
    DList.append)
              ([(Maybe GraphID, DList a)] -> Map (Maybe GraphID) (DList a))
    -> ([([Maybe GraphID], a)] -> [(Maybe GraphID, DList a)])
    -> [([Maybe GraphID], a)]
    -> Map (Maybe GraphID) (DList a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Maybe GraphID], a) -> (Maybe GraphID, DList a))
    -> [([Maybe GraphID], a)] -> [(Maybe GraphID, DList a)]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Maybe GraphID] -> Maybe GraphID
    forall a. HasCallStack => [a] -> a
    last ([Maybe GraphID] -> Maybe GraphID)
    -> (a -> DList a)
    -> ([Maybe GraphID], a)
    -> (Maybe GraphID, DList a)
    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')
    *** a -> DList a
    forall a. a -> DList a
    DList.singleton)

    -- -----------------------------------------------------------------------------

    {- $transitive

       In large, cluttered graphs, it can often be difficult to see what
       is happening due to the number of edges being drawn.  As such, it is
       often useful to remove transitive edges from the graph before
       visualising it.

       For example, consider the following Dot graph:

       > digraph {
       >     a -> b;
       >     a -> c;
       >     b -> c;
       > }

       This graph has the transitive edge @a -> c@ (as we can reach @c@ from @a@ via @b@).

       Graphviz comes with the @tred@ program to perform these transitive
       reductions.  'transitiveReduction' and 'transitiveReductionOptions'
       are pure Haskell re-implementations of @tred@ with the following differences:

       * @tred@ prints a message to stderr if a cycle is detected; these
         functions do not.

       * @tred@ preserves the original structure of the graph; these
         functions use the canonicalisation functions above to create the new
         graph (rather than re-implement creation functions for each one).

       When a graph contains cycles, an arbitrary edge from that cycle is
       ignored whilst calculating the transitive reduction.  Multiple edges
       are also reduced (such that only the first edge between two nodes is
       kept).

       Note that transitive reduction only makes sense for directed graphs;
       for undirected graphs these functions are identical to the
       canonicalisation functions above.

       The caveats for the canonicalisation functions also apply.
     -}

    transitiveReduction :: (DotRepr dg n) => dg n -> DotGraph n
    transitiveReduction :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
    transitiveReduction = CanonicaliseOptions -> dg n -> DotGraph n
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    CanonicaliseOptions -> dg n -> DotGraph n
    transitiveReductionOptions CanonicaliseOptions
    defaultCanonOptions

    transitiveReductionOptions         :: (DotRepr dg n) => CanonicaliseOptions
                                          -> dg n -> DotGraph n
    transitiveReductionOptions :: forall (dg :: * -> *) n.
    DotRepr dg n =>
    CanonicaliseOptions -> dg n -> DotGraph n
    transitiveReductionOptions CanonicaliseOptions
    opts dg n
    dg = DotGraph n
    cdg { strictGraph = graphIsStrict dg
                                             , directedGraph = graphIsDirected dg
                                             }
      where
        cdg :: DotGraph n
    cdg = CanonicaliseOptions
    -> Maybe GraphID
    -> GlobalAttributes
    -> ClusterLookup
    -> NodeLookup n
    -> [DotEdge n]
    -> DotGraph n
    forall n.
    Ord n =>
    CanonicaliseOptions
    -> Maybe GraphID
    -> GlobalAttributes
    -> ClusterLookup
    -> NodeLookup n
    -> [DotEdge n]
    -> DotGraph n
    createCanonical CanonicaliseOptions
    opts (dg n -> Maybe GraphID
    forall (dg :: * -> *) n. DotRepr dg n => dg n -> Maybe GraphID
    getID dg n
    dg) GlobalAttributes
    gas ClusterLookup
    cl NodeLookup n
    nl [DotEdge n]
    es'
        (GlobalAttributes
    gas, ClusterLookup
    cl) = dg n -> (GlobalAttributes, ClusterLookup)
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    dg n -> (GlobalAttributes, ClusterLookup)
    graphStructureInformationClean dg n
    dg
        nl :: NodeLookup n
    nl = Bool -> dg n -> NodeLookup n
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    Bool -> dg n -> NodeLookup n
    nodeInformationClean Bool
    True dg n
    dg
        es :: [DotEdge n]
    es = Bool -> dg n -> [DotEdge n]
    forall (dg :: * -> *) n.
    DotRepr dg n =>
    Bool -> dg n -> [DotEdge n]
    edgeInformationClean Bool
    True dg n
    dg
        es' :: [DotEdge n]
    es' | dg n -> Bool
    forall (dg :: * -> *) n. DotRepr dg n => dg n -> Bool
    graphIsDirected dg n
    dg = [DotEdge n] -> [DotEdge n]
    forall n. Ord n => [DotEdge n] -> [DotEdge n]
    rmTransEdges [DotEdge n]
    es
            | Bool
    otherwise          = [DotEdge n]
    es

    rmTransEdges    :: (Ord n) => [DotEdge n] -> [DotEdge n]
    rmTransEdges :: forall n. Ord n => [DotEdge n] -> [DotEdge n]
    rmTransEdges [] = []
    rmTransEdges [DotEdge n]
    es = (TaggedValues n -> [DotEdge n]) -> [TaggedValues n] -> [DotEdge n]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((Int, DotEdge n) -> DotEdge n)
    -> [(Int, DotEdge n)] -> [DotEdge n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, DotEdge n) -> DotEdge n
    forall a b. (a, b) -> b
    snd ([(Int, DotEdge n)] -> [DotEdge n])
    -> (TaggedValues n -> [(Int, DotEdge n)])
    -> TaggedValues n
    -> [DotEdge n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TaggedValues n -> [(Int, DotEdge n)]
    forall n. TaggedValues n -> [TaggedEdge n]
    outgoing) ([TaggedValues n] -> [DotEdge n])
    -> [TaggedValues n] -> [DotEdge n]
    forall a b. (a -> b) -> a -> b
    $ Map n (TaggedValues n) -> [TaggedValues n]
    forall k a. Map k a -> [a]
    Map.elems Map n (TaggedValues n)
    esM
      where
        tes :: [(Int, DotEdge n)]
    tes = [DotEdge n] -> [(Int, DotEdge n)]
    forall n. [DotEdge n] -> [TaggedEdge n]
    tagEdges [DotEdge n]
    es

        esMS :: StateT (Map n (TaggedValues n), TagSet) Identity ()
    esMS = do [(Int, DotEdge n)]
    -> StateT (Map n (TaggedValues n), TagSet) Identity ()
    forall n. Ord n => [TaggedEdge n] -> TagState n ()
    edgeGraph [(Int, DotEdge n)]
    tes
                  ns <- (Map n (TaggedValues n) -> [n]) -> TagState n [n]
    forall n a. (TagMap n -> a) -> TagState n a
    getsMap Map n (TaggedValues n) -> [n]
    forall k a. Map k a -> [k]
    Map.keys
                  mapM_ (traverseTag zeroTag) ns

        esM :: Map n (TaggedValues n)
    esM = (Map n (TaggedValues n), TagSet) -> Map n (TaggedValues n)
    forall a b. (a, b) -> a
    fst ((Map n (TaggedValues n), TagSet) -> Map n (TaggedValues n))
    -> (Map n (TaggedValues n), TagSet) -> Map n (TaggedValues n)
    forall a b. (a -> b) -> a -> b
    $ StateT (Map n (TaggedValues n), TagSet) Identity ()
    -> (Map n (TaggedValues n), TagSet)
    -> (Map n (TaggedValues n), TagSet)
    forall s a. State s a -> s -> s
    execState StateT (Map n (TaggedValues n), TagSet) Identity ()
    esMS (Map n (TaggedValues n)
    forall k a. Map k a
    Map.empty, TagSet
    forall a. Set a
    Set.empty)

    type Tag = Int
    type TagSet = Set Int
    type TaggedEdge n = (Tag, DotEdge n)

    -- A "nonsense" tag to use as an initial value
    zeroTag :: Tag
    zeroTag :: Int
    zeroTag = Int
    0

    tagEdges :: [DotEdge n] -> [TaggedEdge n]
    tagEdges :: forall n. [DotEdge n] -> [TaggedEdge n]
    tagEdges = [Int] -> [DotEdge n] -> [(Int, DotEdge n)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Int -> Int
    forall a. Enum a => a -> a
    succ Int
    zeroTag)..]

    data TaggedValues n = TV { forall n. TaggedValues n -> Bool
    marked   :: Bool
                             , forall n. TaggedValues n -> [TaggedEdge n]
    incoming :: [TaggedEdge n]
                             , forall n. TaggedValues n -> [TaggedEdge n]
    outgoing :: [TaggedEdge n]
                             }
                        deriving (TaggedValues n -> TaggedValues n -> Bool
    (TaggedValues n -> TaggedValues n -> Bool)
    -> (TaggedValues n -> TaggedValues n -> Bool)
    -> Eq (TaggedValues n)
    forall n. Eq n => TaggedValues n -> TaggedValues n -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall n. Eq n => TaggedValues n -> TaggedValues n -> Bool
    == :: TaggedValues n -> TaggedValues n -> Bool
    $c/= :: forall n. Eq n => TaggedValues n -> TaggedValues n -> Bool
    /= :: TaggedValues n -> TaggedValues n -> Bool
    Eq, Eq (TaggedValues n)
    Eq (TaggedValues n) =>
    (TaggedValues n -> TaggedValues n -> Ordering)
    -> (TaggedValues n -> TaggedValues n -> Bool)
    -> (TaggedValues n -> TaggedValues n -> Bool)
    -> (TaggedValues n -> TaggedValues n -> Bool)
    -> (TaggedValues n -> TaggedValues n -> Bool)
    -> (TaggedValues n -> TaggedValues n -> TaggedValues n)
    -> (TaggedValues n -> TaggedValues n -> TaggedValues n)
    -> Ord (TaggedValues n)
    TaggedValues n -> TaggedValues n -> Bool
    TaggedValues n -> TaggedValues n -> Ordering
    TaggedValues n -> TaggedValues n -> TaggedValues n
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall n. Ord n => Eq (TaggedValues n)
    forall n. Ord n => TaggedValues n -> TaggedValues n -> Bool
    forall n. Ord n => TaggedValues n -> TaggedValues n -> Ordering
    forall n.
    Ord n =>
    TaggedValues n -> TaggedValues n -> TaggedValues n
    $ccompare :: forall n. Ord n => TaggedValues n -> TaggedValues n -> Ordering
    compare :: TaggedValues n -> TaggedValues n -> Ordering
    $c< :: forall n. Ord n => TaggedValues n -> TaggedValues n -> Bool
    < :: TaggedValues n -> TaggedValues n -> Bool
    $c<= :: forall n. Ord n => TaggedValues n -> TaggedValues n -> Bool
    <= :: TaggedValues n -> TaggedValues n -> Bool
    $c> :: forall n. Ord n => TaggedValues n -> TaggedValues n -> Bool
    > :: TaggedValues n -> TaggedValues n -> Bool
    $c>= :: forall n. Ord n => TaggedValues n -> TaggedValues n -> Bool
    >= :: TaggedValues n -> TaggedValues n -> Bool
    $cmax :: forall n.
    Ord n =>
    TaggedValues n -> TaggedValues n -> TaggedValues n
    max :: TaggedValues n -> TaggedValues n -> TaggedValues n
    $cmin :: forall n.
    Ord n =>
    TaggedValues n -> TaggedValues n -> TaggedValues n
    min :: TaggedValues n -> TaggedValues n -> TaggedValues n
    Ord, Int -> TaggedValues n -> ShowS
    [TaggedValues n] -> ShowS
    TaggedValues n -> String
    (Int -> TaggedValues n -> ShowS)
    -> (TaggedValues n -> String)
    -> ([TaggedValues n] -> ShowS)
    -> Show (TaggedValues n)
    forall n. Show n => Int -> TaggedValues n -> ShowS
    forall n. Show n => [TaggedValues n] -> ShowS
    forall n. Show n => TaggedValues n -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall n. Show n => Int -> TaggedValues n -> ShowS
    showsPrec :: Int -> TaggedValues n -> ShowS
    $cshow :: forall n. Show n => TaggedValues n -> String
    show :: TaggedValues n -> String
    $cshowList :: forall n. Show n => [TaggedValues n] -> ShowS
    showList :: [TaggedValues n] -> ShowS
    Show, ReadPrec [TaggedValues n]
    ReadPrec (TaggedValues n)
    Int -> ReadS (TaggedValues n)
    ReadS [TaggedValues n]
    (Int -> ReadS (TaggedValues n))
    -> ReadS [TaggedValues n]
    -> ReadPrec (TaggedValues n)
    -> ReadPrec [TaggedValues n]
    -> Read (TaggedValues n)
    forall n. Read n => ReadPrec [TaggedValues n]
    forall n. Read n => ReadPrec (TaggedValues n)
    forall n. Read n => Int -> ReadS (TaggedValues n)
    forall n. Read n => ReadS [TaggedValues n]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall n. Read n => Int -> ReadS (TaggedValues n)
    readsPrec :: Int -> ReadS (TaggedValues n)
    $creadList :: forall n. Read n => ReadS [TaggedValues n]
    readList :: ReadS [TaggedValues n]
    $creadPrec :: forall n. Read n => ReadPrec (TaggedValues n)
    readPrec :: ReadPrec (TaggedValues n)
    $creadListPrec :: forall n. Read n => ReadPrec [TaggedValues n]
    readListPrec :: ReadPrec [TaggedValues n]
    Read)

    defTV :: TaggedValues n
    defTV :: forall n. TaggedValues n
    defTV = Bool -> [TaggedEdge n] -> [TaggedEdge n] -> TaggedValues n
    forall n.
    Bool -> [TaggedEdge n] -> [TaggedEdge n] -> TaggedValues n
    TV Bool
    False [] []

    type TagMap n = Map n (TaggedValues n)

    type TagState n a = State (TagMap n, TagSet) a

    getMap :: TagState n (TagMap n)
    getMap :: forall n. TagState n (TagMap n)
    getMap = ((TagMap n, TagSet) -> TagMap n)
    -> StateT (TagMap n, TagSet) Identity (TagMap n)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (TagMap n, TagSet) -> TagMap n
    forall a b. (a, b) -> a
    fst

    getsMap   :: (TagMap n -> a) -> TagState n a
    getsMap :: forall n a. (TagMap n -> a) -> TagState n a
    getsMap TagMap n -> a
    f = ((TagMap n, TagSet) -> a) -> StateT (TagMap n, TagSet) Identity a
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (TagMap n -> a
    f (TagMap n -> a)
    -> ((TagMap n, TagSet) -> TagMap n) -> (TagMap n, TagSet) -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TagMap n, TagSet) -> TagMap n
    forall a b. (a, b) -> a
    fst)

    modifyMap   :: (TagMap n -> TagMap n) -> TagState n ()
    modifyMap :: forall n. (TagMap n -> TagMap n) -> TagState n ()
    modifyMap TagMap n -> TagMap n
    f = ((TagMap n, TagSet) -> (TagMap n, TagSet))
    -> StateT (TagMap n, TagSet) Identity ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((TagMap n -> TagMap n) -> (TagMap n, TagSet) -> (TagMap n, TagSet)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first TagMap n -> TagMap n
    f)

    getSet :: TagState n TagSet
    getSet :: forall n. TagState n TagSet
    getSet = ((TagMap n, TagSet) -> TagSet)
    -> StateT (TagMap n, TagSet) Identity TagSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (TagMap n, TagSet) -> TagSet
    forall a b. (a, b) -> b
    snd

    modifySet   :: (TagSet -> TagSet) -> TagState n ()
    modifySet :: forall n. (TagSet -> TagSet) -> TagState n ()
    modifySet TagSet -> TagSet
    f = ((TagMap n, TagSet) -> (TagMap n, TagSet))
    -> StateT (TagMap n, TagSet) Identity ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((TagSet -> TagSet) -> (TagMap n, TagSet) -> (TagMap n, TagSet)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second TagSet -> TagSet
    f)

    -- Create the Map representing the graph from the edges.
    edgeGraph :: (Ord n) => [TaggedEdge n] -> TagState n ()
    edgeGraph :: forall n. Ord n => [TaggedEdge n] -> TagState n ()
    edgeGraph = (TaggedEdge n -> StateT (TagMap n, TagSet) Identity ())
    -> [TaggedEdge n] -> StateT (TagMap n, TagSet) Identity ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ TaggedEdge n -> StateT (TagMap n, TagSet) Identity ()
    forall {n}.
    Ord n =>
    TaggedEdge n -> StateT (TagMap n, TagSet) Identity ()
    addEdge ([TaggedEdge n] -> StateT (TagMap n, TagSet) Identity ())
    -> ([TaggedEdge n] -> [TaggedEdge n])
    -> [TaggedEdge n]
    -> StateT (TagMap n, TagSet) Identity ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TaggedEdge n] -> [TaggedEdge n]
    forall a. [a] -> [a]
    reverse
      where
        addEdge :: TaggedEdge n -> StateT (TagMap n, TagSet) Identity ()
    addEdge TaggedEdge n
    te = n -> TaggedValues n -> StateT (TagMap n, TagSet) Identity ()
    forall {n}. Ord n => n -> TaggedValues n -> TagState n ()
    addVal n
    f TaggedValues n
    tvOut StateT (TagMap n, TagSet) Identity ()
    -> StateT (TagMap n, TagSet) Identity ()
    -> StateT (TagMap n, TagSet) Identity ()
    forall a b.
    StateT (TagMap n, TagSet) Identity a
    -> StateT (TagMap n, TagSet) Identity b
    -> StateT (TagMap n, TagSet) Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> n -> TaggedValues n -> StateT (TagMap n, TagSet) Identity ()
    forall {n}. Ord n => n -> TaggedValues n -> TagState n ()
    addVal n
    t TaggedValues n
    tvIn
          where
            e :: DotEdge n
    e = TaggedEdge n -> DotEdge n
    forall a b. (a, b) -> b
    snd TaggedEdge n
    te
            f :: n
    f = DotEdge n -> n
    forall n. DotEdge n -> n
    fromNode DotEdge n
    e
            t :: n
    t = DotEdge n -> n
    forall n. DotEdge n -> n
    toNode DotEdge n
    e
            addVal :: n -> TaggedValues n -> TagState n ()
    addVal n
    n TaggedValues n
    tv = (TagMap n -> TagMap n) -> TagState n ()
    forall n. (TagMap n -> TagMap n) -> TagState n ()
    modifyMap ((TaggedValues n -> TaggedValues n -> TaggedValues n)
    -> n -> TaggedValues n -> TagMap n -> TagMap n
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith TaggedValues n -> TaggedValues n -> TaggedValues n
    forall {n}. TaggedValues n -> TaggedValues n -> TaggedValues n
    mergeTV n
    n TaggedValues n
    tv)
            tvIn :: TaggedValues n
    tvIn  = TaggedValues n
    forall n. TaggedValues n
    defTV { incoming = [te] }
            tvOut :: TaggedValues n
    tvOut = TaggedValues n
    forall n. TaggedValues n
    defTV { outgoing = [te] }
            mergeTV :: TaggedValues n -> TaggedValues n -> TaggedValues n
    mergeTV TaggedValues n
    tvNew TaggedValues n
    tv  = TaggedValues n
    tv { incoming = incoming tvNew ++ incoming tv
                                   , outgoing = outgoing tvNew ++ outgoing tv
                                   }

    -- Perform a DFS to determine whether or not to keep each edge.
    traverseTag     :: (Ord n) => Tag -> n -> TagState n ()
    traverseTag :: forall n. Ord n => Int -> n -> TagState n ()
    traverseTag Int
    t n
    n = do Bool -> TagState n ()
    setMark Bool
    True
                         TagState n ()
    checkIncoming
                         outEs <- (TagMap n -> [TaggedEdge n]) -> TagState n [TaggedEdge n]
    forall n a. (TagMap n -> a) -> TagState n a
    getsMap ([TaggedEdge n]
    -> (TaggedValues n -> [TaggedEdge n])
    -> Maybe (TaggedValues n)
    -> [TaggedEdge n]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] TaggedValues n -> [TaggedEdge n]
    forall n. TaggedValues n -> [TaggedEdge n]
    outgoing (Maybe (TaggedValues n) -> [TaggedEdge n])
    -> (TagMap n -> Maybe (TaggedValues n))
    -> TagMap n
    -> [TaggedEdge n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> TagMap n -> Maybe (TaggedValues n)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup n
    n)
                         mapM_ maybeRecurse outEs
                         setMark False
      where
        setMark :: Bool -> TagState n ()
    setMark Bool
    mrk = (TagMap n -> TagMap n) -> TagState n ()
    forall n. (TagMap n -> TagMap n) -> TagState n ()
    modifyMap ((TaggedValues n -> TaggedValues n) -> n -> TagMap n -> TagMap n
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust (\TaggedValues n
    tv -> TaggedValues n
    tv { marked = mrk }) n
    n)

        isMarked :: Map k (TaggedValues n) -> k -> Bool
    isMarked Map k (TaggedValues n)
    m k
    n' = Bool -> (TaggedValues n -> Bool) -> Maybe (TaggedValues n) -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False TaggedValues n -> Bool
    forall n. TaggedValues n -> Bool
    marked (Maybe (TaggedValues n) -> Bool) -> Maybe (TaggedValues n) -> Bool
    forall a b. (a -> b) -> a -> b
    $ k
    n' k -> Map k (TaggedValues n) -> Maybe (TaggedValues n)
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map k (TaggedValues n)
    m

        checkIncoming :: TagState n ()
    checkIncoming = do m <- ((TagMap n, TagSet) -> TagMap n)
    -> StateT (TagMap n, TagSet) Identity (TagMap n)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (TagMap n, TagSet) -> TagMap n
    forall a b. (a, b) -> a
    fst
                           let es = TaggedValues n -> [TaggedEdge n]
    forall n. TaggedValues n -> [TaggedEdge n]
    incoming (TaggedValues n -> [TaggedEdge n])
    -> TaggedValues n -> [TaggedEdge n]
    forall a b. (a -> b) -> a -> b
    $ TagMap n
    m TagMap n -> n -> TaggedValues n
    forall k a. Ord k => Map k a -> k -> a
    Map.! n
    n
                               (keepEs, delEs) = partition (keepEdge m) es
                           modifyMap (Map.adjust (\TaggedValues n
    tv -> TaggedValues n
    tv {incoming = keepEs}) n)
                           modifySet (Set.union $ Set.fromList (map fst delEs))
                           mapM_ delOtherEdge delEs
          where
            keepEdge :: Map k (TaggedValues n) -> (Int, DotEdge k) -> Bool
    keepEdge Map k (TaggedValues n)
    m (Int
    t',DotEdge k
    e) = Int
    t Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    t' Bool -> Bool -> Bool
    || Bool -> Bool
    not (Map k (TaggedValues n) -> k -> Bool
    forall {k} {n}. Ord k => Map k (TaggedValues n) -> k -> Bool
    isMarked Map k (TaggedValues n)
    m (k -> Bool) -> k -> Bool
    forall a b. (a -> b) -> a -> b
    $ DotEdge k -> k
    forall n. DotEdge n -> n
    fromNode DotEdge k
    e)

            delOtherEdge :: TaggedEdge n -> TagState n ()
    delOtherEdge TaggedEdge n
    te = (TagMap n -> TagMap n) -> TagState n ()
    forall n. (TagMap n -> TagMap n) -> TagState n ()
    modifyMap ((TaggedValues n -> TaggedValues n) -> n -> TagMap n -> TagMap n
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust TaggedValues n -> TaggedValues n
    delE (n -> TagMap n -> TagMap n)
    -> (DotEdge n -> n) -> DotEdge n -> TagMap n -> TagMap n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotEdge n -> n
    forall n. DotEdge n -> n
    fromNode (DotEdge n -> TagMap n -> TagMap n)
    -> DotEdge n -> TagMap n -> TagMap n
    forall a b. (a -> b) -> a -> b
    $ TaggedEdge n -> DotEdge n
    forall a b. (a, b) -> b
    snd TaggedEdge n
    te)
              where
                delE :: TaggedValues n -> TaggedValues n
    delE TaggedValues n
    tv = TaggedValues n
    tv {outgoing = deleteBy ((==) `on` fst) te $ outgoing tv}

        maybeRecurse :: (Int, DotEdge n) -> StateT (TagMap n, TagSet) Identity ()
    maybeRecurse (Int
    t',DotEdge n
    e) = do m <- TagState n (TagMap n)
    forall n. TagState n (TagMap n)
    getMap
                                 delSet <- getSet
                                 let n' = DotEdge n -> n
    forall n. DotEdge n -> n
    toNode DotEdge n
    e
                                 unless (isMarked m n' || t' `Set.member` delSet)
                                   $ traverseTag t' n'