{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
-- | Functions for modifying the graph. Although the graph structure is entirely expressed by the graph's node collection, for convenience and efficiency the graph representation also comprises a complementary collection of edges, that has to be synchronised with the node collection. Therefore each of the functions below involves a test for whether the graph structure has been changed, and if so, measures are taken to ensure the graph remains consistent.
--
-- Invariants for graph consistency:
--
--    * Every edge attached to some node points back to that node: ∀n∊N ∀e∊E: n→e ⇔ e→n
--
--    * There are no orphaned edges: ∀e∊E ∃n∊N: e→n

module GraphRewriting.Graph.Write
	(module GraphRewriting.Graph.Write, module GraphRewriting.Graph.Types, module Data.View)
where

import Prelude.Unicode
import GraphRewriting.Graph.Types
import GraphRewriting.Graph.Internal
import GraphRewriting.Graph.Read
import qualified GraphRewriting.Graph.Write.Unsafe as Unsafe
import Control.Monad
import Data.Maybe (catMaybes)
import Data.View
import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set


-- | assign new value to given node
writeNode ∷ View [Port] n ⇒ Node → n → Rewrite n ()
writeNode :: forall n. View [Port] n => Node -> n -> Rewrite n ()
writeNode Node
r = forall n. View [Port] n => Node -> (n -> n) -> Rewrite n ()
modifyNode Node
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | modify the node value
modifyNode ∷ View [Port] n ⇒ Node → (n → n) → Rewrite n ()
modifyNode :: forall n. View [Port] n => Node -> (n -> n) -> Rewrite n ()
modifyNode Node
n n -> n
f = do
	[Port]
esBefore ← forall a. Eq a => [a] -> [a]
nub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
	forall n. Node -> (n -> n) -> Rewrite n ()
Unsafe.modifyNode Node
n n -> n
f
	[Port]
esAfter ← forall a. Eq a => [a] -> [a]
nub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
	forall n. Node -> [Port] -> Rewrite n ()
Unsafe.register Node
n ([Port]
esAfter forall a. Eq a => [a] -> [a] -> [a]
\\ [Port]
esBefore)
	forall n. Node -> [Port] -> Rewrite n ()
Unsafe.unregister Node
n ([Port]
esBefore forall a. Eq a => [a] -> [a] -> [a]
\\ [Port]
esAfter)

-- | Wraps 'update' to update aspect @v@ of a node.
updateNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n ()
updateNode :: forall n v. (View [Port] n, View v n) => Node -> v -> Rewrite n ()
updateNode Node
n = forall n v.
(View [Port] n, View v n) =>
Node -> (v -> v) -> Rewrite n ()
adjustNode Node
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | Wraps 'adjust' to adjust aspect @v@ of a node.
adjustNode ∷ (View [Port] n, View v n) ⇒ Node → (v → v) → Rewrite n ()
adjustNode :: forall n v.
(View [Port] n, View v n) =>
Node -> (v -> v) -> Rewrite n ()
adjustNode Node
n = forall n. View [Port] n => Node -> (n -> n) -> Rewrite n ()
modifyNode Node
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n. View v n => (v -> v) -> n -> n
adjust

adjustNodeM ∷ (View [Port] n, View v n) ⇒ Node → (v → Rewrite n v) → Rewrite n ()
adjustNodeM :: forall n v.
(View [Port] n, View v n) =>
Node -> (v -> Rewrite n v) -> Rewrite n ()
adjustNodeM Node
n v -> Rewrite n v
f = forall n v. (View [Port] n, View v n) => Node -> v -> Rewrite n ()
updateNode Node
n forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> Rewrite n v
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n

-- | add a new node with value @n@ to the graph
newNode ∷ View [Port] n ⇒ n → Rewrite n Node
newNode :: forall n. View [Port] n => n -> Rewrite n Node
newNode n
v = do
	Int
key ← forall n. Rewrite n Int
newRef
	let n :: Node
n = Int -> Node
Node Int
key
	forall n. (IntMap n -> IntMap n) -> Rewrite n ()
modifyNodeMap forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
key n
v
	forall n. Node -> [Port] -> Rewrite n ()
Unsafe.register Node
n (forall v n. View v n => n -> v
inspect n
v)
	forall (m :: * -> *) a. Monad m => a -> m a
return Node
n

-- | Create a new node by cloning another, at the same time updating aspect @v@. When defining rewrites in a context where it is not known what type @n@ the nodes of the graph have, this is the only way to add new nodes to the graph.
copyNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n Node
copyNode :: forall n v.
(View [Port] n, View v n) =>
Node -> v -> Rewrite n Node
copyNode Node
n v
f = forall n. View [Port] n => n -> Rewrite n Node
newNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n. View v n => v -> n -> n
update v
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode Node
n

-- | Create a new (unconnected) edge. It is expected that the created edge is connected to a port sooner or later. Otherwise the graph will invove unconnected edges.
newEdge ∷ Rewrite n Edge
newEdge :: forall n. Rewrite n Port
newEdge = Int -> Port
Edge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Rewrite n Int
newRef

-- | remove node from the graph
deleteNode ∷ View [Port] n ⇒ Node → Rewrite n ()
deleteNode :: forall n. View [Port] n => Node -> Rewrite n ()
deleteNode Node
n = do
	forall n. Node -> [Port] -> Rewrite n ()
Unsafe.unregister Node
n forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Eq a => [a] -> [a]
nub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
	forall n. (IntMap n -> IntMap n) -> Rewrite n ()
modifyNodeMap (forall a. Int -> IntMap a -> IntMap a
Map.delete forall a b. (a -> b) -> a -> b
$ Node -> Int
nKey Node
n)

-- | Disconnect ports connected to the given edge by assigning a new (dangling) edge to each of the ports. Then the edge is deleted.
deleteEdge ∷ View [Port] n ⇒ Edge → Rewrite n [Edge]
deleteEdge :: forall n. View [Port] n => Port -> Rewrite n [Port]
deleteEdge Port
e = do
	[Port]
es ← forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {n}. View [Port] n => Node -> Rewrite n [Port]
disconnectPorts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Port -> m [Node]
attachedNodes Port
e
	forall n. (IntMap IntSet -> IntMap IntSet) -> Rewrite n ()
modifyEdgeMap forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
Map.delete (Port -> Int
eKey Port
e)
	forall (m :: * -> *) a. Monad m => a -> m a
return [Port]
es
	where
	disconnectPorts :: Node -> Rewrite n [Port]
disconnectPorts Node
n = do
		[Port]
ports ← forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
		([Maybe Port]
freshEdges, [Port]
ports') ← forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {n}. Port -> Rewrite n (Maybe Port, Port)
substPort [Port]
ports
		forall n v. (View [Port] n, View v n) => Node -> v -> Rewrite n ()
updateNode Node
n [Port]
ports'
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Port]
freshEdges
	substPort :: Port -> Rewrite n (Maybe Port, Port)
substPort Port
p = if Port
p forall α. Eq α => α -> α -> Bool
≡ Port
e
		then do
			Port
p' ← forall n. Rewrite n Port
newEdge
			forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Port
p', Port
p')
		else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Port
p)

