{-# LANGUAGE ScopedTypeVariables #-}

-- | GraphConnection contains various operations on graph connections
module Graphs.GraphConnection(
   SubGraph(..),
      -- defines a subgraph as a subset of nodes and node types.
      -- The user is responsible for making sure that if a node is in
      -- the subgraph, so is its type!
   attachSuperGraph,
      -- :: SubGraph
      --    -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      --    -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      -- turn a graph connection into one, which when passing information back
      -- to the parent, ignores updates which don't lie in the subgraph.
   attachSubGraph,
      -- :: SubGraph
      --    -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      --    -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      -- Ditto, but only accepts updates (and parts of the original graph)
      -- which lie in the original graph.

   mapGraphConnection,
   ) where

import Control.Monad(filterM)

import qualified Data.Set as Set
import Control.Concurrent

import Util.Computation (done)

import Graphs.Graph

-----------------------------------------------------------------------------
-- Connection State
-----------------------------------------------------------------------------

-- We keep track of the arcs currently not in the subgraph; this
-- allows us to filter out attempts to delete from the subgraph.
-- (Attempts to delete non-existent arcs is normally harmless but,
-- apart from wasting time, could get passed onto other clients of the
-- server, which might have themselves constructed identical arcs
-- in their subgraphs.)
newtype ConnectionState = ConnectionState (MVar (Set.Set Arc))
-- This contains the arcs NOT in the subgraph, because for our planned
-- application

newConnectionState :: IO ConnectionState
newConnectionState :: IO ConnectionState
newConnectionState =
   do
      MVar (Set Arc)
mVar <- Set Arc -> IO (MVar (Set Arc))
forall a. a -> IO (MVar a)
newMVar Set Arc
forall a. Set a
Set.empty
      ConnectionState -> IO ConnectionState
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar (Set Arc) -> ConnectionState
ConnectionState MVar (Set Arc)
mVar)

arcIsInSubGraph :: ConnectionState -> Arc -> IO Bool
arcIsInSubGraph :: ConnectionState -> Arc -> IO Bool
arcIsInSubGraph (ConnectionState MVar (Set Arc)
mVar) Arc
arc =
   do
      Set Arc
set <- MVar (Set Arc) -> IO (Set Arc)
forall a. MVar a -> IO a
takeMVar MVar (Set Arc)
mVar
      let
         result :: Bool
result = Bool -> Bool
not (Arc -> Set Arc -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Arc
arc Set Arc
set)
      MVar (Set Arc) -> Set Arc -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Set Arc)
mVar Set Arc
set
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result

arcAdd :: ConnectionState -> Arc -> IO ()
arcAdd :: ConnectionState -> Arc -> IO ()
arcAdd (ConnectionState MVar (Set Arc)
mVar) Arc
arc =
   do
      Set Arc
set <- MVar (Set Arc) -> IO (Set Arc)
forall a. MVar a -> IO a
takeMVar MVar (Set Arc)
mVar
      MVar (Set Arc) -> Set Arc -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Set Arc)
mVar (Set Arc -> Set Arc -> Set Arc
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Arc
set (Arc -> Set Arc
forall a. a -> Set a
Set.singleton Arc
arc))

arcDelete :: ConnectionState -> Arc -> IO ()
arcDelete :: ConnectionState -> Arc -> IO ()
arcDelete (ConnectionState MVar (Set Arc)
mVar) Arc
arc =
   do
      Set Arc
set <- MVar (Set Arc) -> IO (Set Arc)
forall a. MVar a -> IO a
takeMVar MVar (Set Arc)
mVar
      MVar (Set Arc) -> Set Arc -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Set Arc)
mVar (Set Arc -> Set Arc -> Set Arc
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Arc
set (Arc -> Set Arc
forall a. a -> Set a
Set.singleton Arc
arc))

-----------------------------------------------------------------------------
-- SubGraph
-----------------------------------------------------------------------------

data SubGraph = SubGraph {
   SubGraph -> Node -> Bool
nodeIn :: Node -> Bool,
   SubGraph -> NodeType -> Bool
nodeTypeIn :: NodeType -> Bool
   }

