module Data.Graph.Comfort (
   -- * Types
   Graph,
   LabeledNode,
   LabeledEdge,
   Edge(from, to), defaultEdgeFoldMap,
   DirEdge(DirEdge),
   UndirEdge(UndirEdge), undirEdge,
   EitherEdge(EDirEdge,EUndirEdge),

   -- * Construction
   empty, fromList, fromMap,

   -- * Extract large portions of the graph
   graphMap,
   nodeLabels, nodeSet, nodes, nodeEdges,
   edgeLabels, edgeSet, edges,

   -- * Queries
   isEmpty,
   lookupNode, lookupEdge,
   predecessors, successors,
   adjacentEdgeSet, adjacentEdges,
   isLoop,
   pathExists,
   depthFirstSearch,
   topologicalSort,
   components,
   isConsistent,
   stronglyConnectedComponents,

   -- * Manipulate labels
   mapNode, mapNodeWithKey,
   mapEdge, mapEdgeWithKey,
   mapNodeWithInOut, InOut,
   filterEdgeWithKey,
   traverseNode, traverseEdge, traverse,

   -- * Combine graphs
   checkedZipWith,
   union,

   -- * Manipulate indices
   Reverse,
   reverse,
   reverseEdge,
   mapKeys,
   mapMaybeEdgeKeys,
   mapEdgeKeys,

   -- * Insertion and removal
   deleteNode, deleteNodeSet, deleteEdge,
   insertNode, insertEdge, insertEdgeSet,
   ) where

import qualified Data.Graph.Comfort.Map as MapU
import qualified Data.Graph.Comfort.TotalMap as TMap

import qualified Control.Monad.Trans.State as MS
import Control.Monad.Trans.Identity (IdentityT(IdentityT, runIdentityT))
import Control.Monad (liftM2, when, (=<<))
import Control.Applicative (Applicative, liftA2, liftA3, pure)
import Data.Functor.Classes
         (Eq1(liftEq), Ord1(liftCompare), Show1(liftShowsPrec))

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Tree as Tree
import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import Data.Foldable (Foldable, foldMap)
import Data.Map (Map)
import Data.Set (Set)
import Data.Tree (Tree, Forest)
import Data.Monoid
         (Monoid, mempty, mappend, All(All), getAll, Endo(Endo), appEndo)
import Data.Semigroup (Semigroup((<>)), )
import Data.Tuple.HT (mapFst, fst3, snd3, thd3, mapFst3, mapThd3)

import qualified Test.QuickCheck as QC

import qualified Data.List as List
import Data.Functor (Functor, fmap)
import Data.List (map, any, all, (++))
import Data.String (String)
import Data.Maybe (Maybe(Nothing, Just), catMaybes)
import Data.Bool (Bool(False), not, (&&), (||))
import Data.Eq (Eq, (==))
import Data.Ord (Ord, Ordering(LT,GT), (<), (>))
import Data.Tuple (uncurry)
import Data.Function (flip, (.), ($))
import Data.Int (Int)
import Text.Show
         (Show, ShowS, showParen, showString, showChar, shows, showsPrec)

import Prelude (error)


{- $setup
>>> import Test.Base
>>>
>>> import qualified Data.Graph.Comfort as Graph
>>> import qualified Data.Map as Map
>>> import qualified Data.Set as Set
>>> import qualified Data.Char as Char
>>> import Data.Graph.Comfort (Graph, DirEdge(DirEdge), UndirEdge(UndirEdge))
>>> import Data.Tuple.HT (mapSnd)
>>>
>>> import qualified Control.Monad.Trans.Class as MT
>>> import qualified Control.Monad.Trans.State as MS
>>> import Control.Applicative (pure)
>>> import Data.Functor.Identity (Identity(Identity), runIdentity)
>>>
>>> import qualified Test.QuickCheck as QC
>>> import Test.QuickCheck ((==>))
>>>
>>> deleteNodeIfExists :: Node -> MonoGraph -> MonoGraph
>>> deleteNodeIfExists n gr =
>>>    maybe gr (const $ Graph.deleteNode n gr) $ Graph.lookupNode n gr
>>>
>>> isolated :: (Graph.Edge e, Ord n) => Graph.Graph e n el nl -> n -> Bool
>>> isolated gr n = Set.null (Graph.adjacentEdgeSet gr n)
>>>
>>> nodeAction :: (Monad m) => NodeLabel -> MS.StateT NodeLabel m NodeLabel
>>> nodeAction x = do y <- MS.get; MS.put x; return y
>>>
>>> evalTraverseNode :: NodeLabel -> MonoGraph -> MonoGraph
>>> evalTraverseNode nl =
>>>    flip MS.evalState nl . Graph.traverseNode nodeAction
>>>
>>> edgeAction :: (Monad m) => EdgeLabel -> MS.StateT EdgeLabel m EdgeLabel
>>> edgeAction x = MS.modify (x+) >> MS.get
>>>
>>> evalTraverseEdge :: EdgeLabel -> MonoGraph -> MonoGraph
>>> evalTraverseEdge el =
>>>    flip MS.evalState el . Graph.traverseEdge edgeAction
>>>
>>> evalTraverse :: NodeLabel -> EdgeLabel -> MonoGraph -> MonoGraph
>>> evalTraverse nl el =
>>>    flip MS.evalState el . flip MS.evalStateT nl .
>>>    Graph.traverse nodeAction (MT.lift . edgeAction)
>>>
>>>
>>> (*-*) :: n -> n -> UndirEdge n
>>> (*-*) = UndirEdge
>>>
>>> (*->) :: n -> n -> DirEdge n
>>> (*->) = DirEdge
>>>
>>> unlabGraph ::
>>>    (Graph.Edge edge, Ord (edge node), Ord node) =>
>>>    [node] -> [edge node] -> Graph edge node () ()
>>> unlabGraph ns es =
>>>    let label = map (flip (,) ()) in
>>>    Graph.fromMap
>>>       (Map.fromList $ label $ ns ++ map Graph.from es ++ map Graph.to es)
>>>       (Map.fromList $ label es)
>>>
>>> addReversedEdges ::
>>>    (Ord node) => Graph DirEdge node el nl -> Graph DirEdge node el nl
>>> addReversedEdges gr =
>>>    Graph.fromMap
>>>       (Graph.nodeLabels gr)
>>>       (Map.union
>>>         (Graph.edgeLabels gr)
>>>         (Map.mapKeys (\(Graph.DirEdge f t) -> Graph.DirEdge t f) $
>>>            Graph.edgeLabels gr))
-}

{-
For all 'Graph's the 'isConsistent' predicate must be 'True'.
-}
newtype Graph edge node edgeLabel nodeLabel =
   Graph {
      forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap ::
         Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
   } deriving (Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (edge :: * -> *) node edgeLabel nodeLabel.
(Eq1 edge, Eq node, Eq edgeLabel, Eq nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
/= :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c/= :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Eq1 edge, Eq node, Eq edgeLabel, Eq nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
== :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c== :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Eq1 edge, Eq node, Eq edgeLabel, Eq nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
Eq, Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Ordering
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
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 {edge :: * -> *} {node} {edgeLabel} {nodeLabel}.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Eq (Graph edge node edgeLabel nodeLabel)
forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Ordering
forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
min :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
$cmin :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
max :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
$cmax :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
>= :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c>= :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
> :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c> :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
<= :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c<= :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
< :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
$c< :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Bool
compare :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Ordering
$ccompare :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Ord1 edge, Ord node, Ord edgeLabel, Ord nodeLabel) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel -> Ordering
Ord)

instance
   (Edge e, Ord n, Show1 e, Show n, Show el, Show nl) =>
      Show (Graph e n el nl) where
   showsPrec :: Int -> Graph e n el nl -> ShowS
showsPrec Int
prec Graph e n el nl
g =
      Bool -> ShowS -> ShowS
showParen (Int
precforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
         String -> ShowS
showString String
"Graph.fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => a -> ShowS
shows (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> Map n nl
nodeLabels Graph e n el nl
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => a -> ShowS
shows (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Map (Wrap edge node) edgeLabel
edgeLabelsWrap Graph e n el nl
g)


isConsistent :: (Ord n, Eq el) => Graph DirEdge n el nl -> Bool
isConsistent :: forall n el nl. (Ord n, Eq el) => Graph DirEdge n el nl -> Bool
isConsistent (Graph Map n (InOutMap (IdentityT DirEdge) n el nl)
ns) =
   forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b c. (a, b, c) -> a
fst3 Map n (InOutMap (IdentityT DirEdge) n el nl)
ns forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b c. (a, b, c) -> c
thd3 Map n (InOutMap (IdentityT DirEdge) n el nl)
ns
   Bool -> Bool -> Bool
&&
   forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
      (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> Set a
Set.singleton) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3) Map n (InOutMap (IdentityT DirEdge) n el nl)
ns)
      (forall k a. Map k a -> Set k
Map.keysSet Map n (InOutMap (IdentityT DirEdge) n el nl)
ns)
   Bool -> Bool -> Bool
