{-# LANGUAGE ScopedTypeVariables #-}

-- | SimpleGraph is, as the name implies, a simple implementation
-- of the Graph interface.  For example, we don't bother to sort
-- the arcs going out of a node, meaning that to find out if two
-- nodes are connected requires searching all the arcs out of one
-- of the nodes, or all the arcs into the other.
--
-- Notes on synchronicity.
--    The Update operations Set*Label are intrinsically unsafe in
--    this implementation since if two communicating SimpleGraphs
--    both execute a Set*Label operation with different label values
--    they may end up with each others values.  It is recommended that
--    Set*Label only be used during the initialisation of the object,
--    as a way of tieing the knot.
--
--    In addition, Update operations which create a value based on a previous
--    value (EG a NewNode creates a Node based on a NodeType), do
--    assume that the previous value has already been created.
--
--    I realise this is somewhat informal.  It may be necessary to
--    replace SimpleGraph by something more complicated later . . .
module Graphs.SimpleGraph(
   SimpleGraph, -- implements Graph

   getNameSource,
   -- :: SimpleGraph -> NameSource
   -- We need to hack the name source as part of the backup process.


   delayedAction,
      -- :: Graph graph
      -- => graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
      -- -> Node -- node
      -- -> IO () -- action to perform when the node is created in the graph.
      -- -> IO ()

   ClientData(..),

   ) where

import Data.List(delete)

import Control.Concurrent
import Control.Exception

import Util.Computation (done)
import Util.Object
import Util.Registry
import Util.AtomString

import Events.Destructible
import Events.Events
import Events.Channels
import Events.Synchronized

import Reactor.BSem

import Reactor.InfoBus

import Graphs.NewNames
import Graphs.Graph

------------------------------------------------------------------------
-- Data types and trivial instances
------------------------------------------------------------------------

data SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
   SimpleGraph {
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData :: Registry Node (NodeData nodeLabel),
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData :: Registry NodeType nodeTypeLabel,
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData :: Registry Arc (ArcData arcLabel),
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData :: Registry ArcType arcTypeLabel,
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource :: NameSource,
         -- Where new Node/Arc/NodeType/ArcType's can come from.
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar :: MVar
         [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel],
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentDeRegister :: IO (),
         -- deRegister in GraphConnection from which graph was created.
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
graphID :: ObjectID,
         -- used to identify the graph (for InfoBus actually)
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> BSem
bSem :: BSem -- All access operations should synchronize here.
      }

getNameSource :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel ->
   NameSource
getNameSource :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
getNameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
simpleGraph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
simpleGraph

instance Synchronized
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel) where
   synchronize :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph IO b
command = BSem -> IO b -> IO b
forall a b. Synchronized a => a -> IO b -> IO b
synchronize (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> BSem
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> BSem
bSem SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) IO b
command

instance Object
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel) where
   objectID :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
objectID SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
graphID SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

data NodeData nodeLabel = NodeData {
   NodeData nodeLabel -> nodeLabel
nodeLabel :: nodeLabel,
   NodeData nodeLabel -> NodeType
nodeType :: NodeType,
   NodeData nodeLabel -> [Arc]
arcsIn :: [Arc],
   NodeData nodeLabel -> [Arc]
arcsOut :: [Arc]
   }

data ArcData arcLabel = ArcData {
   ArcData arcLabel -> arcLabel
arcLabel :: arcLabel,
   ArcData arcLabel -> ArcType
arcType :: ArcType,
   ArcData arcLabel -> Node
source :: Node,
   ArcData arcLabel -> Node
target :: Node
   }

data ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel =
   ClientData {
      ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
clientID :: ObjectID,
      ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink :: (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
         -> IO())
      }

instance Eq (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
      where
   == :: ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
(==) ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData1 ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData2 =
      (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
clientID ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData1) ObjectID -> ObjectID -> Bool
forall a. Eq a => a -> a -> Bool
== (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
clientID ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData2)
   /= :: ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
(/=) ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData1 ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData2 =
      (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
clientID ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData1) ObjectID -> ObjectID -> Bool
forall a. Eq a => a -> a -> Bool
/= (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
clientID ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData2)

------------------------------------------------------------------------
-- Class Instance
------------------------------------------------------------------------

instance Graph SimpleGraph where
   getNodes :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Node]
getNodes SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Node] -> IO [Node]
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Registry Node (NodeData nodeLabel) -> IO [Node]
forall registry from.
KeyOpsRegistry registry from =>
registry -> IO [from]
listKeys (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph))
   getArcs :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Arc]
getArcs SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [Arc] -> IO [Arc]
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Registry Arc (ArcData arcLabel) -> IO [Arc]
forall registry from.
KeyOpsRegistry registry from =>
registry -> IO [from]
listKeys (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph))
   getNodeTypes :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [NodeType]
getNodeTypes SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [NodeType] -> IO [NodeType]
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Registry NodeType nodeTypeLabel -> IO [NodeType]
forall registry from.
KeyOpsRegistry registry from =>
registry -> IO [from]
listKeys (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph))
   getArcTypes :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ArcType]
getArcTypes SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ArcType] -> IO [ArcType]
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Registry ArcType arcTypeLabel -> IO [ArcType]
forall registry from.
KeyOpsRegistry registry from =>
registry -> IO [from]
listKeys (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph))

   getArcsOut :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO [Arc]