updateIsInSubGraph :: SubGraph -> ConnectionState
   -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO Bool
updateIsInSubGraph :: SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
updateIsInSubGraph (SubGraph{nodeIn :: SubGraph -> Node -> Bool
nodeIn = Node -> Bool
nodeIn,nodeTypeIn :: SubGraph -> NodeType -> Bool
nodeTypeIn = NodeType -> Bool
nodeTypeIn})
      ConnectionState
connectionState Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update =
   case Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update of
      NewNodeType NodeType
nodeType nodeTypeLabel
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> Bool
nodeTypeIn NodeType
nodeType)
      SetNodeTypeLabel NodeType
nodeType nodeTypeLabel
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeType -> Bool
nodeTypeIn NodeType
nodeType)
      NewNode Node
node NodeType
_ nodeLabel
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Bool
nodeIn Node
node)
      DeleteNode Node
node -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Bool
nodeIn Node
node)
      SetNodeLabel Node
node nodeLabel
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Bool
nodeIn Node
node)
      SetNodeType Node
node NodeType
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Bool
nodeIn Node
node)
      NewArc Arc
arc ArcType
_ arcLabel
_ Node
node1 Node
node2 ->
         do
            let
               inSubGraph :: Bool
inSubGraph = Node -> Bool
nodeIn Node
node1 Bool -> Bool -> Bool
&& Node -> Bool
nodeIn Node
node2
            if Bool
inSubGraph
               then
                  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               else
                  do
                     ConnectionState -> Arc -> IO ()
arcAdd ConnectionState
connectionState Arc
arc
                     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      DeleteArc Arc
arc ->
         do
            Bool
inSubGraph <- ConnectionState -> Arc -> IO Bool
arcIsInSubGraph ConnectionState
connectionState Arc
arc
            if Bool
inSubGraph
               then
                  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               else
                  do
                     ConnectionState -> Arc -> IO ()
arcDelete ConnectionState
connectionState Arc
arc
                     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      SetArcLabel Arc
arc arcLabel
_ -> ConnectionState -> Arc -> IO Bool
arcIsInSubGraph ConnectionState
connectionState Arc
arc
      SetArcType Arc
arc ArcType
_ -> ConnectionState -> Arc -> IO Bool
arcIsInSubGraph ConnectionState
connectionState Arc
arc
      Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-----------------------------------------------------------------------------
-- GraphConnection operations
-----------------------------------------------------------------------------

attachSuperGraph :: SubGraph
   -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
attachSuperGraph :: SubGraph
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
attachSuperGraph SubGraph
subGraph GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnection Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentChanges =
   do
      GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData <- GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnection Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentChanges
      -- all changes to the parent get passed on

      ConnectionState
connectionState <- IO ConnectionState
newConnectionState
      let
         oldGraphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
oldGraphUpdate = GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData

         newGraphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
newGraphUpdate Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update =
            -- updates to the child only get passed on if in the subgraph.
            do
               Bool
isInSubGraph
                  <- SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
updateIsInSubGraph SubGraph
subGraph ConnectionState
connectionState Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
               if Bool
isInSubGraph
                  then
                     Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
oldGraphUpdate Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
                  else
                     IO ()
forall (m :: * -> *). Monad m => m ()
done
      GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO
     (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData {graphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
newGraphUpdate})

attachSubGraph :: SubGraph
   -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
attachSubGraph :: SubGraph
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
attachSubGraph SubGraph
subGraph GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnection Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentChanges =
   do
      ConnectionState
connectionState <- IO ConnectionState
newConnectionState
      let
         newParentChanges :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
newParentChanges Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update =
         -- Changes from the parent only get passed on if in the subgraph.
            do
               Bool
isInSubGraph
                  <- SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
updateIsInSubGraph SubGraph
subGraph ConnectionState
connectionState Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
               if Bool
isInSubGraph
                  then
                     Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentChanges Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
                  else
                     IO ()
forall (m :: * -> *). Monad m => m ()
done
      GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData <- GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnection Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
newParentChanges
      -- We have to filter the graph state.
      let
         oldGraphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