&&
   (forall (t :: * -> *). Foldable t => t Bool -> Bool
Fold.and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Map n (InOutMap (IdentityT DirEdge) n el nl)
ns forall a b. (a -> b) -> a -> b
$
      \n
n (Map (Wrap DirEdge n) el
ins,nl
_nl,Map (Wrap DirEdge n) el
outs) ->
         forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((n
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap) (forall k a. Map k a -> [k]
Map.keys Map (Wrap DirEdge n) el
ins) Bool -> Bool -> Bool
&&
         forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((n
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap) (forall k a. Map k a -> [k]
Map.keys Map (Wrap DirEdge n) el
outs))


type LabeledNode n label = (n, label)


defaultEdgeFoldMap :: (Edge edge, Monoid a) => edge a -> a
defaultEdgeFoldMap :: forall (edge :: * -> *) a. (Edge edge, Monoid a) => edge a -> a
defaultEdgeFoldMap edge a
e = forall a. Monoid a => a -> a -> a
mappend (forall (edge :: * -> *) node. Edge edge => edge node -> node
from edge a
e) (forall (edge :: * -> *) node. Edge edge => edge node -> node
to edge a
e)

class (Foldable edge, Ord1 edge) => Edge edge where
   from, to :: edge node -> node

instance Edge DirEdge where
   from :: forall node. DirEdge node -> node
from (DirEdge node
x node
_) = node
x
   to :: forall node. DirEdge node -> node
to (DirEdge node
_ node
x) = node
x

instance Edge UndirEdge where
   from :: forall node. UndirEdge node -> node
from (UndirEdge node
x node
_) = node
x
   to :: forall node. UndirEdge node -> node
to (UndirEdge node
_ node
x) = node
x

instance Edge EitherEdge where
   from :: forall node. EitherEdge node -> node
from EitherEdge node
ee =
      case EitherEdge node
ee of
         EDirEdge   DirEdge node
e -> forall (edge :: * -> *) node. Edge edge => edge node -> node
from DirEdge node
e
         EUndirEdge UndirEdge node
e -> forall (edge :: * -> *) node. Edge edge => edge node -> node
from UndirEdge node
e
   to :: forall node. EitherEdge node -> node
to EitherEdge node
ee =
      case EitherEdge node
ee of
         EDirEdge   DirEdge node
e -> forall (edge :: * -> *) node. Edge edge => edge node -> node
to DirEdge node
e
         EUndirEdge UndirEdge node
e -> forall (edge :: * -> *) node. Edge edge => edge node -> node
to UndirEdge node
e


{-
class (Edge edge) => ConsEdge edge where
   {- |
   The construction of an edge may fail
   and it is not warranted
   that @x == from (edge x y)@ or @y == to (edge x y)@.
   -}
   edge :: Ord node => node -> node -> Maybe (edge node)

instance ConsEdge DirEdge where
   edge x y = Just $ DirEdge x y

instance ConsEdge UndirEdge where
   edge x y = Just $ undirEdge x y
-}



type LabeledEdge edge node label = (edge node, label)


data DirEdge node = DirEdge node node
   deriving (DirEdge node -> DirEdge node -> Bool
forall node. Eq node => DirEdge node -> DirEdge node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirEdge node -> DirEdge node -> Bool
$c/= :: forall node. Eq node => DirEdge node -> DirEdge node -> Bool
== :: DirEdge node -> DirEdge node -> Bool
$c== :: forall node. Eq node => DirEdge node -> DirEdge node -> Bool
Eq, DirEdge node -> DirEdge node -> Bool
DirEdge node -> DirEdge node -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {node}. Ord node => Eq (DirEdge node)
forall node. Ord node => DirEdge node -> DirEdge node -> Bool
forall node. Ord node => DirEdge node -> DirEdge node -> Ordering
forall node.
Ord node =>
DirEdge node -> DirEdge node -> DirEdge node
min :: DirEdge node -> DirEdge node -> DirEdge node
$cmin :: forall node.
Ord node =>
DirEdge node -> DirEdge node -> DirEdge node
max :: DirEdge node -> DirEdge node -> DirEdge node
$cmax :: forall node.
Ord node =>
DirEdge node -> DirEdge node -> DirEdge node
>= :: DirEdge node -> DirEdge node -> Bool
$c>= :: forall node. Ord node => DirEdge node -> DirEdge node -> Bool
> :: DirEdge node -> DirEdge node -> Bool
$c> :: forall node. Ord node => DirEdge node -> DirEdge node -> Bool
<= :: DirEdge node -> DirEdge node -> Bool
$c<= :: forall node. Ord node => DirEdge node -> DirEdge node -> Bool
< :: DirEdge node -> DirEdge node -> Bool
$c< :: forall node. Ord node => DirEdge node -> DirEdge node -> Bool
compare :: DirEdge node -> DirEdge node -> Ordering
$ccompare :: forall node. Ord node => DirEdge node -> DirEdge node -> Ordering
Ord, Int -> DirEdge node -> ShowS
forall node. Show node => Int -> DirEdge node -> ShowS
forall node. Show node => [DirEdge node] -> ShowS
forall node. Show node => DirEdge node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirEdge node] -> ShowS
$cshowList :: forall node. Show node => [DirEdge node] -> ShowS
show :: DirEdge node -> String
$cshow :: forall node. Show node => DirEdge node -> String
showsPrec :: Int -> DirEdge node -> ShowS
$cshowsPrec :: forall node. Show node => Int -> DirEdge node -> ShowS
Show)

{- |
Danger:
Do not use the data constructor 'UndirEdge'
because it does not ensure ordering of members.
Use the smart constructor 'undirEdge' instead.

'UndirEdge' is not really an undirected edge.
It is more like a directed edge with a canonical direction.
Working with 'UndirEdge' requires caution.
In @Graph UndirEdge@ 'predecessors' are all edges to lower nodes
with respect to @Ord node@,
whereas 'successors' are all edges to higher nodes.
Thus you get all connection only when merging 'predecessors' and 'successors'.
-}
data UndirEdge node = UndirEdge node node
   deriving (UndirEdge node -> UndirEdge node -> Bool
forall node. Eq node => UndirEdge node -> UndirEdge node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UndirEdge node -> UndirEdge node -> Bool
$c/= :: forall node. Eq node => UndirEdge node -> UndirEdge node -> Bool
== :: UndirEdge node -> UndirEdge node -> Bool
$c== :: forall node. Eq node => UndirEdge node -> UndirEdge node -> Bool
Eq, UndirEdge node -> UndirEdge node -> Bool
UndirEdge node -> UndirEdge node -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {node}. Ord node => Eq (UndirEdge node)
forall node. Ord node => UndirEdge node -> UndirEdge node -> Bool
forall node.
Ord node =>
UndirEdge node -> UndirEdge node -> Ordering
forall node.
Ord node =>
UndirEdge node -> UndirEdge node -> UndirEdge node
min :: UndirEdge node -> UndirEdge node -> UndirEdge node
$cmin :: forall node.
Ord node =>
UndirEdge node -> UndirEdge node -> UndirEdge node
max :: UndirEdge node -> UndirEdge node -> UndirEdge node
$cmax :: forall node.
Ord node =>
UndirEdge node -> UndirEdge node -> UndirEdge node
>= :: UndirEdge node -> UndirEdge node -> Bool
$c>= :: forall node. Ord node => UndirEdge node -> UndirEdge node -> Bool
> :: UndirEdge node -> UndirEdge node -> Bool
$c> :: forall node. Ord node => UndirEdge node -> UndirEdge node -> Bool
<= :: UndirEdge node -> UndirEdge node -> Bool
$c<= :: forall node. Ord node => UndirEdge node -> UndirEdge node -> Bool
< :: UndirEdge node -> UndirEdge node -> Bool
$c< :: forall node. Ord node => UndirEdge node -> UndirEdge node -> Bool
compare :: UndirEdge node -> UndirEdge node -> Ordering
$ccompare :: forall node.
Ord node =>
UndirEdge node -> UndirEdge node -> Ordering
Ord, Int -> UndirEdge node -> ShowS
forall node. Show node => Int -> UndirEdge node -> ShowS
forall node. Show node => [UndirEdge node] -> ShowS
forall node. Show node => UndirEdge node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UndirEdge node] -> ShowS
$cshowList :: forall node. Show node => [UndirEdge node] -> ShowS
show :: UndirEdge node -> String
$cshow :: forall node. Show node => UndirEdge node -> String
showsPrec :: Int -> UndirEdge node -> ShowS
$cshowsPrec :: forall node. Show node => Int -> UndirEdge node -> ShowS
Show)

undirEdge :: (Ord node) => node -> node -> UndirEdge node
undirEdge :: forall node. Ord node => node -> node -> UndirEdge node
undirEdge node
x node
y =
   if node
xforall a. Ord a => a -> a -> Bool
<node
y
     then forall node. node -> node -> UndirEdge node
UndirEdge node
x node
y
     else forall node. node -> node -> UndirEdge node
UndirEdge node
y node
x