-- | Reconnects the ports connected to the second edge to the first one. Then the second edge is deleted.
mergeEdges ∷ View [Port] n ⇒ Edge → Edge → Rewrite n ()
mergeEdges :: forall n. View [Port] n => Port -> Port -> Rewrite n ()
mergeEdges Port
e1 Port
e2 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Port
e1 forall α. Eq α => α -> α -> Bool
≢ Port
e2) forall a b. (a -> b) -> a -> b
$ do
		[Node]
ns ← forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Port -> m [Node]
attachedNodes Port
e2
		forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [forall n. Node -> (n -> n) -> Rewrite n ()
Unsafe.modifyNode Node
n (forall v n. View v n => (v -> v) -> n -> n
adjust forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Port -> Port
replacePort) | Node
n ← [Node]
ns]
		forall n. (IntMap IntSet -> IntMap IntSet) -> Rewrite n ()
modifyEdgeMap forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Int -> IntMap a -> IntMap a
Map.adjust (IntSet -> IntSet -> IntSet
Set.union forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Node -> Int
nKey [Node]
ns) (Port -> Int
eKey Port
e1)
		forall n. View [Port] n => Port -> Rewrite n [Port]
deleteEdge Port
e2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
	where replacePort :: Port -> Port
replacePort Port
p = if Port
p forall α. Eq α => α -> α -> Bool
≡ Port
e2 then Port
e1 else Port
p