{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
module Distribution.Compat.Graph (
    
    Graph,
    IsNode(..),
    
    null,
    size,
    member,
    lookup,
    
    empty,
    insert,
    deleteKey,
    deleteLookup,
    
    unionLeft,
    unionRight,
    
    stronglyConnComp,
    SCC(..),
    cycles,
    broken,
    neighbors,
    revNeighbors,
    closure,
    revClosure,
    topSort,
    revTopSort,
    
    
    toMap,
    
    fromDistinctList,
    toList,
    keys,
    
    keysSet,
    
    toGraph,
    
    Node(..),
    nodeValue,
) where
import Distribution.Compat.Prelude hiding (empty, lookup, null, toList)
import Prelude ()
import Data.Array                    ((!))
import Data.Graph                    (SCC (..))
import Distribution.Utils.Structured (Structure (..), Structured (..))
import qualified Data.Array                  as Array
import qualified Data.Foldable               as Foldable
import qualified Data.Graph                  as G
import qualified Data.Map.Strict             as Map
import qualified Data.Set                    as Set
import qualified Data.Tree                   as Tree
import qualified Distribution.Compat.Prelude as Prelude
data Graph a
    = Graph {
        forall a. Graph a -> Map (Key a) a
graphMap          :: !(Map (Key a) a),
        
        forall a. Graph a -> Graph
graphForward      :: G.Graph,
        forall a. Graph a -> Graph
graphAdjoint      :: G.Graph,
        forall a. Graph a -> Vertex -> a
graphVertexToNode :: G.Vertex -> a,
        forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex  :: Key a -> Maybe G.Vertex,
        forall a. Graph a -> [(a, [Key a])]
graphBroken       :: [(a, [Key a])]
    }
    deriving (Typeable)
instance Show a => Show (Graph a) where
    show :: Graph a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Graph a -> [a]) -> Graph a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [a]
forall a. Graph a -> [a]
toList
instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where
    readsPrec :: Vertex -> ReadS (Graph a)
readsPrec Vertex
d String
s = (([a], String) -> (Graph a, String))
-> [([a], String)] -> [(Graph a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
a,String
r) -> ([a] -> Graph a
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList [a]
a, String
r)) (Vertex -> ReadS [a]
forall a. Read a => Vertex -> ReadS a
readsPrec Vertex
d String
s)
instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where
    put :: Graph a -> Put
put Graph a
x = [a] -> Put
forall t. Binary t => t -> Put
put (Graph a -> [a]
forall a. Graph a -> [a]
toList Graph a
x)
    get :: Get (Graph a)
get = ([a] -> Graph a) -> Get [a] -> Get (Graph a)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Graph a
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList Get [a]
forall t. Binary t => Get t
get
instance Structured a => Structured (Graph a) where
    structure :: Proxy (Graph a) -> Structure
structure Proxy (Graph a)
p = TypeRep -> TypeVersion -> String -> [Structure] -> Structure
Nominal (Proxy (Graph a) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy (Graph a)
p) TypeVersion
0 String
"Graph" [Proxy a -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)]
instance (Eq (Key a), Eq a) => Eq (Graph a) where
    Graph a
g1 == :: Graph a -> Graph a -> Bool
== Graph a
g2 = Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap Graph a
g1 Map (Key a) a -> Map (Key a) a -> Bool
forall a. Eq a => a -> a -> Bool
== Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap Graph a
g2
instance Foldable.Foldable Graph where
    fold :: forall m. Monoid m => Graph m -> m