data
   EitherEdge node =
        EDirEdge (DirEdge node)
      | EUndirEdge (UndirEdge node)
   deriving (EitherEdge node -> EitherEdge node -> Bool
forall node. Eq node => EitherEdge node -> EitherEdge node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EitherEdge node -> EitherEdge node -> Bool
$c/= :: forall node. Eq node => EitherEdge node -> EitherEdge node -> Bool
== :: EitherEdge node -> EitherEdge node -> Bool
$c== :: forall node. Eq node => EitherEdge node -> EitherEdge node -> Bool
Eq, EitherEdge node -> EitherEdge node -> Bool
EitherEdge node -> EitherEdge node -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {node}. Ord node => Eq (EitherEdge node)
forall node. Ord node => EitherEdge node -> EitherEdge node -> Bool
forall node.
Ord node =>
EitherEdge node -> EitherEdge node -> Ordering
forall node.
Ord node =>
EitherEdge node -> EitherEdge node -> EitherEdge node
min :: EitherEdge node -> EitherEdge node -> EitherEdge node
$cmin :: forall node.
Ord node =>
EitherEdge node -> EitherEdge node -> EitherEdge node
max :: EitherEdge node -> EitherEdge node -> EitherEdge node
$cmax :: forall node.
Ord node =>
EitherEdge node -> EitherEdge node -> EitherEdge node
>= :: EitherEdge node -> EitherEdge node -> Bool
$c>= :: forall node. Ord node => EitherEdge node -> EitherEdge node -> Bool
> :: EitherEdge node -> EitherEdge node -> Bool
$c> :: forall node. Ord node => EitherEdge node -> EitherEdge node -> Bool
<= :: EitherEdge node -> EitherEdge node -> Bool
$c<= :: forall node. Ord node => EitherEdge node -> EitherEdge node -> Bool
< :: EitherEdge node -> EitherEdge node -> Bool
$c< :: forall node. Ord node => EitherEdge node -> EitherEdge node -> Bool
compare :: EitherEdge node -> EitherEdge node -> Ordering
$ccompare :: forall node.
Ord node =>
EitherEdge node -> EitherEdge node -> Ordering
Ord, Int -> EitherEdge node -> ShowS
forall node. Show node => Int -> EitherEdge node -> ShowS
forall node. Show node => [EitherEdge node] -> ShowS
forall node. Show node => EitherEdge node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EitherEdge node] -> ShowS
$cshowList :: forall node. Show node => [EitherEdge node] -> ShowS
show :: EitherEdge node -> String
$cshow :: forall node. Show node => EitherEdge node -> String
showsPrec :: Int -> EitherEdge node -> ShowS
$cshowsPrec :: forall node. Show node => Int -> EitherEdge node -> ShowS
Show)


liftBin ::
   (Edge edge, Monoid a) =>
   (node0 -> node1 -> a) -> edge node0 -> edge node1 -> a
liftBin :: forall (edge :: * -> *) a node0 node1.
(Edge edge, Monoid a) =>
(node0 -> node1 -> a) -> edge node0 -> edge node1 -> a
liftBin node0 -> node1 -> a
op edge node0
e0 edge node1
e1 = forall a. Monoid a => a -> a -> a
mappend (node0 -> node1 -> a
op (forall (edge :: * -> *) node. Edge edge => edge node -> node
from edge node0
e0) (forall (edge :: * -> *) node. Edge edge => edge node -> node
from edge node1
e1)) (node0 -> node1 -> a
op (forall (edge :: * -> *) node. Edge edge => edge node -> node
to edge node0
e0) (forall (edge :: * -> *) node. Edge edge => edge node -> node
to edge node1
e1))

liftEdgeEq ::
   Edge edge => (node0 -> node1 -> Bool) -> edge node0 -> edge node1 -> Bool
liftEdgeEq :: forall (edge :: * -> *) node0 node1.
Edge edge =>
(node0 -> node1 -> Bool) -> edge node0 -> edge node1 -> Bool
liftEdgeEq node0 -> node1 -> Bool
eq = (All -> Bool
getAll forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) a node0 node1.
(Edge edge, Monoid a) =>
(node0 -> node1 -> a) -> edge node0 -> edge node1 -> a
liftBin (\node0
a node1
b -> Bool -> All
All forall a b. (a -> b) -> a -> b
$ node0 -> node1 -> Bool
eq node0
a node1
b)

liftEdgeShowsPrec ::
   (Foldable edge) =>
   String -> (Int -> node -> ShowS) -> showList -> Int -> edge node -> ShowS
liftEdgeShowsPrec :: forall (edge :: * -> *) node showList.
Foldable edge =>
String
-> (Int -> node -> ShowS) -> showList -> Int -> edge node -> ShowS
liftEdgeShowsPrec String
name Int -> node -> ShowS
showsPrc showList
_showsList Int
p edge node
e =
   Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. Endo a -> a -> a
appEndo (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\node
n -> forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> node -> ShowS
showsPrc Int
11 node
n) edge node
e)

instance Eq1 DirEdge where liftEq :: forall a b. (a -> b -> Bool) -> DirEdge a -> DirEdge b -> Bool
liftEq = forall (edge :: * -> *) node0 node1.
Edge edge =>
(node0 -> node1 -> Bool) -> edge node0 -> edge node1 -> Bool
liftEdgeEq
instance Ord1 DirEdge where liftCompare :: forall a b.
(a -> b -> Ordering) -> DirEdge a -> DirEdge b -> Ordering
liftCompare = forall (edge :: * -> *) a node0 node1.
(Edge edge, Monoid a) =>
(node0 -> node1 -> a) -> edge node0 -> edge node1 -> a
liftBin
instance Show1 DirEdge where liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> DirEdge a -> ShowS
liftShowsPrec = forall (edge :: * -> *) node showList.
Foldable edge =>
String
-> (Int -> node -> ShowS) -> showList -> Int -> edge node -> ShowS
liftEdgeShowsPrec String
"DirEdge"

instance Eq1 UndirEdge where liftEq :: forall a b. (a -> b -> Bool) -> UndirEdge a -> UndirEdge b -> Bool
liftEq = forall (edge :: * -> *) node0 node1.
Edge edge =>
(node0 -> node1 -> Bool) -> edge node0 -> edge node1 -> Bool
liftEdgeEq
instance Ord1 UndirEdge where liftCompare :: forall a b.
(a -> b -> Ordering) -> UndirEdge a -> UndirEdge b -> Ordering
liftCompare = forall (edge :: * -> *) a node0 node1.
(Edge edge, Monoid a) =>
(node0 -> node1 -> a) -> edge node0 -> edge node1 -> a
liftBin
instance Show1 UndirEdge where liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> UndirEdge a -> ShowS
liftShowsPrec = forall (edge :: * -> *) node showList.
Foldable edge =>
String
-> (Int -> node -> ShowS) -> showList -> Int -> edge node -> ShowS
liftEdgeShowsPrec String
"UndirEdge"

instance Eq1 EitherEdge where
   liftEq :: forall a b.
(a -> b -> Bool) -> EitherEdge a -> EitherEdge b -> Bool
liftEq a -> b -> Bool
eq EitherEdge a
ee0 EitherEdge b
ee1 =
      case (EitherEdge a
ee0, EitherEdge b
ee1) of
         (EDirEdge DirEdge a
e0, EDirEdge DirEdge b
e1) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq DirEdge a
e0 DirEdge b
e1
         (EUndirEdge UndirEdge a
e0, EUndirEdge UndirEdge b
e1) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq UndirEdge a
e0 UndirEdge b
e1
         (EitherEdge a, EitherEdge b)
_ -> Bool
False

instance Ord1 EitherEdge where
   liftCompare :: forall a b.
(a -> b -> Ordering) -> EitherEdge a -> EitherEdge b -> Ordering
liftCompare a -> b -> Ordering
cmp EitherEdge a
ee0 EitherEdge b
ee1 =
      case (EitherEdge a
ee0, EitherEdge b
ee1) of
         (EDirEdge DirEdge a
e0, EDirEdge DirEdge b
e1) -> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp DirEdge a
e0 DirEdge b
e1
         (EUndirEdge UndirEdge a
e0, EUndirEdge UndirEdge b
e1) -> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp UndirEdge a
e0 UndirEdge b
e1
         (EDirEdge DirEdge a
_, EUndirEdge UndirEdge b
_) -> Ordering
LT
         (EUndirEdge UndirEdge a
_, EDirEdge DirEdge b
_) -> Ordering
GT

instance Show1 EitherEdge where
   liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> EitherEdge a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrc [a] -> ShowS
showsList Int
p EitherEdge a
ee =
      case EitherEdge a
ee of
         EDirEdge DirEdge a
e ->
            Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"EDirEdge " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrc [a] -> ShowS
showsList Int
11 DirEdge a
e
         EUndirEdge UndirEdge a
e ->
            Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"EUndirEdge " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrc [a] -> ShowS
showsList Int
11 UndirEdge a
e


instance Functor DirEdge where
   fmap :: forall a b. (a -> b) -> DirEdge a -> DirEdge b
fmap a -> b
f (DirEdge a
x a
y) = forall node. node -> node -> DirEdge node
DirEdge (a -> b
f a
x) (a -> b
f a
y)

instance Foldable DirEdge where
   foldMap :: forall m a. Monoid m => (a -> m) -> DirEdge a -> m
foldMap a -> m
f (DirEdge a
x a
y) = forall a. Monoid a => a -> a -> a
mappend (a -> m
f a
x) (a -> m
f a
y)

instance Foldable UndirEdge where
   foldMap :: forall m a. Monoid m => (a -> m) -> UndirEdge a -> m
foldMap a -> m
f (UndirEdge a
x a
y) = forall a. Monoid a => a -> a -> a
mappend (a -> m
f a
x) (a -> m
f a
y)

instance Foldable EitherEdge where
   foldMap :: forall m a. Monoid m => (a -> m) -> EitherEdge a -> m
foldMap a -> m
f EitherEdge a
ee =
      case EitherEdge a
ee of
         EDirEdge   DirEdge a
e -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f DirEdge a
e
         EUndirEdge UndirEdge a
e -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f UndirEdge a
e

instance (QC.Arbitrary n) => QC.Arbitrary (DirEdge n) where
   arbitrary :: Gen (DirEdge n)
arbitrary = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall node. node -> node -> DirEdge node
DirEdge forall a. Arbitrary a => Gen a
QC.arbitrary forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: DirEdge n -> [DirEdge n]
shrink (DirEdge n
x n
y) = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall node. node -> node -> DirEdge node
DirEdge) forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
QC.shrink (n
x,n
y)