getArcsOut = (NodeData nodeLabel -> [Arc])
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO [Arc]
forall nodeLabel result nodeTypeLabel arcLabel arcTypeLabel.
(NodeData nodeLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO result
getNodeInfo NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsOut
   getArcsIn :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO [Arc]
getArcsIn = (NodeData nodeLabel -> [Arc])
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO [Arc]
forall nodeLabel result nodeTypeLabel arcLabel arcTypeLabel.
(NodeData nodeLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO result
getNodeInfo NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsIn
   getNodeLabel :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO nodeLabel
getNodeLabel = (NodeData nodeLabel -> nodeLabel)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO nodeLabel
forall nodeLabel result nodeTypeLabel arcLabel arcTypeLabel.
(NodeData nodeLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO result
getNodeInfo NodeData nodeLabel -> nodeLabel
forall nodeLabel. NodeData nodeLabel -> nodeLabel
nodeLabel
   getNodeType :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO NodeType
getNodeType = (NodeData nodeLabel -> NodeType)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO NodeType
forall nodeLabel result nodeTypeLabel arcLabel arcTypeLabel.
(NodeData nodeLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO result
getNodeInfo NodeData nodeLabel -> NodeType
forall nodeLabel. NodeData nodeLabel -> NodeType
nodeType

   getNodeTypeLabel :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NodeType -> IO nodeTypeLabel
getNodeTypeLabel SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph NodeType
nodeType =
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO nodeTypeLabel -> IO nodeTypeLabel
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
         String
-> Registry NodeType nodeTypeLabel -> NodeType -> IO nodeTypeLabel
forall registry from to.
GetSetRegistry registry from to =>
String -> registry -> from -> IO to
getValue' String
"NodeTypeLabel" (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) NodeType
nodeType)

   getSource :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO Node
getSource = (ArcData arcLabel -> Node)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO Node
forall arcLabel result nodeLabel nodeTypeLabel arcTypeLabel.
(ArcData arcLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO result
getArcInfo ArcData arcLabel -> Node
forall arcLabel. ArcData arcLabel -> Node
source
   getTarget :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO Node
getTarget = (ArcData arcLabel -> Node)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO Node
forall arcLabel result nodeLabel nodeTypeLabel arcTypeLabel.
(ArcData arcLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO result
getArcInfo ArcData arcLabel -> Node
forall arcLabel. ArcData arcLabel -> Node
target
   getArcLabel :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO arcLabel
getArcLabel = (ArcData arcLabel -> arcLabel)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO arcLabel
forall arcLabel result nodeLabel nodeTypeLabel arcTypeLabel.
(ArcData arcLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO result
getArcInfo ArcData arcLabel -> arcLabel
forall arcLabel. ArcData arcLabel -> arcLabel
arcLabel
   getArcType :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc -> IO ArcType
getArcType = (ArcData arcLabel -> ArcType)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO ArcType
forall arcLabel result nodeLabel nodeTypeLabel arcTypeLabel.
(ArcData arcLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO result
getArcInfo ArcData arcLabel -> ArcType
forall arcLabel. ArcData arcLabel -> ArcType
arcType

   getArcTypeLabel :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ArcType -> IO arcTypeLabel
getArcTypeLabel SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph ArcType
arcType =
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO arcTypeLabel -> IO arcTypeLabel
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
         String
-> Registry ArcType arcTypeLabel -> ArcType -> IO arcTypeLabel
forall registry from to.
GetSetRegistry registry from to =>
String -> registry -> from -> IO to
getValue' String
"ArcTypeLabel" (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) ArcType
arcType)

   shareGraph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
shareGraph SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph =
      (\ Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink ->
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO
     (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> IO
     (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
            do
               CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState <- SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
cannGraph SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
               ObjectID
clientID <- IO ObjectID
newObject
               let
                  clientData :: ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData = ClientData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ObjectID
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
ClientData
                     {clientID :: ObjectID
clientID = ObjectID
clientID,clientSink :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink}
                  mVar :: MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
               [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients <- MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. MVar a -> IO a
takeMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar
               MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. a -> [a] -> [a]
: [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients)
               let
                  deRegister :: IO ()
deRegister =
                     do
                        -- It is intentional that we don't sync this.
                        -- I don't see how it can matter.
                        [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients <- MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. MVar a -> IO a
takeMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar
                        MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. Eq a => a -> [a] -> [a]
delete ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients)
                  graphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update =
                     SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
applyUpdateFromClient SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData

               NameSourceBranch
nameSourceBranch <- NameSource -> IO NameSourceBranch
branch (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)

               GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO
     (GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (GraphConnectionData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> NameSourceBranch
-> GraphConnectionData
     nodeLabel nodeTypeLabel arcLabel arcTypeLabel
GraphConnectionData {
                     graphState :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState = CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState,
                     deRegister :: IO ()
deRegister = IO ()
deRegister,
                     graphUpdate :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate,
                     nameSourceBranch :: NameSourceBranch
nameSourceBranch = NameSourceBranch
nameSourceBranch
                     })
            ) -- end of sync
         )

   newGraph :: GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newGraph GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
getGraphConnection =
      do
         Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
graphUpdatesQueue <- IO (Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel))
forall a. IO (Channel a)
newChannel
         GraphConnectionData {
            graphState :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState = CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState,
            deRegister :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
deRegister = IO ()
deRegister,
            graphUpdate :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate,
            nameSourceBranch :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
GraphConnectionData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSourceBranch
nameSourceBranch = NameSourceBranch
nameSourceBranch
            } <- GraphConnection nodeLabel nodeTypeLabel arcLabel arcTypeLabel
getGraphConnection (Event () -> IO ()
forall a. Event a -> IO a
sync (Event () -> IO ())
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Event ())
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event () -> Event ()
forall a. Event a -> Event ()
noWait (Event () -> Event ())
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Event ())
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Event ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
graphUpdatesQueue))

         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph <- CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
-> NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
-> NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
uncannGraph CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graphState IO ()
deRegister NameSourceBranch
nameSourceBranch
         let
            mVar :: MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

         -- modify client list
         (oldClients :: [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients@[]) <- MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. MVar a -> IO a
takeMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar
         -- if uncannGraph is later changed to add clients,
         -- we probably need to synchronize the changes to graph
         -- in this method!
         ObjectID
clientID <- IO ObjectID
newObject
         let
            clientSink :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
graphUpdate Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
            clientData :: ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData = ClientData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ObjectID
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
ClientData
               {clientID :: ObjectID
clientID = ObjectID
clientID,clientSink :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink}
         MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. a -> [a] -> [a]
: [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
oldClients)

         -- set up thread to listen to changes from parent.
         let
            receiveChanges :: IO b
receiveChanges =
               do
                  Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update <- Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> IO (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (chan :: * -> *) a. HasReceive chan => chan a -> IO a
receiveIO Channel (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
graphUpdatesQueue
                  SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
applyUpdateFromClient SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData
                  IO b
receiveChanges
         IO () -> IO ThreadId
forkIO IO ()
forall b. IO b
receiveChanges
         -- register for destruction.
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall t. (Object t, Destroyable t) => t -> IO ()
registerTool SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

   newNodeType :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> nodeTypeLabel -> IO NodeType
newNodeType SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph nodeTypeLabel
nodeTypeLabel =
      do
         String
name <- NameSource -> IO String
getNewName (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
         let (NodeType
nodeType :: NodeType) = String -> NodeType
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
name
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall (graph :: * -> * -> * -> * -> *) nodeLabel nodeTypeLabel
       arcLabel arcTypeLabel.
Graph graph =>
graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (NodeType
-> nodeTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
NodeType
-> nodeTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNodeType NodeType
nodeType nodeTypeLabel
nodeTypeLabel)
         NodeType -> IO NodeType
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
nodeType

   newNode :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NodeType -> nodeLabel -> IO Node
newNode SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph NodeType
nodeType nodeLabel
nodeLabel =
      do
         String
name <- NameSource -> IO String
getNewName (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
         let (Node
node :: Node) = String -> Node
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
name
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall (graph :: * -> * -> * -> * -> *) nodeLabel nodeTypeLabel
       arcLabel arcTypeLabel.
Graph graph =>
graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNode Node
node NodeType
nodeType nodeLabel
nodeLabel)
         Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
node

   newArcType :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> arcTypeLabel -> IO ArcType
newArcType SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph arcTypeLabel
arcTypeLabel =
      do
         String
name <- NameSource -> IO String
getNewName (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
         let (ArcType
arcType :: ArcType) = String -> ArcType
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
name
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall (graph :: * -> * -> * -> * -> *) nodeLabel nodeTypeLabel
       arcLabel arcTypeLabel.
Graph graph =>
graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (ArcType
-> arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ArcType
-> arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArcType ArcType
arcType arcTypeLabel
arcTypeLabel)
         ArcType -> IO ArcType
forall (m :: * -> *) a. Monad m => a -> m a
return ArcType
arcType

   newArc :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ArcType -> arcLabel -> Node -> Node -> IO Arc
newArc SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph ArcType
arcType arcLabel
arcLabel Node
source Node
target =
      do
         String
name <- NameSource -> IO String
getNewName (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> NameSource
nameSource SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
         let (Arc
arc :: Arc) = String -> Arc
forall stringClass.
StringClass stringClass =>
String -> stringClass
fromString String
name
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall (graph :: * -> * -> * -> * -> *) nodeLabel nodeTypeLabel
       arcLabel arcTypeLabel.
Graph graph =>
graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArc Arc
arc ArcType
arcType arcLabel
arcLabel Node
source Node
target)
         Arc -> IO Arc
forall (m :: * -> *) a. Monad m => a -> m a
return Arc
arc

   update :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Bool)
-> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Bool)
-> IO ()
applyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update (Bool
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
forall a b. a -> b -> a
const Bool
True)

   newEmptyGraph :: IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newEmptyGraph = NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newEmptyGraphWithSource NameSourceBranch
initialBranch

getNodeInfo ::
   (NodeData nodeLabel -> result)
   -> (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
   -> Node
   -> IO result
getNodeInfo :: (NodeData nodeLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO result
getNodeInfo NodeData nodeLabel -> result
converter SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Node
node =
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO result -> IO result
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
      do
         (Just NodeData nodeLabel
nodeData) <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) Node
node
         result -> IO result
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeData nodeLabel -> result
converter NodeData nodeLabel
nodeData)
      )

getArcInfo ::
   (ArcData arcLabel -> result)
   -> (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
   -> Arc
   -> IO result
getArcInfo :: (ArcData arcLabel -> result)
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Arc
-> IO result
getArcInfo ArcData arcLabel -> result
converter SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Arc
arc =
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO result -> IO result
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
      do
         (Just ArcData arcLabel
arcData) <- Registry Arc (ArcData arcLabel)
-> Arc -> IO (Maybe (ArcData arcLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) Arc
arc
         result -> IO result
forall (m :: * -> *) a. Monad m => a -> m a
return (ArcData arcLabel -> result
converter ArcData arcLabel
arcData)
      )

------------------------------------------------------------------------
-- We make it possible to destroy graphs.  It is not recommended
-- to destroy a graph before its children have been destroyed!
------------------------------------------------------------------------

instance Destroyable
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel) where
   destroy :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
destroy SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph =
      do
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall t. Object t => t -> IO ()
deregisterTool SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
         SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO () -> IO ()
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
            -- if anyone tries to access it afterwards, it will in
            -- fact be empty.
            do
               SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
parentDeRegister SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
               -- Do a few things to encourage garbage collection.
               Registry Node (NodeData nodeLabel) -> IO ()
forall registry. NewRegistry registry => registry -> IO ()
emptyRegistry (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
               Registry NodeType nodeTypeLabel -> IO ()
forall registry. NewRegistry registry => registry -> IO ()
emptyRegistry (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
               Registry Arc (ArcData arcLabel) -> IO ()
forall registry. NewRegistry registry => registry -> IO ()
emptyRegistry (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
               Registry ArcType arcTypeLabel -> IO ()
forall registry. NewRegistry registry => registry -> IO ()
emptyRegistry (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
               let
                  mVar :: MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
               MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. MVar a -> IO a
takeMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar
               MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
mVar []
            ) -- end of synchronization

------------------------------------------------------------------------
-- Updates
------------------------------------------------------------------------

applyUpdateFromClient ::
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> IO ()
applyUpdateFromClient :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
applyUpdateFromClient SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
client =
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Bool)
-> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Bool)
-> IO ()
applyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
      (\ ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientToBroadcast -> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
client ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
forall a. Eq a => a -> a -> Bool
/= ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientToBroadcast)

applyUpdate ::
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool)
   -> IO ()
-- applyUpdate graph update proceedFn
--    updates graph with update.  It then broadcasts to all listeners
--    of the graph with classData such that proceedFn classData == True.
applyUpdate :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
    -> Bool)
-> IO ()
applyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
proceedFn =
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO () -> IO ()
forall a b. Synchronized a => a -> IO b -> IO b
synchronize SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (
      do
         -- (1) Update graph, and get list of current clients.
         [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clients <- SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
innerApplyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update
         -- (2) Tell the clients
         [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
            ((ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map
               (\ ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData ->
                  if ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> Bool
proceedFn ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData
                     then
                        do
                           Either SomeException ()
result <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try
                              (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update)
                           case Either SomeException ()
result of
                              Left SomeException
exception ->
                                 String -> IO ()
putStrLn (String
"Client error " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                           SomeException -> String
forall a. Show a => a -> String
show (SomeException
exception :: SomeException))
                              Right () -> IO ()
forall (m :: * -> *). Monad m => m ()
done
                     else
                        IO ()
forall (m :: * -> *). Monad m => m ()
done
                  )
               [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clients
               )
      )

innerApplyUpdate ::
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
innerApplyUpdate :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
innerApplyUpdate
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
      Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update =
   let
      passOnUpdate :: IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate = MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. MVar a -> IO a
readMVar (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph)
      killUpdate :: IO [a]
killUpdate = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      arcRegistry :: Registry Arc (ArcData arcLabel)
arcRegistry = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph
      nodeRegistry :: Registry Node (NodeData nodeLabel)
nodeRegistry = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

   in
      -- The following cases need special treatment, in case
      -- someone else has deleted a relevant Node or Arc before
      -- we get there: SetNodeLabel, SetArcLabel, DeleteNode, DeleteArc.
      -- In these cases we (a) do nothing;
      -- (b) return a null client list, to prevent the update
      -- being passed on to anyone else.
      -- We don't give
      case Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update of
         NewNodeType NodeType
nodeType nodeTypeLabel
nodeTypeLabel ->
            do
               Registry NodeType nodeTypeLabel
-> NodeType -> nodeTypeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) NodeType
nodeType nodeTypeLabel
nodeTypeLabel
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         SetNodeTypeLabel NodeType
nodeType nodeTypeLabel
nodeTypeLabel ->
            do
               Registry NodeType nodeTypeLabel
-> NodeType -> nodeTypeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) NodeType
nodeType nodeTypeLabel
nodeTypeLabel
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         NewNode Node
node NodeType
nodeType nodeLabel
nodeLabel ->
            do
               Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) Node
node
                  (NodeData :: forall nodeLabel.
nodeLabel -> NodeType -> [Arc] -> [Arc] -> NodeData nodeLabel
NodeData {
                     nodeLabel :: nodeLabel
nodeLabel = nodeLabel
nodeLabel,
                     nodeType :: NodeType
nodeType = NodeType
nodeType,
                     arcsIn :: [Arc]
arcsIn = [],
                     arcsOut :: [Arc]
arcsOut = []
                     })
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         DeleteNode Node
node ->
            do
               Maybe (NodeData nodeLabel)
nodeDataOpt <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
               case Maybe (NodeData nodeLabel)
nodeDataOpt of
                  Maybe (NodeData nodeLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
                  Just (NodeData {arcsIn :: forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsIn = [Arc]
arcsIn,arcsOut :: forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsOut = [Arc]
arcsOut}
                     :: NodeData nodeLabel) ->
                     do
                        [IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
                           ((Arc
 -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> [Arc]
-> [IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]]
forall a b. (a -> b) -> [a] -> [b]
map
                              (\ Arc
arc ->
                                 SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
innerApplyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph (Arc -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
DeleteArc Arc
arc))
                              ([Arc]
arcsIn [Arc] -> [Arc] -> [Arc]
forall a. [a] -> [a] -> [a]
++ [Arc]
arcsOut)
                              )
                        Registry Node (NodeData nodeLabel) -> Node -> IO ()
forall registry from.
KeyOpsRegistry registry from =>
registry -> from -> IO ()
deleteFromRegistry Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         SetNodeLabel Node
node nodeLabel
nodeLabel ->
            do
               Maybe (NodeData nodeLabel)
nodeDataOpt <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
               case Maybe (NodeData nodeLabel)
nodeDataOpt of
                  Maybe (NodeData nodeLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
                  Just (NodeData nodeLabel
nodeData :: NodeData nodeLabel) ->
                     do
                        Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
                           (NodeData nodeLabel
nodeData {nodeLabel :: nodeLabel
nodeLabel = nodeLabel
nodeLabel})
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         SetNodeType Node
node NodeType
nodeType ->
            do
               Maybe (NodeData nodeLabel)
nodeDataOpt <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
               case Maybe (NodeData nodeLabel)
nodeDataOpt of
                  Maybe (NodeData nodeLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
                  Just (NodeData nodeLabel
nodeData :: NodeData nodeLabel) ->
                     do
                        Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
node
                           (NodeData nodeLabel
nodeData {nodeType :: NodeType
nodeType = NodeType
nodeType})
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         NewArcType ArcType
arcType arcTypeLabel
arcTypeLabel ->
            do
               Registry ArcType arcTypeLabel -> ArcType -> arcTypeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) ArcType
arcType arcTypeLabel
arcTypeLabel
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         SetArcTypeLabel ArcType
arcType arcTypeLabel
arcTypeLabel ->
            do
               Registry ArcType arcTypeLabel -> ArcType -> arcTypeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) ArcType
arcType arcTypeLabel
arcTypeLabel
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         NewArc Arc
arc ArcType
arcType arcLabel
arcLabel Node
nodeSource Node
nodeTarget ->
            do
               Maybe (NodeData nodeLabel)
nodeSourceDataOpt <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Node (NodeData nodeLabel)
nodeRegistry Node
nodeSource
               Maybe (NodeData nodeLabel)
nodeTargetDataOpt <- Registry Node (NodeData nodeLabel)
-> Node -> IO (Maybe (NodeData nodeLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Node (NodeData nodeLabel)
nodeRegistry Node
nodeTarget
               case (Maybe (NodeData nodeLabel)
nodeSourceDataOpt,Maybe (NodeData nodeLabel)
nodeTargetDataOpt) of
                  (Just (NodeData nodeLabel
nodeSourceData :: NodeData nodeLabel),
                   Just (NodeData nodeLabel
nodeTargetData :: NodeData nodeLabel)) ->
                     do
                        let
                           newArcData :: ArcData arcLabel
newArcData = ArcData :: forall arcLabel.
arcLabel -> ArcType -> Node -> Node -> ArcData arcLabel
ArcData {
                              arcLabel :: arcLabel
arcLabel = arcLabel
arcLabel,
                              arcType :: ArcType
arcType = ArcType
arcType,
                              source :: Node
source = Node
nodeSource,
                              target :: Node
target = Node
nodeTarget
                              }
                        Registry Arc (ArcData arcLabel) -> Arc -> ArcData arcLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc ArcData arcLabel
newArcData
                        if (Node
nodeSource Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
nodeTarget)
                           then
                              do
                                 let
                                    newNodeSourceData :: NodeData nodeLabel
newNodeSourceData = NodeData nodeLabel
nodeSourceData {
                                       arcsOut :: [Arc]
arcsOut =
                                          Arc
arc Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: Arc
arc Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: (NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsOut NodeData nodeLabel
nodeSourceData)
                                       }
                                 Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
nodeSource
                                    NodeData nodeLabel
newNodeSourceData
                           else
                              do
                                 let
                                    newNodeSourceData :: NodeData nodeLabel
newNodeSourceData = NodeData nodeLabel
nodeSourceData {
                                       arcsOut :: [Arc]
arcsOut = Arc
arc Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
:
                                          (NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsOut NodeData nodeLabel
nodeSourceData)
                                       }
                                    newNodeTargetData :: NodeData nodeLabel
newNodeTargetData = NodeData nodeLabel
nodeTargetData {
                                       arcsIn :: [Arc]
arcsIn = Arc
arc Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: (NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsIn NodeData nodeLabel
nodeTargetData)
                                       }
                                 Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
nodeSource
                                    NodeData nodeLabel
newNodeSourceData
                                 Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
nodeTarget
                                    NodeData nodeLabel
newNodeTargetData
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
                  (Maybe (NodeData nodeLabel), Maybe (NodeData nodeLabel))
_ -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
         DeleteArc Arc
arc ->
            do
               Maybe (ArcData arcLabel)
arcDataOpt <- Registry Arc (ArcData arcLabel)
-> Arc -> IO (Maybe (ArcData arcLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
               case Maybe (ArcData arcLabel)
arcDataOpt of
                  Maybe (ArcData arcLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
                  Just (ArcData {source :: forall arcLabel. ArcData arcLabel -> Node
source = Node
source,target :: forall arcLabel. ArcData arcLabel -> Node
target = Node
target}
                     :: ArcData arcLabel) ->
                     do
                        -- The getValue operations for the source and
                        -- target must succeed, because if the arc is
                        -- still there, the nodes must also still be there.
                        Registry Arc (ArcData arcLabel) -> Arc -> IO ()
forall registry from.
KeyOpsRegistry registry from =>
registry -> from -> IO ()
deleteFromRegistry Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
                        (NodeData nodeLabel
nodeSourceData :: NodeData nodeLabel)
                           <- Registry Node (NodeData nodeLabel)
-> Node -> IO (NodeData nodeLabel)
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO to
getValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
source
                        let
                           newNodeSourceData :: NodeData nodeLabel
newNodeSourceData = NodeData nodeLabel
nodeSourceData {
                              arcsOut :: [Arc]
arcsOut = Arc -> [Arc] -> [Arc]
forall a. Eq a => a -> [a] -> [a]
delete Arc
arc (NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsOut NodeData nodeLabel
nodeSourceData)
                              }
                        Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
source NodeData nodeLabel
newNodeSourceData

                        (NodeData nodeLabel
nodeTargetData :: NodeData nodeLabel)
                           <- String
-> Registry Node (NodeData nodeLabel)
-> Node
-> IO (NodeData nodeLabel)
forall registry from to.
GetSetRegistry registry from to =>
String -> registry -> from -> IO to
getValue' String
"DeleteArc" Registry Node (NodeData nodeLabel)
nodeRegistry Node
target
                        let
                           newNodeTargetData :: NodeData nodeLabel
newNodeTargetData = NodeData nodeLabel
nodeTargetData {
                              arcsIn :: [Arc]
arcsIn = Arc -> [Arc] -> [Arc]
forall a. Eq a => a -> [a] -> [a]
delete Arc
arc (NodeData nodeLabel -> [Arc]
forall nodeLabel. NodeData nodeLabel -> [Arc]
arcsIn NodeData nodeLabel
nodeTargetData)
                              }
                        Registry Node (NodeData nodeLabel)
-> Node -> NodeData nodeLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Node (NodeData nodeLabel)
nodeRegistry Node
target NodeData nodeLabel
newNodeTargetData
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
         SetArcLabel Arc
arc arcLabel
arcLabel ->
            do
               Maybe (ArcData arcLabel)
arcDataOpt <- Registry Arc (ArcData arcLabel)
-> Arc -> IO (Maybe (ArcData arcLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
               case Maybe (ArcData arcLabel)
arcDataOpt of
                  Just (ArcData arcLabel
arcData :: ArcData arcLabel) ->
                     do
                        Registry Arc (ArcData arcLabel) -> Arc -> ArcData arcLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
                           (ArcData arcLabel
arcData {arcLabel :: arcLabel
arcLabel = arcLabel
arcLabel})
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
                  Maybe (ArcData arcLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
         SetArcType Arc
arc ArcType
arcType ->
            do
               Maybe (ArcData arcLabel)
arcDataOpt <- Registry Arc (ArcData arcLabel)
-> Arc -> IO (Maybe (ArcData arcLabel))
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> IO (Maybe to)
getValueOpt Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
               case Maybe (ArcData arcLabel)
arcDataOpt of
                  Just (ArcData arcLabel
arcData :: ArcData arcLabel) ->
                     do
                        Registry Arc (ArcData arcLabel) -> Arc -> ArcData arcLabel -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry Arc (ArcData arcLabel)
arcRegistry Arc
arc
                           (ArcData arcLabel
arcData {arcType :: ArcType
arcType = ArcType
arcType})
                        IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate
                  Maybe (ArcData arcLabel)
Nothing -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. IO [a]
killUpdate
         MultiUpdate [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates ->
            do
               (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
 -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
innerApplyUpdate SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates
               IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
passOnUpdate

------------------------------------------------------------------------
-- Canning, Uncanning, and graph creation.
-- These are the part of sharing graphs not involving communication.
------------------------------------------------------------------------

cannGraph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> IO (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
cannGraph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
cannGraph (SimpleGraph{
   nodeData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData = Registry Node (NodeData nodeLabel)
nodeData,
   nodeTypeData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry NodeType nodeTypeLabel
nodeTypeData = Registry NodeType nodeTypeLabel
nodeTypeData,
   arcData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Arc (ArcData arcLabel)
arcData = Registry Arc (ArcData arcLabel)
arcData,
   arcTypeData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry ArcType arcTypeLabel
arcTypeData = Registry ArcType arcTypeLabel
arcTypeData
   }) =
   do
      [(NodeType, nodeTypeLabel)]
nodeTypes <- Registry NodeType nodeTypeLabel -> IO [(NodeType, nodeTypeLabel)]
forall (registry :: * -> * -> *) from to.
ListRegistryContents registry from to =>
registry from to -> IO [(from, to)]
listRegistryContents Registry NodeType nodeTypeLabel
nodeTypeData
      [(Node, NodeData nodeLabel)]
nodeRegistryContents <- Registry Node (NodeData nodeLabel)
-> IO [(Node, NodeData nodeLabel)]
forall (registry :: * -> * -> *) from to.
ListRegistryContents registry from to =>
registry from to -> IO [(from, to)]
listRegistryContents Registry Node (NodeData nodeLabel)
nodeData
      [(ArcType, arcTypeLabel)]
arcTypes <- Registry ArcType arcTypeLabel -> IO [(ArcType, arcTypeLabel)]
forall (registry :: * -> * -> *) from to.
ListRegistryContents registry from to =>
registry from to -> IO [(from, to)]
listRegistryContents Registry ArcType arcTypeLabel
arcTypeData
      [(Arc, ArcData arcLabel)]
arcRegistryContents <- Registry Arc (ArcData arcLabel) -> IO [(Arc, ArcData arcLabel)]
forall (registry :: * -> * -> *) from to.
ListRegistryContents registry from to =>
registry from to -> IO [(from, to)]
listRegistryContents Registry Arc (ArcData arcLabel)
arcData

      let
         nodeTypeUpdates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
nodeTypeUpdates =
            ((NodeType, nodeTypeLabel)
 -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> [(NodeType, nodeTypeLabel)]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a b. (a -> b) -> [a] -> [b]
map
               (\ (NodeType
nodeType,nodeTypeLabel
nodeTypeLabel)
                  -> NodeType
-> nodeTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
NodeType
-> nodeTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNodeType NodeType
nodeType nodeTypeLabel
nodeTypeLabel
                  )
               [(NodeType, nodeTypeLabel)]
nodeTypes
         nodeUpdates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
nodeUpdates =
            ((Node, NodeData nodeLabel)
 -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> [(Node, NodeData nodeLabel)]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a b. (a -> b) -> [a] -> [b]
map
               (\ (Node
node,NodeData {nodeType :: forall nodeLabel. NodeData nodeLabel -> NodeType
nodeType = NodeType
nodeType,nodeLabel :: forall nodeLabel. NodeData nodeLabel -> nodeLabel
nodeLabel = nodeLabel
nodeLabel})
                  -> Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNode Node
node NodeType
nodeType nodeLabel
nodeLabel
                  )
               [(Node, NodeData nodeLabel)]
nodeRegistryContents
         arcTypeUpdates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
arcTypeUpdates =
            ((ArcType, arcTypeLabel)
 -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> [(ArcType, arcTypeLabel)]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a b. (a -> b) -> [a] -> [b]
map
               (\ (ArcType
arcType,arcTypeLabel
arcTypeLabel)
                  -> ArcType
-> arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ArcType
-> arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArcType ArcType
arcType arcTypeLabel
arcTypeLabel
                  )
               [(ArcType, arcTypeLabel)]
arcTypes
         arcUpdates :: [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
arcUpdates =
            ((Arc, ArcData arcLabel)
 -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-> [(Arc, ArcData arcLabel)]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a b. (a -> b) -> [a] -> [b]
map
               (\ (Arc
arc,ArcData {arcType :: forall arcLabel. ArcData arcLabel -> ArcType
arcType = ArcType
arcType,arcLabel :: forall arcLabel. ArcData arcLabel -> arcLabel
arcLabel = arcLabel
arcLabel,
                     source :: forall arcLabel. ArcData arcLabel -> Node
source = Node
source,target :: forall arcLabel. ArcData arcLabel -> Node
target = Node
target})
                  -> Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArc Arc
arc ArcType
arcType arcLabel
arcLabel Node
source Node
target
                  )
               [(Arc, ArcData arcLabel)]
arcRegistryContents

      CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return (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]
forall nodeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
nodeTypeUpdates [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. [a] -> [a] -> [a]
++ [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
nodeUpdates [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. [a] -> [a] -> [a]
++ [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
arcTypeUpdates
            [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. [a] -> [a] -> [a]
++ [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
arcUpdates
            })

uncannGraph :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> IO () -> NameSourceBranch
   -> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
-- the second argument is the deregistration function of the parent,
-- which we need to put in the SimpleGraph.  The third argument is
-- the graph's NameSource, ditto.
uncannGraph :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO ()
-> NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
uncannGraph
      ((CannedGraph {updates :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates = [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates})
         :: CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
      IO ()
parentDeRegister NameSourceBranch
nameSourceBranch =
   do
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph' :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
         <- NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newEmptyGraphWithSource NameSourceBranch
nameSourceBranch
      let
         graph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph' {parentDeRegister :: IO ()
parentDeRegister = IO ()
parentDeRegister}
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ((Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
forall (graph :: * -> * -> * -> * -> *) nodeLabel nodeTypeLabel
       arcLabel arcTypeLabel.
Graph graph =>
graph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
update SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) [Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
updates)
      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

newEmptyGraphWithSource :: NameSourceBranch
   -> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newEmptyGraphWithSource :: NameSourceBranch
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
newEmptyGraphWithSource NameSourceBranch
nameSourceBranch =
   do
      Registry Node (NodeData nodeLabel)
nodeData <- IO (Registry Node (NodeData nodeLabel))
forall registry. NewRegistry registry => IO registry
newRegistry
      Registry NodeType nodeTypeLabel
nodeTypeData <- IO (Registry NodeType nodeTypeLabel)
forall registry. NewRegistry registry => IO registry
newRegistry
      Registry Arc (ArcData arcLabel)
arcData <- IO (Registry Arc (ArcData arcLabel))
forall registry. NewRegistry registry => IO registry
newRegistry
      Registry ArcType arcTypeLabel
arcTypeData <- IO (Registry ArcType arcTypeLabel)
forall registry. NewRegistry registry => IO registry
newRegistry
      MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar <- [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO
     (MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
forall a. a -> IO (MVar a)
newMVar []
      BSem
bSem <- IO BSem
newBSem
      ObjectID
graphID <- IO ObjectID
newObject
      NameSource
nameSource <- NameSourceBranch -> IO NameSource
useBranch NameSourceBranch
nameSourceBranch

      SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> IO (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleGraph :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Registry Node (NodeData nodeLabel)
-> Registry NodeType nodeTypeLabel
-> Registry Arc (ArcData arcLabel)
-> Registry ArcType arcTypeLabel
-> NameSource
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO ()
-> ObjectID
-> BSem
-> SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SimpleGraph {
         nodeData :: Registry Node (NodeData nodeLabel)
nodeData = Registry Node (NodeData nodeLabel)
nodeData,nodeTypeData :: Registry NodeType nodeTypeLabel
nodeTypeData = Registry NodeType nodeTypeLabel
nodeTypeData,
         arcData :: Registry Arc (ArcData arcLabel)
arcData = Registry Arc (ArcData arcLabel)
arcData,arcTypeData :: Registry ArcType arcTypeLabel
arcTypeData = Registry ArcType arcTypeLabel
arcTypeData,
         nameSource :: NameSource
nameSource = NameSource
nameSource,
         parentDeRegister :: IO ()
parentDeRegister = IO ()
forall (m :: * -> *). Monad m => m ()
done,
         clientsMVar :: MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar = MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar,
         bSem :: BSem
bSem = BSem
bSem,
         graphID :: ObjectID
graphID = ObjectID
graphID
         })



------------------------------------------------------------------------
-- delayedAction is used to delay an action until a node is present.
-- It assumes that the node is not already present.
-- Typical use: register that an arc shall be added when a given node
-- at one end of the arc is created.
------------------------------------------------------------------------

delayedAction ::
   SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
   -> Node -- node
   -> IO () -- action to perform when the node is created in the graph.
   -> IO ()
delayedAction :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node -> IO () -> IO ()
delayedAction
      (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph :: SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel)
      Node
node IO ()
action =
   do
      Bool
doNow <- Registry Node (NodeData nodeLabel)
-> Node
-> (Maybe (NodeData nodeLabel)
    -> IO (Maybe (NodeData nodeLabel), Bool))
-> IO Bool
forall registry from to extra.
GetSetRegistry registry from to =>
registry -> from -> (Maybe to -> IO (Maybe to, extra)) -> IO extra
transformValue (SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Registry Node (NodeData nodeLabel)
nodeData SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph) Node
node
         (\ (Maybe (NodeData nodeLabel)
nodeDataOpt :: Maybe (NodeData nodeLabel)) ->
            case Maybe (NodeData nodeLabel)
nodeDataOpt of
               Just NodeData nodeLabel
nodeData -> (Maybe (NodeData nodeLabel), Bool)
-> IO (Maybe (NodeData nodeLabel), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (NodeData nodeLabel)
nodeDataOpt,Bool
True)
               Maybe (NodeData nodeLabel)
Nothing ->
                  do
                     -- we create a new client for the purpose.
                     ObjectID
clientID <- IO ObjectID
newObject
                     let
                        clients :: MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clients = SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clientsMVar SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
graph

                        clientData :: ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData = ClientData :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ObjectID
-> (Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ())
-> ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
ClientData {
                           clientID :: ObjectID
clientID = ObjectID
clientID,clientSink :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink = Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink
                           }

                        clientSink :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> IO ()
clientSink Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update = case Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update of
                           NewNode Node
node1 NodeType
_ nodeLabel
_
                              | Node
node1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node
                              ->
                                 do
                                    IO () -> IO ThreadId
forkIO IO ()
action
                                    MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clients
                                       ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
 -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. Eq a => a -> [a] -> [a]
delete ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData)
                           Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
_ -> IO ()
forall (m :: * -> *). Monad m => m ()
done

                     MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
clients ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
 -> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> ([ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
    -> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel])
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> IO [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
clientData ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> [ClientData nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
forall a. a -> [a] -> [a]
:))
                     (Maybe (NodeData nodeLabel), Bool)
-> IO (Maybe (NodeData nodeLabel), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (NodeData nodeLabel)
nodeDataOpt,Bool
False)
            )
      if Bool
doNow then IO ()
action else IO ()
forall (m :: * -> *). Monad m => m ()
done