fold = Map (Key m) m -> m
forall m. Monoid m => Map (Key m) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (Map (Key m) m -> m) -> (Graph m -> Map (Key m) m) -> Graph m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph m -> Map (Key m) m
forall a. Graph a -> Map (Key a) a
graphMap
    foldr :: forall a b. (a -> b -> b) -> b -> Graph a -> b
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> Map (Key a) a -> b
forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> b -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldl :: forall b a. (b -> a -> b) -> b -> Graph a -> b
foldl b -> a -> b
f b
z = (b -> a -> b) -> b -> Map (Key a) a -> b
forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl b -> a -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldMap :: forall m a. Monoid m => (a -> m) -> Graph a -> m
foldMap a -> m
f = (a -> m) -> Map (Key a) a -> m
forall m a. Monoid m => (a -> m) -> Map (Key a) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap a -> m
f (Map (Key a) a -> m) -> (Graph a -> Map (Key a) a) -> Graph a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldl' :: forall b a. (b -> a -> b) -> b -> Graph a -> b
foldl' b -> a -> b
f b
z = (b -> a -> b) -> b -> Map (Key a) a -> b
forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' b -> a -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldr' :: forall a b. (a -> b -> b) -> b -> Graph a -> b
foldr' a -> b -> b
f b
z = (a -> b -> b) -> b -> Map (Key a) a -> b
forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr' a -> b -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
#ifdef MIN_VERSION_base
#if MIN_VERSION_base(4,8,0)
    length :: forall a. Graph a -> Vertex