instance (QC.Arbitrary n, Ord n) => QC.Arbitrary (UndirEdge n) where
   arbitrary :: Gen (UndirEdge n)
arbitrary = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall node. Ord node => node -> node -> UndirEdge node
undirEdge forall a. Arbitrary a => Gen a
QC.arbitrary forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: UndirEdge n -> [UndirEdge n]
shrink (UndirEdge n
x n
y) =
      forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall node. Ord node => node -> node -> UndirEdge node
undirEdge) forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
QC.shrink (n
x,n
y)


graphMap ::
   Graph edge node edgeLabel nodeLabel ->
   Map node (InOutMap edge node edgeLabel nodeLabel)
graphMap :: forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap edge node edgeLabel nodeLabel)
graphMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (e :: * -> *) n el nl.
InOutMap (Wrap e) n el nl -> InOutMap e n el nl
unwrapInOut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

nodes ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   [node]
nodes :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> [node]
nodes = forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

nodeEdges ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   Map node (Set (edge node), nodeLabel, Set (edge node))
nodeEdges :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Map node (Set (edge node), nodeLabel, Set (edge node))
nodeEdges =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap edge node) edgeLabel
ins,nodeLabel
n,Map (Wrap edge node) edgeLabel
outs) ->
         (forall (f :: * -> *) a. Set (Wrap f a) -> Set (f a)
unwrapSet forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map (Wrap edge node) edgeLabel
ins, nodeLabel
n, forall (f :: * -> *) a. Set (Wrap f a) -> Set (f a)
unwrapSet forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map (Wrap edge node) edgeLabel
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap


edgeLabels ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   Map (edge node) edgeLabel
edgeLabels :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Map (edge node) edgeLabel
edgeLabels = forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Map (Wrap edge node) edgeLabel
edgeLabelsWrap

edgeLabelsWrap ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   Map (Wrap edge node) edgeLabel
edgeLabelsWrap :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Map (Wrap edge node) edgeLabel
edgeLabelsWrap = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

edgeSet ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel -> Set (edge node)
edgeSet :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Set (edge node)
edgeSet = forall (f :: * -> *) a. Set (Wrap f a) -> Set (f a)
unwrapSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

edges ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel -> [edge node]
edges :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> [edge node]
edges = forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Map (edge node) edgeLabel
edgeLabels


{- |
prop> \(TestGraph gr) -> Graph.isConsistent (Graph.reverse gr)
prop> \(TestGraph gr) -> Graph.reverse (Graph.reverse gr) == gr
-}
reverse ::
   (Reverse e, Ord n) =>
   Graph e n el nl -> Graph e n el nl
reverse :: forall (e :: * -> *) n el nl.
(Reverse e, Ord n) =>
Graph e n el nl -> Graph e n el nl
reverse =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap e n) el
ins, nl
nl, Map (Wrap e n) el
outs) ->
         (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall (edge :: * -> *) node.
Reverse edge =>
Wrap edge node -> Wrap edge node
reverseEdgeWrap Map (Wrap e n) el
outs,
          nl
nl,
          forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall (edge :: * -> *) node.
Reverse edge =>
Wrap edge node -> Wrap edge node
reverseEdgeWrap Map (Wrap e n) el
ins))

reverseEdgeWrap :: Reverse edge => Wrap edge node -> Wrap edge node
reverseEdgeWrap :: forall (edge :: * -> *) node.
Reverse edge =>
Wrap edge node -> Wrap edge node
reverseEdgeWrap = forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node.
Reverse edge =>
edge node -> edge node
reverseEdge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap


class Edge edge => Reverse edge where
   reverseEdge :: edge node -> edge node

instance Reverse DirEdge where
   reverseEdge :: forall node. DirEdge node -> DirEdge node
reverseEdge (DirEdge node
x node
y) = forall node. node -> node -> DirEdge node
DirEdge node
y node
x


{- |
The index map must be an injection,
that is, nodes must not collaps.
Also the node and edge index maps must be consistent, i.e.

> from (edgeMap e) == nodeMap (from e)
> to   (edgeMap e) == nodeMap (to   e)

Strictly spoken, we would need the node map only for isolated nodes,
but we use it for all nodes for simplicity.
-}
mapKeys ::
   (Edge edge1, Ord node0, Ord node1) =>
   (node0 -> node1) ->
   (edge0 node0 -> edge1 node1) ->
   Graph edge0 node0 edgeLabel nodeLabel ->
   Graph edge1 node1 edgeLabel nodeLabel
mapKeys :: forall (edge1 :: * -> *) node0 node1 (edge0 :: * -> *) edgeLabel
       nodeLabel.
(Edge edge1, Ord node0, Ord node1) =>
(node0 -> node1)
-> (edge0 node0 -> edge1 node1)
-> Graph edge0 node0 edgeLabel nodeLabel
-> Graph edge1 node1 edgeLabel nodeLabel
mapKeys node0 -> node1
f edge0 node0 -> edge1 node1
g =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap edge0 node0) edgeLabel
ins,nodeLabel
nl,Map (Wrap edge0 node0) edgeLabel
outs) ->
         (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. edge0 node0 -> edge1 node1
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap edge0 node0) edgeLabel
ins,
          nodeLabel
nl,
          forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. edge0 node0 -> edge1 node1
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap edge0 node0) edgeLabel
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith (forall a. HasCallStack => String -> a
error String
"Graph.mapKeys: node map is not injective") node0 -> node1
f

{- |
prop> Graph.isEmpty (Graph.empty :: MonoGraph)
prop> Graph.isConsistent (Graph.empty :: MonoGraph)
-}
empty :: Graph edge node edgeLabel nodeLabel
empty :: forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
empty = forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall k a. Map k a
Map.empty

{- |
The node sets must be disjoint.
-}
union ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   Graph edge node edgeLabel nodeLabel ->
   Graph edge node edgeLabel nodeLabel
union :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
union (Graph Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
ns0) (Graph Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
ns1) =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph
      (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (forall a. HasCallStack => String -> a
error String
"Graph.union: node sets overlap") Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
ns0 Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
ns1)

instance
   (Edge edge, Ord node) =>
      Semigroup (Graph edge node edgeLabel nodeLabel) where
   <> :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
(<>) = forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
union

instance
   (Edge edge, Ord node) =>
      Monoid (Graph edge node edgeLabel nodeLabel) where
   mempty :: Graph edge node edgeLabel nodeLabel
mempty = forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
empty
   mappend :: Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
mappend = forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
-> Graph edge node edgeLabel nodeLabel
union


{- |
Node and edge sets must be equal.
-}
checkedZipWith ::
   (Edge edge, Ord node) =>
   MapU.Caller ->
   (nodeLabel0 -> nodeLabel1 -> nodeLabel2) ->
   (edgeLabel0 -> edgeLabel1 -> edgeLabel2) ->
   Graph edge node edgeLabel0 nodeLabel0 ->
   Graph edge node edgeLabel1 nodeLabel1 ->
   Graph edge node edgeLabel2 nodeLabel2
checkedZipWith :: forall (edge :: * -> *) node nodeLabel0 nodeLabel1 nodeLabel2
       edgeLabel0 edgeLabel1 edgeLabel2.
(Edge edge, Ord node) =>
String
-> (nodeLabel0 -> nodeLabel1 -> nodeLabel2)
-> (edgeLabel0 -> edgeLabel1 -> edgeLabel2)
-> Graph edge node edgeLabel0 nodeLabel0
-> Graph edge node edgeLabel1 nodeLabel1
-> Graph edge node edgeLabel2 nodeLabel2
checkedZipWith String
caller nodeLabel0 -> nodeLabel1 -> nodeLabel2
f edgeLabel0 -> edgeLabel1 -> edgeLabel2
g (Graph Map node (InOutMap (Wrap edge) node edgeLabel0 nodeLabel0)
ns0) (Graph Map node (InOutMap (Wrap edge) node edgeLabel1 nodeLabel1)
ns1) =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall a b. (a -> b) -> a -> b
$
   forall k a b c.
Ord k =>
String -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
MapU.checkedZipWith (String
caller forall a. [a] -> [a] -> [a]
++ String
" node")
      (\(Map (Wrap edge node) edgeLabel0
ins0, nodeLabel0
n0, Map (Wrap edge node) edgeLabel0
outs0) (Map (Wrap edge node) edgeLabel1
ins1, nodeLabel1
n1, Map (Wrap edge node) edgeLabel1
outs1) ->
         (forall k a b c.
Ord k =>
String -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
MapU.checkedZipWith (String
caller forall a. [a] -> [a] -> [a]
++ String
" ins") edgeLabel0 -> edgeLabel1 -> edgeLabel2
g Map (Wrap edge node) edgeLabel0
ins0 Map (Wrap edge node) edgeLabel1
ins1,
          nodeLabel0 -> nodeLabel1 -> nodeLabel2
f nodeLabel0
n0 nodeLabel1
n1,
          forall k a b c.
Ord k =>
String -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
MapU.checkedZipWith (String
caller forall a. [a] -> [a] -> [a]
++ String
" outs") edgeLabel0 -> edgeLabel1 -> edgeLabel2
g Map (Wrap edge node) edgeLabel0
outs0 Map (Wrap edge node) edgeLabel1
outs1))
      Map node (InOutMap (Wrap edge) node edgeLabel0 nodeLabel0)
ns0 Map node (InOutMap (Wrap edge) node edgeLabel1 nodeLabel1)
ns1


