{-# LANGUAGE ScopedTypeVariables #-}
module Graphs.SimpleGraph(
SimpleGraph,
getNameSource,
delayedAction,
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 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,
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 (),
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> ObjectID
graphID :: ObjectID,
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel -> BSem
bSem :: BSem
}
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)
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
[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
})
)
)
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
(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
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)
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
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)
)
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 (
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
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 []
)
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 :: 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
[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
[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
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
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
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)
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 ::
SimpleGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
-> Node
-> IO ()
-> 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
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