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 Control.Applicative
import Data.Maybe (catMaybes)
import Data.View
import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
writeNode ∷ View [Port] n ⇒ Node → n → Rewrite n ()
writeNode r = modifyNode r . const
modifyNode ∷ View [Port] n ⇒ Node → (n → n) → Rewrite n ()
modifyNode n f = do
esBefore ← nub <$> inspectNode n
Unsafe.modifyNode n f
esAfter ← nub <$> inspectNode n
Unsafe.register n (esAfter \\ esBefore)
Unsafe.unregister n (esBefore \\ esAfter)
updateNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n ()
updateNode n = adjustNode n . const
adjustNode ∷ (View [Port] n, View v n) ⇒ Node → (v → v) → Rewrite n ()
adjustNode n = modifyNode n . adjust
adjustNodeM ∷ (View [Port] n, View v n) ⇒ Node → (v → Rewrite n v) → Rewrite n ()
adjustNodeM n f = updateNode n =<< f =<< inspectNode n
newNode ∷ View [Port] n ⇒ n → Rewrite n Node
newNode v = do
key ← newRef
let n = Node key
modifyNodeMap $ Map.insert key v
Unsafe.register n (inspect v)
return n
copyNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n Node
copyNode n f = newNode . update f =<< readNode n
newEdge ∷ Rewrite n Edge
newEdge = Edge <$> newRef
deleteNode ∷ View [Port] n ⇒ Node → Rewrite n ()
deleteNode n = do
Unsafe.unregister n =<< nub <$> inspectNode n
modifyNodeMap (Map.delete $ nKey n)
deleteEdge ∷ View [Port] n ⇒ Edge → Rewrite n [Edge]
deleteEdge e = do
es ← fmap concat $ mapM disconnectPorts =<< attachedNodes e
modifyEdgeMap $ Map.delete (eKey e)
return es
where
disconnectPorts n = do
ports ← inspectNode n
(freshEdges, ports') ← unzip <$> mapM substPort ports
updateNode n ports'
return $ catMaybes freshEdges
substPort p = if p ≡ e
then do
p' ← newEdge
return (Just p', p')
else return (Nothing, p)
mergeEdges ∷ View [Port] n ⇒ Edge → Edge → Rewrite n ()
mergeEdges e1 e2 = when (e1 ≢ e2) $ do
ns ← attachedNodes e2
sequence_ [Unsafe.modifyNode n (adjust $ map replacePort) | n ← ns]
modifyEdgeMap $ Map.adjust (Set.union $ Set.fromList $ map nKey ns) (eKey e1)
deleteEdge e2 >> return ()
where replacePort p = if p ≡ e2 then e1 else p