nodeLabels :: (Edge e, Ord n) => Graph e n el nl -> Map n nl
nodeLabels :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> Map n nl
nodeLabels = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
prop> \(GraphAndEdge gr e) -> Graph.lookupEdge e gr == Map.lookup e (Graph.edgeLabels gr)
-}
lookupEdge :: (Edge e, Ord n) => e n -> Graph e n el nl -> Maybe el
lookupEdge :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
e n -> Graph e n el nl -> Maybe el
lookupEdge e n
e (Graph Map n (InOutMap (Wrap e) n el nl)
g) =
   forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall (f :: * -> *) a. f a -> Wrap f a
wrap e n
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> c
thd3 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall (edge :: * -> *) node. Edge edge => edge node -> node
from e n
e) Map n (InOutMap (Wrap e) n el nl)
g

{- |
Alternative implementation for test:
-}
_lookupEdge :: (Edge e, Ord n) => e n -> Graph e n el nl -> Maybe el
_lookupEdge :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
e n -> Graph e n el nl -> Maybe el
_lookupEdge e n
e (Graph Map n (InOutMap (Wrap e) n el nl)
g) =
   forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall (f :: * -> *) a. f a -> Wrap f a
wrap e n
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall (edge :: * -> *) node. Edge edge => edge node -> node
to e n
e) Map n (InOutMap (Wrap e) n el nl)
g


isEmpty :: Graph e n el nl -> Bool
isEmpty :: forall (e :: * -> *) n el nl. Graph e n el nl -> Bool
isEmpty = forall k a. Map k a -> Bool
Map.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
prop> \(TestGraph gr) n -> Graph.lookupNode n gr == Map.lookup n (Graph.nodeLabels gr)
-}
lookupNode :: (Ord n) => n -> Graph e n el nl -> Maybe nl
lookupNode :: forall n (e :: * -> *) el nl.
Ord n =>
n -> Graph e n el nl -> Maybe nl
lookupNode n
n (Graph Map n (InOutMap (Wrap e) n el nl)
g) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> b
snd3 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup n
n Map n (InOutMap (Wrap e) n el nl)
g

memberNode :: (Ord n) => n -> Graph e n el nl -> Bool
memberNode :: forall n (e :: * -> *) el nl. Ord n => n -> Graph e n el nl -> Bool
memberNode n
n (Graph Map n (InOutMap (Wrap e) n el nl)
g) = forall k a. Ord k => k -> Map k a -> Bool
Map.member n
n Map n (InOutMap (Wrap e) n el nl)
g

{- |
Direct predecessors of a node,
i.e. nodes with an outgoing edge to the queried node.

It is a checked error, if the queried node is not contained in the graph.
-}
predecessors :: (Edge e, Ord n) => Graph e n el nl -> n -> [n]
predecessors :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
predecessors Graph e n el nl
g n
n =
   forall a b. (a -> b) -> [a] -> [b]
map forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => String -> a
error String
"predecessors: unknown node") n
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap forall a b. (a -> b) -> a -> b
$ Graph e n el nl
g

{- |
Direct successors of a node,
i.e. nodes with an incoming edge from the queried node.

It is a checked error, if the queried node is not contained in the graph.
-}
successors :: (Edge e, Ord n) => Graph e n el nl -> n -> [n]
successors :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
successors Graph e n el nl
g n
n =
   forall a b. (a -> b) -> [a] -> [b]
map forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> c
thd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => String -> a
error String
"successors: unknown node") n
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap forall a b. (a -> b) -> a -> b
$ Graph e n el nl
g

{-# DEPRECATED adjacentEdges "Use adjacentEdgeSet instead." #-}
adjacentEdges, adjacentEdgeSet ::
   (Edge e, Ord n) =>
   Graph e n el nl -> n -> Set (e n)
adjacentEdges :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> Set (e n)
adjacentEdges = forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> Set (e n)
adjacentEdgeSet
adjacentEdgeSet :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> Set (e n)
adjacentEdgeSet Graph e n el nl
g n
n =
   (\(Map (Wrap e n) el
ins,nl
_nl,Map (Wrap e n) el
outs) ->
      forall (f :: * -> *) a. Set (Wrap f a) -> Set (f a)
unwrapSet forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map (Wrap e n) el
ins forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall k a. Map k a -> Set k
Map.keysSet Map (Wrap e n) el
outs) forall a b. (a -> b) -> a -> b
$
   forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => String -> a
error String
"adjacentEdgeSet: unknown node") n
n forall a b. (a -> b) -> a -> b
$
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap Graph e n el nl
g

{-
In constrast to Map.intersectWith ($), unaffected values are preserved.
-}
applyMap :: (Ord k) => Map k (a -> a) -> Map k a -> Map k a
applyMap :: forall k a. Ord k => Map k (a -> a) -> Map k a -> Map k a
applyMap Map k (a -> a)
f Map k a
x =
   forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a b. (a -> b) -> a -> b
($) Map k (a -> a)
f Map k a
x) Map k a
x

{- |
Node to be deleted must be contained in the graph.

prop> \(TestGraph gr) n -> Graph.isConsistent $ deleteNodeIfExists n gr
prop> \(TestGraph gr) n nl -> Graph.deleteNode n (Graph.insertNode n nl gr) == deleteNodeIfExists n gr
prop> \(TestGraph gr) -> let isolatedNodes = filter (isolated gr) $ Graph.nodes gr in not (null isolatedNodes) ==> QC.forAll (QC.elements isolatedNodes) $ \n nl -> Graph.insertNode n nl gr == Graph.insertNode n nl (Graph.deleteNode n gr)
-}
deleteNode ::
   (Edge e, Ord n) =>
   n -> Graph e n el nl -> Graph e n el nl
deleteNode :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
n -> Graph e n el nl -> Graph e n el nl
deleteNode n
n =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$ \Map n (InOutMap (Wrap e) n el nl)
ns ->
   case forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => String -> a
error String
"deleteNode: unknown node") n
n Map n (InOutMap (Wrap e) n el nl)
ns of
      (Map (Wrap e n) el
ins, nl
_nl, Map (Wrap e n) el
outs) ->
         forall k a. Ord k => Map k (a -> a) -> Map k a -> Map k a
applyMap
            (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap forall a b. (a -> b) -> a -> b
$
             forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Wrap e n
e el
_ -> forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Wrap e n
e) Map (Wrap e n) el
ins)  forall a b. (a -> b) -> a -> b
$
         forall k a. Ord k => Map k (a -> a) -> Map k a -> Map k a
applyMap
            (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap   forall a b. (a -> b) -> a -> b
$
             forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Wrap e n
e el
_ -> forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
mapFst3 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Wrap e n
e) Map (Wrap e n) el
outs) forall a b. (a -> b) -> a -> b
$
         forall k a. Ord k => k -> Map k a -> Map k a
Map.delete n
n Map n (InOutMap (Wrap e) n el nl)
ns

{- |
Could be implemented more efficiently.
-}
deleteNodeSet ::
   (Edge e, Ord n) =>
   Set n -> Graph e n el nl -> Graph e n el nl
deleteNodeSet :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Set n -> Graph e n el nl -> Graph e n el nl
deleteNodeSet Set n
delNs Graph e n el nl
g = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
n -> Graph e n el nl -> Graph e n el nl
deleteNode) Graph e n el nl
g Set n
delNs

{- |
prop> \(GraphAndEdge gr e) -> Graph.isConsistent $ Graph.deleteEdge e gr
prop> \(GraphAndEdge gr e) el -> Graph.deleteEdge e (Graph.insertEdge e el gr) == Graph.deleteEdge e gr
prop> \(GraphAndEdge gr e) el -> Graph.insertEdge e el gr == Graph.insertEdge e el (Graph.deleteEdge e gr)
-}
deleteEdge ::
   (Edge e, Ord n) =>
   e n -> Graph e n el nl -> Graph e n el nl
deleteEdge :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
e n -> Graph e n el nl -> Graph e n el nl
deleteEdge e n
e =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
      forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Wrap f a
wrap e n
e) (forall (edge :: * -> *) node. Edge edge => edge node -> node
from e n
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
mapFst3 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Wrap f a
wrap e n
e) (forall (edge :: * -> *) node. Edge edge => edge node -> node
to e n
e)

{- |
prop> \(GraphAndEdge gr e) -> Graph.filterEdgeWithKey (\ei _ -> e/=ei) gr == Graph.deleteEdge e gr
-}
filterEdgeWithKey ::
   (Edge e, Ord n) =>
   (e n -> el -> Bool) ->
   Graph e n el nl -> Graph e n el nl
filterEdgeWithKey :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
(e n -> el -> Bool) -> Graph e n el nl -> Graph e n el nl
filterEdgeWithKey e n -> el -> Bool
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap e n) el
ins, nl
nl, Map (Wrap e n) el
outs) ->
         (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (e n -> el -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e n) el
ins, nl
nl,
          forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (e n -> el -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e n) el
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
You may only use this for filtering edges
and use more specialised types as a result.
You must not alter source and target nodes of edges.
-}
mapMaybeEdgeKeys ::
   (Edge e1, Ord n) =>
   (e0 n -> Maybe (e1 n)) ->
   Graph e0 n el nl -> Graph e1 n el nl