oldGraphState = GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData
         oldUpdates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldUpdates = CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
oldGraphState
      [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
newUpdates <- (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO Bool)
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SubGraph
-> ConnectionState
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO Bool
updateIsInSubGraph SubGraph
subGraph ConnectionState
connectionState)
         [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldUpdates
      let
         newGraphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
newGraphState = CannedGraph :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
CannedGraph {updates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates = [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
newUpdates}
      GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO
     (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphConnectionData {graphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState = CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
newGraphState})

{-# DEPRECATED attachSuperGraph,attachSubGraph
   "Functions need to be updated to cope with MultiUpdate" #-}

--  | Throw away the old types in a graph, and recompute them from the
-- node and arc labels.
mapGraphConnection ::
   (nodeLabel1 -> (nodeLabel2,NodeType))
      -- ^ function to compute node label in new graph and type
   -> (arcLabel1 -> (arcLabel2,ArcType))
      -- ^ function to compute arc label in new graph and type
   -> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
      -- ^ updates prepended to initialse types.
      -- (The type declarations in the input graph are discarded)
   -> GraphConnection nodeLabel1 () arcLabel1 ()
   -> GraphConnection nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
   -- NB.  Changes to the child do not get passed back.
mapGraphConnection :: (nodeLabel1 -> (nodeLabel2, NodeType))
-> (arcLabel1 -> (arcLabel2, ArcType))
-> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> GraphConnection nodeLabel1 () arcLabel1 ()
-> GraphConnection
     nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
mapGraphConnection
      (nodeLabel1 -> (nodeLabel2, NodeType)
mapNode :: nodeLabel1 -> (nodeLabel2,NodeType))
      (arcLabel1 -> (arcLabel2, ArcType)
mapArc :: arcLabel1 -> (arcLabel2,ArcType))
      ([Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
initialUpdates
         :: [Update nodeLabel2  nodeTypeLabel2 arcLabel2 arcTypeLabel2])
      GraphConnection nodeLabel1 () arcLabel1 ()
graphConnection1 Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2 -> IO ()
updateFn2 =
   let
      mapUpdate :: Update nodeLabel1 () arcLabel1 ()
         -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
      mapUpdate :: Update nodeLabel1 () arcLabel1 ()
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
mapUpdate Update nodeLabel1 () arcLabel1 ()
update = case Update nodeLabel1 () arcLabel1 ()
update of
         NewNodeType NodeType
_ ()
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         SetNodeTypeLabel NodeType
_ ()
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         NewNode Node
node NodeType
_ nodeLabel1
nodeTypeLabel1 ->
            let
               (nodeLabel2
nodeTypeLabel2,NodeType
nodeType2) = nodeLabel1 -> (nodeLabel2, NodeType)
mapNode nodeLabel1
nodeTypeLabel1
            in
               Node
-> NodeType
-> nodeLabel2
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNode Node
node NodeType
nodeType2 nodeLabel2
nodeTypeLabel2
         DeleteNode Node
node -> Node -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
DeleteNode Node
node
         SetNodeLabel Node
node nodeLabel1
nodeLabel1 ->
            let
               (nodeLabel2
nodeLabel2,NodeType
nodeType2) = nodeLabel1 -> (nodeLabel2, NodeType)
mapNode nodeLabel1
nodeLabel1
            in
               [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
MultiUpdate [
                  Node
-> nodeLabel2
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SetNodeLabel Node
node nodeLabel2
nodeLabel2,
                  Node
-> NodeType
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> NodeType -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SetNodeType Node
node NodeType
nodeType2
                  ]
         SetNodeType Node
_ NodeType
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         NewArcType ArcType
_ ()
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         SetArcTypeLabel ArcType
_ ()
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         NewArc Arc
arc ArcType
_ arcLabel1
arcLabel1 Node
nodeFrom Node
nodeTo ->
            let
               (arcLabel2
arcLabel2,ArcType
arcType2) = arcLabel1 -> (arcLabel2, ArcType)
mapArc arcLabel1
arcLabel1
            in
               Arc
-> ArcType
-> arcLabel2
-> Node
-> Node
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArc Arc
arc ArcType
arcType2 arcLabel2
arcLabel2 Node
nodeFrom Node
nodeTo
         DeleteArc Arc
arc -> Arc -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
DeleteArc Arc
arc
         SetArcLabel Arc
arc arcLabel1
arcLabel1 ->
            let
               (arcLabel2
arcLabel2,ArcType
arcType2) = arcLabel1 -> (arcLabel2, ArcType)
mapArc arcLabel1
arcLabel1
            in
               [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
MultiUpdate [
                  Arc
-> arcLabel2
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> arcLabel -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SetArcLabel Arc
arc arcLabel2
arcLabel2,
                  Arc
-> ArcType
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> ArcType -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SetArcType Arc
arc ArcType
arcType2
                  ]
         SetArcType Arc
_ ArcType
_ -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop
         MultiUpdate [Update nodeLabel1 () arcLabel1 ()]
updates -> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
MultiUpdate ((Update nodeLabel1 () arcLabel1 ()
 -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2)
-> [Update nodeLabel1 () arcLabel1 ()]
-> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Update nodeLabel1 () arcLabel1 ()
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
mapUpdate [Update nodeLabel1 () arcLabel1 ()]
updates)

      updateFn1 :: Update nodeLabel1 () arcLabel1 () -> IO ()
updateFn1 Update nodeLabel1 () arcLabel1 ()
update1 = Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2 -> IO ()
updateFn2 (Update nodeLabel1 () arcLabel1 ()
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
mapUpdate Update nodeLabel1 () arcLabel1 ()
update1)

      nop :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
nop = [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
MultiUpdate []
   in
      do
         GraphConnectionData nodeLabel1 () arcLabel1 ()
graphConnectionData1 <- GraphConnection nodeLabel1 () arcLabel1 ()
graphConnection1 Update nodeLabel1 () arcLabel1 () -> IO ()
updateFn1
         let
            cannedGraph1 :: CannedGraph nodeLabel1 () arcLabel1 ()
cannedGraph1 = GraphConnectionData nodeLabel1 () arcLabel1 ()
-> CannedGraph nodeLabel1 () arcLabel1 ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState GraphConnectionData nodeLabel1 () arcLabel1 ()
graphConnectionData1
            updates1 :: [Update nodeLabel1 () arcLabel1 ()]
updates1 = CannedGraph nodeLabel1 () arcLabel1 ()
-> [Update nodeLabel1 () arcLabel1 ()]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates CannedGraph nodeLabel1 () arcLabel1 ()
cannedGraph1
            updates2 :: [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
updates2 = [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
initialUpdates [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
-> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
forall a. [a] -> [a] -> [a]
++ (Update nodeLabel1 () arcLabel1 ()
 -> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2)
-> [Update nodeLabel1 () arcLabel1 ()]
-> [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Update nodeLabel1 () arcLabel1 ()
-> Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
mapUpdate [Update nodeLabel1 () arcLabel1 ()]
updates1
            cannedGraph2 :: CannedGraph nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
cannedGraph2 = CannedGraph :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
CannedGraph {updates :: [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
updates = [Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2]
updates2}
            graphUpdate2 :: p -> m ()
graphUpdate2 p
_ = m ()
forall (m :: * -> *). Monad m => m ()
done

            graphConnectionData2 :: GraphConnectionData
  nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
graphConnectionData2 = GraphConnectionData nodeLabel1 () arcLabel1 ()
graphConnectionData1 {
               graphState :: CannedGraph nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
graphState = CannedGraph nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
cannedGraph2,
               graphUpdate :: Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2 -> IO ()
graphUpdate = Update nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2 -> IO ()
forall (m :: * -> *) p. Monad m => p -> m ()
graphUpdate2
               }
         GraphConnectionData
  nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
-> IO
     (GraphConnectionData
        nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2)
forall (m :: * -> *) a. Monad m => a -> m a
return GraphConnectionData
  nodeLabel2 nodeTypeLabel2 arcLabel2 arcTypeLabel2
graphConnectionData2