length = Map (Key a) a -> Vertex
forall a. Map (Key a) a -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
Foldable.length (Map (Key a) a -> Vertex)
-> (Graph a -> Map (Key a) a) -> Graph a -> Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    null :: forall a. Graph a -> Bool
null   = Map (Key a) a -> Bool
forall a. Map (Key a) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null   (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    toList :: forall a. Graph a -> [a]
toList = Map (Key a) a -> [a]
forall a. Map (Key a) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Map (Key a) a -> [a])
-> (Graph a -> Map (Key a) a) -> Graph a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    elem :: forall a. Eq a => a -> Graph a -> Bool
elem a
x = a -> Map (Key a) a -> Bool
forall a. Eq a => a -> Map (Key a) a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Foldable.elem a
x (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    maximum :: forall a. Ord a => Graph a -> a
maximum = Map (Key a) a -> a
forall a. Ord a => Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.maximum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    minimum :: forall a. Ord a => Graph a -> a
minimum = Map (Key a) a -> a
forall a. Ord a => Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.minimum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    sum :: forall a. Num a => Graph a -> a
sum     = Map (Key a) a -> a
forall a. Num a => Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.sum     (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    product :: forall a. Num a => Graph a -> a
product = Map (Key a) a -> a
forall a. Num a => Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.product (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
#endif
#endif
instance (NFData a, NFData (Key a)) => NFData (Graph a) where
    rnf :: Graph a -> ()
rnf Graph {
        graphMap :: forall a. Graph a -> Map (Key a) a
graphMap = Map (Key a) a
m,
        graphForward :: forall a. Graph a -> Graph
graphForward = Graph
gf,
        graphAdjoint :: forall a. Graph a -> Graph
graphAdjoint = Graph
ga,
        graphVertexToNode :: forall a. Graph a -> Vertex -> a
graphVertexToNode = Vertex -> a
vtn,
        graphKeyToVertex :: forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex = Key a -> Maybe Vertex
ktv,
        graphBroken :: forall a. Graph a -> [(a, [Key a])]
graphBroken = [(a, [Key a])]
b
    } = Graph
gf Graph -> () -> ()
forall a b. a -> b -> b
`seq` Graph
ga Graph -> () -> ()
forall a b. a -> b -> b
`seq` Vertex -> a
vtn (Vertex -> a) -> () -> ()
forall a b. a -> b -> b
`seq` Key a -> Maybe Vertex
ktv (Key a -> Maybe Vertex) -> () -> ()
forall a b. a -> b -> b
`seq` [(a, [Key a])]
b [(a, [Key a])] -> () -> ()
forall a b. a -> b -> b
`seq` Map (Key a) a -> ()
forall a. NFData a => a -> ()
rnf Map (Key a) a
m
class Ord (Key a) => IsNode a where
    type Key a
    nodeKey :: a -> Key a
    nodeNeighbors :: a -> [Key a]
instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where
    type Key (Either a b) = Key a
    nodeKey :: Either a b -> Key (Either a b)
nodeKey (Left a
x)  = a -> Key a
forall a. IsNode a => a -> Key a
nodeKey a
x
    nodeKey (Right b
x) = b -> Key b
forall a. IsNode a => a -> Key a
nodeKey b
x
    nodeNeighbors :: Either a b -> [Key (Either a b)]
nodeNeighbors (Left a
x)  = a -> [Key a]
forall a. IsNode a => a -> [Key a]
nodeNeighbors a
x
    nodeNeighbors (Right b
x) = b -> [Key b]
forall a. IsNode a => a -> [Key a]
nodeNeighbors b
x
data Node k a = N a k [k]
    deriving (Vertex -> Node k a -> ShowS
[Node k a] -> ShowS
Node k a -> String
(Vertex -> Node k a -> ShowS)
-> (Node k a -> String) -> ([Node k a] -> ShowS) -> Show (Node k a)
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS
forall k a. (Show a, Show k) => [Node k a] -> ShowS
forall k a. (Show a, Show k) => Node k a -> String
$cshowsPrec :: forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS
showsPrec :: Vertex -> Node k a -> ShowS
$cshow :: forall k a. (Show a, Show k) => Node k a -> String
show :: Node k a -> String
$cshowList :: forall k a. (Show a, Show k) => [Node k a] -> ShowS
showList :: [Node k a] -> ShowS
Show, Node k a -> Node k a -> Bool
(Node k a -> Node k a -> Bool)
-> (Node k a -> Node k a -> Bool) -> Eq (Node k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
$c== :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
== :: Node k a -> Node k a -> Bool
$c/= :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
/= :: Node k a -> Node k a -> Bool
Eq)
nodeValue :: Node k a -> a
nodeValue :: forall k a. Node k a -> a
nodeValue (N a
a k
_ [k]
_) = a
a
instance Functor (Node k) where
    fmap :: forall a b. (a -> b) -> Node k a -> Node k b
fmap a -> b
f (N a
a k
k [k]
ks) = b -> k -> [k] -> Node k b
forall k a. a -> k -> [k] -> Node k a
N (a -> b
f a
a) k
k [k]
ks
instance Ord k => IsNode (Node k a) where
    type Key (Node k a) = k
    nodeKey :: Node k a -> Key (Node k a)
nodeKey (N a
_ k
k [k]
_) = k
Key (Node k a)
k
    nodeNeighbors :: Node k a -> [Key (Node k a)]
nodeNeighbors (N a
_ k
_ [k]
ks) = [k]
[Key (Node k a)]
ks
null :: Graph a -> Bool
null :: forall a. Graph a -> Bool
null = Map (Key a) a -> Bool
forall k a. Map k a -> Bool
Map.null (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap
size :: Graph a -> Int
size :: forall a. Graph a -> Vertex
size = Map (Key a) a -> Vertex
forall k a. Map k a -> Vertex
Map.size (Map (Key a) a -> Vertex)
-> (Graph a -> Map (Key a) a) -> Graph a -> Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap
member :: IsNode a => Key a -> Graph a -> Bool
member :: forall a. IsNode a => Key a -> Graph a -> Bool
member Key a
k Graph a
g = Key a -> Map (Key a) a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
lookup :: IsNode a => Key a -> Graph a -> Maybe a
lookup :: forall a. IsNode a => Key a -> Graph a -> Maybe a
lookup Key a
k Graph a
g = Key a -> Map (Key a) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
empty :: IsNode a => Graph a
empty :: forall a. IsNode a => Graph a
empty = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap Map (Key a) a
forall k a. Map k a
Map.empty
insert :: IsNode a => a -> Graph a -> Graph a
insert :: forall a. IsNode a => a -> Graph a -> Graph a
insert !a
n Graph a
g = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap (Key a -> a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> Key a
forall a. IsNode a => a -> Key a
nodeKey a
n) a
n (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))
deleteKey :: IsNode a => Key a -> Graph a -> Graph a
deleteKey :: forall a. IsNode a => Key a -> Graph a -> Graph a
deleteKey Key a
k Graph a
g = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap (Key a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))
deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a)
deleteLookup :: forall a. IsNode a => Key a -> Graph a -> (Maybe a, Graph a)
deleteLookup Key a
k Graph a
g =
    let (Maybe a
r, Map (Key a) a
m') = (Key a -> a -> Maybe a)
-> Key a -> Map (Key a) a -> (Maybe a, Map (Key a) a)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\Key a
_ a
_ -> Maybe a
forall a. Maybe a
Nothing) Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
    in (Maybe a
r, Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap Map (Key a) a
m')
unionRight :: IsNode a => Graph a -> Graph a -> Graph a
unionRight :: forall a. IsNode a => Graph a -> Graph a -> Graph a
unionRight Graph a
g Graph a
g' = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap (Map (Key a) a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g') (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))
unionLeft :: IsNode a => Graph a -> Graph a -> Graph a
unionLeft :: forall a. IsNode a => Graph a -> Graph a -> Graph a
unionLeft = (Graph a -> Graph a -> Graph a) -> Graph a -> Graph a -> Graph a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Graph a -> Graph a -> Graph a
forall a. IsNode a => Graph a -> Graph a -> Graph a
unionRight
stronglyConnComp :: Graph a -> [SCC a]
stronglyConnComp :: forall a. Graph a -> [SCC a]
stronglyConnComp Graph a
g = (Tree Vertex -> SCC a) -> [Tree Vertex] -> [SCC a]
forall a b. (a -> b) -> [a] -> [b]
map Tree Vertex -> SCC a
decode [Tree Vertex]
forest
  where
    forest :: [Tree Vertex]
forest = Graph -> [Tree Vertex]
G.scc (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g)
    decode :: Tree Vertex -> SCC a
decode (Tree.Node Vertex
v [])
        | Vertex -> Bool
mentions_itself Vertex
v = [a] -> SCC a
forall vertex. [vertex] -> SCC vertex
CyclicSCC  [Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v]
        | Bool
otherwise         = a -> SCC a
forall vertex. vertex -> SCC vertex
AcyclicSCC (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v)
    decode Tree Vertex
other = [a] -> SCC a
forall vertex. [vertex] -> SCC vertex
CyclicSCC (Tree Vertex -> [a] -> [a]
dec Tree Vertex
other [])
        where dec :: Tree Vertex -> [a] -> [a]
dec (Tree.Node Vertex
v [Tree Vertex]
ts) [a]
vs
                = Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Tree Vertex -> [a] -> [a]) -> [a] -> [Tree Vertex] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree Vertex -> [a] -> [a]