mapMaybeEdgeKeys :: forall (e1 :: * -> *) n (e0 :: * -> *) el nl.
(Edge e1, Ord n) =>
(e0 n -> Maybe (e1 n)) -> Graph e0 n el nl -> Graph e1 n el nl
mapMaybeEdgeKeys e0 n -> Maybe (e1 n)
f =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap e0 n) el
ins, nl
nl, Map (Wrap e0 n) el
outs) ->
         (forall k1 k0 a. Ord k1 => (k0 -> Maybe k1) -> Map k0 a -> Map k1 a
MapU.mapMaybeKeys (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. e0 n -> Maybe (e1 n)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e0 n) el
ins,
          nl
nl,
          forall k1 k0 a. Ord k1 => (k0 -> Maybe k1) -> Map k0 a -> Map k1 a
MapU.mapMaybeKeys (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. e0 n -> Maybe (e1 n)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e0 n) el
outs))

{- |
Same restrictions as in 'mapMaybeEdgeKeys'.
-}
mapEdgeKeys ::
   (Edge e1, Ord n) =>
   (e0 n -> e1 n) ->
   Graph e0 n el nl -> Graph e1 n el nl
mapEdgeKeys :: forall (e1 :: * -> *) n (e0 :: * -> *) el nl.
(Edge e1, Ord n) =>
(e0 n -> e1 n) -> Graph e0 n el nl -> Graph e1 n el nl
mapEdgeKeys e0 n -> e1 n
f =
   forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(Map (Wrap e0 n) el
ins, nl
nl, Map (Wrap e0 n) el
outs) ->
         (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. e0 n -> e1 n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e0 n) el
ins,
          nl
nl,
          forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall (f :: * -> *) a. f a -> Wrap f a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. e0 n -> e1 n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e0 n) el
outs))

{- |
In the current implementation
existing nodes are replaced with new labels
and existing edges are maintained.
However, I think we should better have an extra function for this purpose
and you should not rely on this behavior.

prop> \(TestGraph gr) n nl -> Graph.isConsistent $ Graph.insertNode n nl gr
prop> \(TestGraph gr) n nl -> Graph.lookupNode n (Graph.insertNode n nl gr) == Just nl
-}
insertNode ::
   (Ord n) => n -> nl -> Graph e n el nl -> Graph e n el nl
insertNode :: forall n nl (e :: * -> *) el.
Ord n =>
n -> nl -> Graph e n el nl -> Graph e n el nl
insertNode n
n nl
nl =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
      (\InOutMap (Wrap e) n el nl
_ (Map (Wrap e n) el
ins, nl
_, Map (Wrap e n) el
outs) -> (Map (Wrap e n) el
ins, nl
nl, Map (Wrap e n) el
outs))
      n
n (forall k a. Map k a
Map.empty, nl
nl, forall k a. Map k a
Map.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
prop> \(GraphAndEdge gr e) el -> Graph.isConsistent $ Graph.insertEdge e el gr
prop> \(GraphAndEdge gr e) el -> Graph.lookupEdge e (Graph.insertEdge e el gr) == Just el
-}
insertEdge ::
   (Edge e, Ord n) =>
   e n -> el -> Graph e n el nl -> Graph e n el nl
insertEdge :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
e n -> el -> Graph e n el nl -> Graph e n el nl
insertEdge e n
e el
el = forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Map (e n) el -> Graph e n el nl -> Graph e n el nl
insertEdgeSet forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton e n
e el
el

{- |
In the current implementation
existing edges are replaced with new labels.
However, I think we should better have an extra function for this purpose
and you should not rely on this behavior.
It is an unchecked error if edges between non-existing nodes are inserted.
-}
insertEdgeSet ::
   (Edge e, Ord n) =>
   Map (e n) el -> Graph e n el nl -> Graph e n el nl
insertEdgeSet :: forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Map (e n) el -> Graph e n el nl -> Graph e n el nl
insertEdgeSet Map (e n) el
es =
   let ess :: Map (Wrap e n) (Map (Wrap e n) el)
ess = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey forall k a. k -> a -> Map k a
Map.singleton forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n a. Map (e n) a -> Map (Wrap e n) a
wrapMap Map (e n) el
es
   in  forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph forall a b. (a -> b) -> a -> b
$
       forall k a. Ord k => Map k (a -> a) -> Map k a -> Map k a
applyMap
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map (Wrap e n) el
new -> forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
mapFst3 (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Wrap e n) el
new)) forall a b. (a -> b) -> a -> b
$
           forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap   Map (Wrap e n) (Map (Wrap e n) el)
ess) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall k a. Ord k => Map k (a -> a) -> Map k a -> Map k a
applyMap
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map (Wrap e n) el
new -> forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Wrap e n) el
new)) forall a b. (a -> b) -> a -> b
$
           forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap Map (Wrap e n) (Map (Wrap e n) el)
ess)

fromList ::
   (Edge e, Ord n) =>
   [LabeledNode n nl] -> [LabeledEdge e n el] -> Graph e n el nl
fromList :: forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
[LabeledNode n nl] -> [LabeledEdge e n el] -> Graph e n el nl
fromList [LabeledNode n nl]
ns [LabeledEdge e n el]
es =
   forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (Wrap e n) el -> Graph e n el nl
fromMapWrap (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [LabeledNode n nl]
ns) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall (f :: * -> *) a. f a -> Wrap f a
wrap) [LabeledEdge e n el]
es

{- |
prop> \(TestGraph gr) -> gr == Graph.fromMap (Graph.nodeLabels gr) (Graph.edgeLabels gr)
-}
fromMap ::
   (Edge e, Ord n) =>
   Map n nl -> Map (e n) el -> Graph e n el nl
fromMap :: forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (e n) el -> Graph e n el nl
fromMap Map n nl
ns = forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (Wrap e n) el -> Graph e n el nl
fromMapWrap Map n nl
ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: * -> *) n a. Map (e n) a -> Map (Wrap e n) a
wrapMap

fromMapWrap ::
   (Edge e, Ord n) =>
   Map n nl -> Map (Wrap e n) el -> Graph e n el nl
fromMapWrap :: forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (Wrap e n) el -> Graph e n el nl
fromMapWrap Map n nl
ns Map (Wrap e n) el
es =
   let ess :: Map (Wrap e n) (Map (Wrap e n) el)
ess = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey forall k a. k -> a -> Map k a
Map.singleton Map (Wrap e n) el
es
   in  forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall a b. (a -> b) -> a -> b
$
       forall k a b c.
Ord k =>
(a -> b -> c) -> TotalMap k a -> Map k b -> Map k c
TMap.intersectionPartialWith (\Map (Wrap e n) el
ins (Map (Wrap e n) el
outs, nl
nl) -> (Map (Wrap e n) el
ins,nl
nl,Map (Wrap e n) el
outs))
          (forall a k. a -> Map k a -> TotalMap k a
TMap.cons forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap   Map (Wrap e n) (Map (Wrap e n) el)
ess) forall a b. (a -> b) -> a -> b
$
       forall k a b c.
Ord k =>
(a -> b -> c) -> TotalMap k a -> Map k b -> Map k c
TMap.intersectionPartialWith (,)
          (forall a k. a -> Map k a -> TotalMap k a
TMap.cons forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap Map (Wrap e n) (Map (Wrap e n) el)
ess) Map n nl
ns


