{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
module GraphRewriting.Rule.Internal where

import GraphRewriting.Graph.Internal
import GraphRewriting.Graph.Write
import qualified Data.IntSet as Set


type MergeEdges = [Edge]

newtype Replace n a = Replace (Rewrite n (a, [MergeEdges]))

mergeEs :: View [Port] n ⇒ MergeEdges -> Rewrite n ()
mergeEs :: forall n. View [Port] n => [Port] -> Rewrite n ()
mergeEs (Port
e:[Port]
es) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall n. View [Port] n => Port -> Port -> Rewrite n ()
mergeEdges Port
e) [Port]
es

type Set = Set.IntSet

joinEdges ∷ [[Edge]] → [[Edge]]
joinEdges :: [[Port]] -> [[Port]]
joinEdges = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Int -> Port
Edge forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
Set.elems) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> [IntSet]
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> IntSet
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Port -> Int
eKey)

-- The code below is essentially maintaining equivalence classes. TODO: use a library for that.

-- | Join pairs of sets with a common element until all sets are disjoint.
join ∷ [Set] → [Set]
join :: [IntSet] -> [IntSet]
join = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IntSet -> [IntSet] -> [IntSet]
join1 []

-- | Add to a list of disjoint sets a further set and join sets with common elements such that the resulting list again only contains disjoint sets.
join1 ∷ Set → [Set] → [Set]
join1 :: IntSet -> [IntSet] -> [IntSet]
join1 IntSet
x [    ] = [IntSet
x]
join1 IntSet
x (IntSet
y:[IntSet]
ys) = if IntSet -> Bool
Set.null forall a b. (a -> b) -> a -> b
$ IntSet -> IntSet -> IntSet
Set.intersection IntSet
x IntSet
y
	then IntSet
y forall a. a -> [a] -> [a]
: IntSet -> [IntSet] -> [IntSet]
join1 IntSet
x [IntSet]
ys
	else IntSet -> [IntSet] -> [IntSet]
join1 (IntSet -> IntSet -> IntSet
Set.union IntSet
x IntSet
y) [IntSet]
ys