dec [a]
vs [Tree Vertex]
ts
    mentions_itself :: Vertex -> Bool
mentions_itself Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v)
cycles :: Graph a -> [[a]]
cycles :: forall a. Graph a -> [[a]]
cycles Graph a
g = [ [a]
vs | CyclicSCC [a]
vs <- Graph a -> [SCC a]
forall a. Graph a -> [SCC a]
stronglyConnComp Graph a
g ]
broken :: Graph a -> [(a, [Key a])]
broken :: forall a. Graph a -> [(a, [Key a])]
broken Graph a
g = Graph a -> [(a, [Key a])]
forall a. Graph a -> [(a, [Key a])]
graphBroken Graph a
g
neighbors :: Graph a -> Key a -> Maybe [a]
neighbors :: forall a. Graph a -> Key a -> Maybe [a]
neighbors Graph a
g Key a
k = do
    Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
    [a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v))
revNeighbors :: Graph a -> Key a -> Maybe [a]
revNeighbors :: forall a. Graph a -> Key a -> Maybe [a]
revNeighbors Graph a
g Key a
k = do
    Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
    [a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v))
closure :: Graph a -> [Key a] -> Maybe [a]
closure :: forall a. Graph a -> [Key a] -> Maybe [a]
closure Graph a
g [Key a]
ks = do
    [Vertex]
vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g) [Key a]
ks
    [a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g) [Vertex]
vs))
revClosure :: Graph a -> [Key a] -> Maybe [a]
revClosure :: forall a. Graph a -> [Key a] -> Maybe [a]
revClosure Graph a
g [Key a]
ks = do
    [Vertex]
vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g) [Key a]
ks
    [a] -> Maybe [a]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g) [Vertex]
vs))
flattenForest :: Tree.Forest a -> [a]
flattenForest :: forall a. Forest a -> [a]
flattenForest = (Tree a -> [a]) -> [Tree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
forall a. Tree a -> [a]
Tree.flatten
decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]
decodeVertexForest :: forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a])
-> ([Tree Vertex] -> [Vertex]) -> [Tree Vertex] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Vertex] -> [Vertex]
forall a. Forest a -> [a]
flattenForest
topSort :: Graph a -> [a]
topSort :: forall a. Graph a -> [a]
topSort Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a]) -> [Vertex] -> [a]
forall a b. (a -> b) -> a -> b
$ Graph -> [Vertex]
G.topSort (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g)
revTopSort :: Graph a -> [a]
revTopSort :: forall a. Graph a -> [a]
revTopSort Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a]) -> [Vertex] -> [a]
forall a b. (a -> b) -> a -> b
$ Graph -> [Vertex]
G.topSort (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g)
fromMap :: IsNode a => Map (Key a) a -> Graph a
fromMap :: forall a. IsNode a => Map (Key a) a -> Graph a
fromMap Map (Key a) a
m
    = Graph { graphMap :: Map (Key a) a
graphMap = Map (Key a) a
m
            
            , graphForward :: Graph
graphForward = Graph
g
            , graphAdjoint :: Graph
graphAdjoint = Graph -> Graph
G.transposeG Graph
g
            , graphVertexToNode :: Vertex -> a
graphVertexToNode = Vertex -> a
vertex_to_node
            , graphKeyToVertex :: Key a -> Maybe Vertex
graphKeyToVertex = Key a -> Maybe Vertex
key_to_vertex
            , graphBroken :: [(a, [Key a])]
graphBroken = [(a, [Key a])]
broke
            }
  where
    try_key_to_vertex :: Key a -> Either (Key a) Vertex
try_key_to_vertex Key a
k = Either (Key a) Vertex
-> (Vertex -> Either (Key a) Vertex)
-> Maybe Vertex
-> Either (Key a) Vertex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key a -> Either (Key a) Vertex
forall a b. a -> Either a b
Left Key a
k) Vertex -> Either (Key a) Vertex
forall a b. b -> Either a b
Right (Key a -> Maybe Vertex
key_to_vertex Key a
k)
    ([[Key a]]
brokenEdges, [[Vertex]]
edges)
        = [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]])
forall a b. [(a, b)] -> ([a], [b])
unzip
        ([([Key a], [Vertex])] -> ([[Key a]], [[Vertex]]))
-> [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]])
forall a b. (a -> b) -> a -> b
$ [ [Either (Key a) Vertex] -> ([Key a], [Vertex])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Key a -> Either (Key a) Vertex)
-> [Key a] -> [Either (Key a) Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Key a -> Either (Key a) Vertex
try_key_to_vertex (a -> [Key a]
forall a. IsNode a => a -> [Key a]
nodeNeighbors a
n))
          | a
n <- [a]
ns ]
    broke :: [(a, [Key a])]