{- |
prop> \(TestGraph gr) -> Graph.mapNode id gr == gr
-}
mapNode :: (nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNode :: forall nl0 nl1 (e :: * -> *) n el.
(nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNode nl0 -> nl1
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Map (Wrap e n) el
ins,nl0
n,Map (Wrap e n) el
outs) -> (Map (Wrap e n) el
ins, nl0 -> nl1
f nl0
n, Map (Wrap e n) el
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

mapNodeWithKey :: (n -> nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNodeWithKey :: forall n nl0 nl1 (e :: * -> *) el.
(n -> nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNodeWithKey n -> nl0 -> nl1
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\n
n (Map (Wrap e n) el
ins,nl0
nl,Map (Wrap e n) el
outs) -> (Map (Wrap e n) el
ins, n -> nl0 -> nl1
f n
n nl0
nl, Map (Wrap e n) el
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
prop> \(TestGraph gr) -> Graph.mapEdge id gr == gr
-}
mapEdge :: (el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
mapEdge :: forall el0 el1 (e :: * -> *) n nl.
(el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
mapEdge el0 -> el1
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Map (Wrap e n) el0
ins,nl
n,Map (Wrap e n) el0
outs) -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap el0 -> el1
f Map (Wrap e n) el0
ins, nl
n, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap el0 -> el1
f Map (Wrap e n) el0
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

mapEdgeWithKey :: (e n -> el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
mapEdgeWithKey :: forall (e :: * -> *) n el0 el1 nl.
(e n -> el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
mapEdgeWithKey e n -> el0 -> el1
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Map (Wrap e n) el0
ins,nl
n,Map (Wrap e n) el0
outs) -> (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (e n -> el0 -> el1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e n) el0
ins, nl
n, forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (e n -> el0 -> el1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap) Map (Wrap e n) el0
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

nodeSet :: Graph e n el nl -> Set n
nodeSet :: forall (e :: * -> *) n el nl. Graph e n el nl -> Set n
nodeSet = forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap


type
   InOut e n el nl =
      ([LabeledEdge e n el], LabeledNode n nl, [LabeledEdge e n el])

mapNodeWithInOut ::
   (Edge e, Ord n) =>
   (InOut e n el nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNodeWithInOut :: forall (e :: * -> *) n el nl0 nl1.
(Edge e, Ord n) =>
(InOut e n el nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
mapNodeWithInOut InOut e n el nl0 -> nl1
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
      (\n
n (Map (Wrap e n) el
ins,nl0
nl,Map (Wrap e n) el
outs) ->
         (Map (Wrap e n) el
ins,
          InOut e n el nl0 -> nl1
f (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap Map (Wrap e n) el
ins, (n
n,nl0
nl), forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap Map (Wrap e n) el
outs),
          Map (Wrap e n) el
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap


{- |
Same restrictions as in 'traverse'.

prop> \(TestGraph gr) nl -> Graph.isConsistent $ evalTraverseNode nl gr
prop> \(TestGraph gr) -> runIdentity (Graph.traverseNode (Identity . Char.toUpper) gr) == Graph.mapNode Char.toUpper gr
-}
traverseNode ::
   (Applicative f, Edge e, Ord n) =>
   (nl0 -> f nl1) -> Graph e n el nl0 -> f (Graph e n el nl1)
traverseNode :: forall (f :: * -> *) (e :: * -> *) n nl0 nl1 el.
(Applicative f, Edge e, Ord n) =>
(nl0 -> f nl1) -> Graph e n el nl0 -> f (Graph e n el nl1)
traverseNode nl0 -> f nl1
f =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse (\(Map (Wrap e n) el
ins,nl0
nl0,Map (Wrap e n) el
outs) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\nl1
nl1 -> (Map (Wrap e n) el
ins, nl1
nl1, Map (Wrap e n) el
outs)) forall a b. (a -> b) -> a -> b
$ nl0 -> f nl1
f nl0
nl0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

{- |
Same restrictions as in 'traverse'.

prop> \(TestGraph gr) el -> Graph.isConsistent $ evalTraverseEdge el gr
prop> \(TestGraph gr) el -> runIdentity (Graph.traverseEdge (Identity . (el+)) gr) == Graph.mapEdge (el+) gr
-}
traverseEdge ::
   (Applicative f, Edge e, Ord n) =>
   (el0 -> f el1) -> Graph e n el0 nl -> f (Graph e n el1 nl)
traverseEdge :: forall (f :: * -> *) (e :: * -> *) n el0 el1 nl.
(Applicative f, Edge e, Ord n) =>
(el0 -> f el1) -> Graph e n el0 nl -> f (Graph e n el1 nl)
traverseEdge el0 -> f el1
f Graph e n el0 nl
gr =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (e n) el -> Graph e n el nl
fromMap (forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> Map n nl
nodeLabels Graph e n el0 nl
gr)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse el0 -> f el1
f forall a b. (a -> b) -> a -> b
$ forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Map (edge node) edgeLabel
edgeLabels Graph e n el0 nl
gr

{- |
Don't rely on a particular order of traversal!

prop> \(TestGraph gr) nl el -> Graph.isConsistent $ evalTraverse nl el gr
prop> \(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseNode nl (evalTraverseEdge el gr)
prop> \(TestGraph gr) nl el -> evalTraverse nl el gr == evalTraverseEdge el (evalTraverseNode nl gr)
prop> \(TestGraph gr) nl -> flip MS.evalState nl (Graph.traverseNode nodeAction gr) == flip MS.evalState nl (Graph.traverse nodeAction pure gr)
prop> \(TestGraph gr) el -> flip MS.evalState el (Graph.traverseEdge edgeAction gr) == flip MS.evalState el (Graph.traverse pure edgeAction gr)
-}
traverse, _traverseNaive ::
   (Applicative f, Edge e, Ord n) =>
   (nl0 -> f nl1) ->
   (el0 -> f el1) ->
   Graph e n el0 nl0 -> f (Graph e n el1 nl1)
traverse :: forall (f :: * -> *) (e :: * -> *) n nl0 nl1 el0 el1.
(Applicative f, Edge e, Ord n) =>
(nl0 -> f nl1)
-> (el0 -> f el1) -> Graph e n el0 nl0 -> f (Graph e n el1 nl1)
traverse nl0 -> f nl1
fn el0 -> f el1
fe Graph e n el0 nl0
gr =
   forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (e :: * -> *) n nl el.
(Edge e, Ord n) =>
Map n nl -> Map (e n) el -> Graph e n el nl
fromMap
      (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse nl0 -> f nl1
fn forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> Map n nl
nodeLabels Graph e n el0 nl0
gr)
      (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse el0 -> f el1
fe forall a b. (a -> b) -> a -> b
$ forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Map (edge node) edgeLabel
edgeLabels Graph e n el0 nl0
gr)

{-
Due to the current implementation all edges are accessed twice.
That is, the actions should be commutative and non-destructive.
-}
_traverseNaive :: forall (f :: * -> *) (e :: * -> *) n nl0 nl1 el0 el1.
(Applicative f, Edge e, Ord n) =>
(nl0 -> f nl1)
-> (el0 -> f el1) -> Graph e n el0 nl0 -> f (Graph e n el1 nl1)
_traverseNaive nl0 -> f nl1
fn el0 -> f el1
fe =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse
      (\(Map (Wrap e n) el0
ins,nl0
n,Map (Wrap e n) el0
outs) ->
         forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse el0 -> f el1
fe Map (Wrap e n) el0
ins) (nl0 -> f nl1
fn nl0
n) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse el0 -> f el1
fe Map (Wrap e n) el0
outs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap


isLoop :: (Edge edge, Eq node) => edge node -> Bool
isLoop :: forall (edge :: * -> *) node.
(Edge edge, Eq node) =>
edge node -> Bool
isLoop edge node
e = forall (edge :: * -> *) node. Edge edge => edge node -> node
from edge node
e forall a. Eq a => a -> a -> Bool
== forall (edge :: * -> *) node. Edge edge => edge node -> node
to edge node
e

pathExists ::
   (Edge edge, Ord node) =>
   node -> node -> Graph edge node edgeLabel nodeLabel -> Bool
pathExists :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
node -> node -> Graph edge node edgeLabel nodeLabel -> Bool
pathExists node
src node
dst =
   let go :: Graph e node el nl -> node -> Bool
go Graph e node el nl
gr node
a =
          Bool -> Bool
not (forall (e :: * -> *) n el nl. Graph e n el nl -> Bool
isEmpty Graph e node el nl
gr) Bool -> Bool -> Bool
&&
          (node
aforall a. Eq a => a -> a -> Bool
==node
dst Bool -> Bool -> Bool
|| (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Graph e node el nl -> node -> Bool
go (forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
n -> Graph e n el nl -> Graph e n el nl
deleteNode node
a Graph e node el nl
gr)) forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
successors Graph e node el nl
gr node
a))
   in  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {e :: * -> *} {el} {nl}.
Edge e =>
Graph e node el nl -> node -> Bool
go node
src

depthFirstSearch ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel -> Forest node
depthFirstSearch :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Forest node
depthFirstSearch =
   let go :: StateT (Graph edge node edgeLabel nodeLabel) Identity [Tree node]
go = do
         Graph edge node edgeLabel nodeLabel
gr <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
         case forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> [node]
nodes Graph edge node edgeLabel nodeLabel
gr of
            node
n:[node]
_ -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
node -> State (Graph edge node edgeLabel nodeLabel) (Tree node)
depthFirstSearchFrom node
n) StateT (Graph edge node edgeLabel nodeLabel) Identity [Tree node]
go
            [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
   in forall s a. State s a -> s -> a
MS.evalState forall {edgeLabel} {nodeLabel}.
StateT (Graph edge node edgeLabel nodeLabel) Identity [Tree node]
go

depthFirstSearchFrom ::
   (Edge edge, Ord node) =>
   node -> MS.State (Graph edge node edgeLabel nodeLabel) (Tree node)
depthFirstSearchFrom :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
node -> State (Graph edge node edgeLabel nodeLabel) (Tree node)
depthFirstSearchFrom node
n = do
   Graph edge node edgeLabel nodeLabel
gr <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
   forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
n -> Graph e n el nl -> Graph e n el nl
deleteNode node
n Graph edge node edgeLabel nodeLabel
gr
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [Tree a] -> Tree a
Tree.Node node
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
Trav.for (forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
successors Graph edge node edgeLabel nodeLabel
gr node
n) forall a b. (a -> b) -> a -> b
$ \node
succ -> do
      Bool
unvisited <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a b. (a -> b) -> a -> b
$ forall n (e :: * -> *) el nl. Ord n => n -> Graph e n el nl -> Bool
memberNode node
n
      if Bool
unvisited
         then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
node -> State (Graph edge node edgeLabel nodeLabel) (Tree node)
depthFirstSearchFrom node
succ
         else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

{- |
>>> mapSnd Graph.nodes $ Graph.topologicalSort $ unlabGraph [] ['a'*->'a']
("","a")
>>> mapSnd Graph.nodes $ Graph.topologicalSort $ unlabGraph [] ['a'*->'h', 'a'*->'p', 'g'*->'r', 'p'*->'h', 'r'*->'a']
("graph","")
>>> mapSnd Graph.nodes $ Graph.topologicalSort $ unlabGraph [] ['h'*->'a', 'a'*->'p', 'g'*->'r', 'p'*->'h', 'r'*->'a']
("gr","ahp")
-}
topologicalSort ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   ([node], Graph edge node edgeLabel nodeLabel)
topologicalSort :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> ([node], Graph edge node edgeLabel nodeLabel)
topologicalSort Graph edge node edgeLabel nodeLabel
gr =
   let go :: Graph e a el nl -> Set a -> ([a], Graph e a el nl)
go Graph e a el nl
gr0 Set a
startNodes =
         case forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
startNodes of
            Maybe (a, Set a)
Nothing -> ([], Graph e a el nl
gr0)
            Just (a
n,Set a
ns) ->
               let gr1 :: Graph e a el nl
gr1 = forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
n -> Graph e n el nl -> Graph e n el nl
deleteNode a
n Graph e a el nl
gr0 in
               forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
n forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
               Graph e a el nl -> Set a -> ([a], Graph e a el nl)
go Graph e a el nl
gr1 forall a b. (a -> b) -> a -> b
$
                  forall a. (a -> Bool) -> Set a -> Set a
Set.filter
                     (forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
predecessors Graph e a el nl
gr1)
                     (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
successors Graph e a el nl
gr0 a
n)
                  forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
                  Set a
ns
   in forall {a} {e :: * -> *} {el} {nl}.
(Edge e, Ord a) =>
Graph e a el nl -> Set a -> ([a], Graph e a el nl)
go Graph edge node edgeLabel nodeLabel
gr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Set a -> Bool
Set.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> Map node (Set (edge node), nodeLabel, Set (edge node))
nodeEdges forall a b. (a -> b) -> a -> b
$ Graph edge node edgeLabel nodeLabel
gr

{- |
>>> map Graph.nodes $ Graph.components $ unlabGraph ['d'] ['a'*->'p', 'g'*->'r', 'p'*->'h']
["ahp","d","gr"]
>>> map Graph.nodes $ Graph.components $ unlabGraph ['d'] ['a'*-*'p', 'g'*-*'r', 'p'*-*'h']
["ahp","d","gr"]
-}
components ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel ->
   [Graph edge node edgeLabel nodeLabel]
components :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> [Graph edge node edgeLabel nodeLabel]
components =
   let go :: Graph edge node edgeLabel nodeLabel
-> [Graph edge node edgeLabel nodeLabel]
go Graph edge node edgeLabel nodeLabel
gr0 =
         case forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> [node]
nodes Graph edge node edgeLabel nodeLabel
gr0 of
            [] -> []
            node
n:[node]
_ ->
               let (Graph edge node edgeLabel nodeLabel
comp, Graph edge node edgeLabel nodeLabel
remaining) = forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> node
-> (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
fetchComponent Graph edge node edgeLabel nodeLabel
gr0 node
n in
               Graph edge node edgeLabel nodeLabel
comp forall a. a -> [a] -> [a]
: Graph edge node edgeLabel nodeLabel
-> [Graph edge node edgeLabel nodeLabel]
go Graph edge node edgeLabel nodeLabel
remaining
   in forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> [Graph edge node edgeLabel nodeLabel]
go

fetchComponent ::
   (Edge edge, Ord node) =>
   Graph edge node edgeLabel nodeLabel -> node ->
   (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
fetchComponent :: forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel
-> node
-> (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
fetchComponent (Graph Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr) node
n =
   let go :: Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Set node
-> (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
go Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
comp0 Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr0 Set node
set =
         if forall a. Set a -> Bool
Set.null Set node
set
            then (forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
comp0, forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr0)
            else
               let zone :: Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
zone = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr0 Set node
set
                   remaining :: Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
remaining = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr0 Set node
set
                   comp1 :: Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
comp1 = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
comp0 Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
zone
                   newSet :: Set node
newSet =
                     forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
                        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. (a -> b) -> [a] -> [b]
map forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3) Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
zone
                        forall a. [a] -> [a] -> [a]
++
                        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. (a -> b) -> [a] -> [b]
map forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> c
thd3) Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
zone
               in Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Set node
-> (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
go Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
comp1 Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
remaining Set node
newSet
   in forall {node} {edge :: * -> *} {edgeLabel} {nodeLabel}.
(Ord node, Edge edge) =>
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Set node
-> (Graph edge node edgeLabel nodeLabel,
    Graph edge node edgeLabel nodeLabel)
go forall k a. Map k a
Map.empty Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
gr (forall a. a -> Set a
Set.singleton node
n)


buildReverseQueue :: Tree node -> [node] -> [node]
buildReverseQueue :: forall node. Tree node -> [node] -> [node]
buildReverseQueue (Tree.Node node
n [Tree node]
ns) [node]
queue =
   node
n forall a. a -> [a] -> [a]
: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall node. Tree node -> [node] -> [node]
buildReverseQueue) [node]
queue [Tree node]
ns

{- |
>>> map Set.toAscList $ Graph.stronglyConnectedComponents $ unlabGraph ['d'] ['g'*->'r', 'r'*->'a', 'a'*->'g', 'a'*->'p', 'p'*->'h', 'h'*->'p']
["d","hp","agr"]

prop> \(TestGraph gr) -> Set.fromList (map Graph.nodeSet (Graph.components gr)) == Set.fromList (Graph.stronglyConnectedComponents (addReversedEdges gr))
-}
stronglyConnectedComponents ::
   (Ord node) => Graph DirEdge node edgeLabel nodeLabel -> [Set node]
stronglyConnectedComponents :: forall node edgeLabel nodeLabel.
Ord node =>
Graph DirEdge node edgeLabel nodeLabel -> [Set node]
stronglyConnectedComponents Graph DirEdge node edgeLabel nodeLabel
gr =
   let forest :: Forest node
forest = forall (edge :: * -> *) node edgeLabel nodeLabel.
(Edge edge, Ord node) =>
Graph edge node edgeLabel nodeLabel -> Forest node
depthFirstSearch Graph DirEdge node edgeLabel nodeLabel
gr
       queue :: [node]
queue = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall node. Tree node -> [node] -> [node]
buildReverseQueue) [] Forest node
forest
       assignComponent :: t -> node -> StateT (Map node t) m ()
assignComponent t
root node
n = do
         Bool
assigned <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Bool
Map.member node
n
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
assigned) forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
n t
root
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ (t -> node -> StateT (Map node t) m ()
assignComponent t
root) forall a b. (a -> b) -> a -> b
$ forall (e :: * -> *) n el nl.
(Edge e, Ord n) =>
Graph e n el nl -> n -> [n]
predecessors Graph DirEdge node edgeLabel nodeLabel
gr node
n
       transposeMap :: Map node node -> [Set node]
transposeMap =
         forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Ord a => Set a -> Set a -> Set a
Set.union) forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\node
n node
root -> forall k a. k -> a -> Map k a
Map.singleton node
root forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton node
n)
   in Map node node -> [Set node]
transposeMap forall a b. (a -> b) -> a -> b
$
      forall s a. State s a -> s -> s
MS.execState (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ (\node
n -> forall {m :: * -> *} {t}.
Monad m =>
t -> node -> StateT (Map node t) m ()
assignComponent node
n node
n) [node]
queue) forall k a. Map k a
Map.empty



-- * Wrap utilities

type Wrap = IdentityT

wrap :: f a -> Wrap f a
wrap :: forall (f :: * -> *) a. f a -> Wrap f a
wrap = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT

unwrap :: Wrap f a -> f a
unwrap :: forall (f :: * -> *) a. Wrap f a -> f a
unwrap = forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

unwrapMap :: Map (Wrap e n) a -> Map (e n) a
unwrapMap :: forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic forall (f :: * -> *) a. Wrap f a -> f a
unwrap

wrapMap :: Map (e n) a -> Map (Wrap e n) a
wrapMap :: forall (e :: * -> *) n a. Map (e n) a -> Map (Wrap e n) a
wrapMap = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic forall (f :: * -> *) a. f a -> Wrap f a
wrap

unwrapSet :: Set (Wrap f a) -> Set (f a)
unwrapSet :: forall (f :: * -> *) a. Set (Wrap f a) -> Set (f a)
unwrapSet = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall (f :: * -> *) a. Wrap f a -> f a
unwrap


type InOutMap e n el nl = (Map (e n) el, nl, Map (e n) el)

unwrapInOut :: InOutMap (Wrap e) n el nl -> InOutMap e n el nl
unwrapInOut :: forall (e :: * -> *) n el nl.
InOutMap (Wrap e) n el nl -> InOutMap e n el nl
unwrapInOut = forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
mapFst3 forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
mapThd3 forall (e :: * -> *) n a. Map (Wrap e n) a -> Map (e n) a
unwrapMap

withWrappedGraph ::
   (Map n0 (InOutMap (Wrap e0) n0 el0 nl0) ->
    Map n1 (InOutMap (Wrap e1) n1 el1 nl1)) ->
   Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph :: forall n0 (e0 :: * -> *) el0 nl0 n1 (e1 :: * -> *) el1 nl1.
(Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
 -> Map n1 (InOutMap (Wrap e1) n1 el1 nl1))
-> Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
withWrappedGraph Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
-> Map n1 (InOutMap (Wrap e1) n1 el1 nl1)
f =
   forall (edge :: * -> *) node edgeLabel nodeLabel.
Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
-> Graph edge node edgeLabel nodeLabel
Graph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map n0 (InOutMap (Wrap e0) n0 el0 nl0)
-> Map n1 (InOutMap (Wrap e1) n1 el1 nl1)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (edge :: * -> *) node edgeLabel nodeLabel.
Graph edge node edgeLabel nodeLabel
-> Map node (InOutMap (Wrap edge) node edgeLabel nodeLabel)
graphMapWrap

fromWrap :: (Edge edge) => Wrap edge node -> node
fromWrap :: forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
fromWrap = forall (edge :: * -> *) node. Edge edge => edge node -> node
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap

toWrap :: (Edge edge) => Wrap edge node -> node
toWrap :: forall (edge :: * -> *) node. Edge edge => Wrap edge node -> node
toWrap   = forall (edge :: * -> *) node. Edge edge => edge node -> node
to   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Wrap f a -> f a
unwrap