broke = ((a, [Key a]) -> Bool) -> [(a, [Key a])] -> [(a, [Key a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, [Key a]) -> Bool) -> (a, [Key a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null ([Key a] -> Bool)
-> ((a, [Key a]) -> [Key a]) -> (a, [Key a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Key a]) -> [Key a]
forall a b. (a, b) -> b
snd) ([a] -> [[Key a]] -> [(a, [Key a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ns [[Key a]]
brokenEdges)
    g :: Graph
g = (Vertex, Vertex) -> [[Vertex]] -> Graph
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Vertex, Vertex)
bounds [[Vertex]]
edges
    ns :: [a]
ns              = Map (Key a) a -> [a]
forall k a. Map k a -> [a]
Map.elems Map (Key a) a
m 
    vertices :: [(Key a, Vertex)]
vertices        = [Key a] -> [Vertex] -> [(Key a, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> Key a) -> [a] -> [Key a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Key a
forall a. IsNode a => a -> Key a
nodeKey [a]
ns) [Vertex
0..]
    vertex_map :: Map (Key a) Vertex
vertex_map      = [(Key a, Vertex)] -> Map (Key a) Vertex
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [(Key a, Vertex)]
vertices
    key_to_vertex :: Key a -> Maybe Vertex
key_to_vertex Key a
k = Key a -> Map (Key a) Vertex -> Maybe Vertex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key a
k Map (Key a) Vertex
vertex_map
    vertex_to_node :: Vertex -> a
vertex_to_node Vertex
vertex = Array Vertex a
nodeTable Array Vertex a -> Vertex -> a
forall i e. Ix i => Array i e -> i -> e
! Vertex
vertex
    nodeTable :: Array Vertex a
nodeTable   = (Vertex, Vertex) -> [a] -> Array Vertex a
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Vertex, Vertex)
bounds [a]
ns
    bounds :: (Vertex, Vertex)
bounds = (Vertex
0, Map (Key a) a -> Vertex
forall k a. Map k a -> Vertex
Map.size Map (Key a) a
m Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
- Vertex
1)
fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList :: forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
fromMap
                 (Map (Key a) a -> Graph a)
-> ([a] -> Map (Key a) a) -> [a] -> Graph a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [(Key a, a)] -> Map (Key a) a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\a
_ -> a -> a
forall {a} {a}. (Show (Key a), IsNode a) => a -> a
duplicateError)
                 ([(Key a, a)] -> Map (Key a) a)
-> ([a] -> [(Key a, a)]) -> [a] -> Map (Key a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Key a, a)) -> [a] -> [(Key a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
n -> a
n a -> (Key a, a) -> (Key a, a)
forall a b. a -> b -> b
`seq` (a -> Key a
forall a. IsNode a => a -> Key a
nodeKey a
n, a
n))
  where
    duplicateError :: a -> a
duplicateError a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Graph.fromDistinctList: duplicate key: "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key a -> String
forall a. Show a => a -> String
show (a -> Key a
forall a. IsNode a => a -> Key a
nodeKey a
n)
toList :: Graph a -> [a]
toList :: forall a. Graph a -> [a]
toList Graph a
g = Map (Key a) a -> [a]
forall k a. Map k a -> [a]
Map.elems (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
keys :: Graph a -> [Key a]
keys :: forall a. Graph a -> [Key a]
keys Graph a
g = Map (Key a) a -> [Key a]
forall k a. Map k a -> [k]
Map.keys (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
keysSet :: Graph a -> Set.Set (Key a)
keysSet :: forall a. Graph a -> Set (Key a)
keysSet Graph a
g = Map (Key a) a -> Set (Key a)
forall k a. Map k a -> Set k
Map.keysSet (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
toMap :: Graph a -> Map (Key a) a
toMap :: forall a. Graph a -> Map (Key a) a
toMap = Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex)
toGraph :: forall a. Graph a -> (Graph, Vertex -> a, Key a -> Maybe Vertex)
toGraph Graph a
g = (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g, Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g, Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g)