{-# LANGUAGE ScopedTypeVariables #-}

-- | This module, given a changing source of 'PureGraph's, transforms it into
-- a 'Graph'. -}
module Graphs.PureGraphToGraph(
   pureGraphToGraph,
   ) where

import Data.List

import qualified Data.Map as Map
import Data.IORef

import Util.Computation(done)
import Util.Sources
import Util.Sink
import Util.AtomString
import Util.ExtendedPrelude

import Graphs.Graph
import Graphs.NewNames
import Graphs.PureGraph


-- ------------------------------------------------------------------------
-- Data types
-- ------------------------------------------------------------------------

data State nodeKey nodeInfo arcInfo = State {
   State nodeKey nodeInfo arcInfo -> NameSource
nameSource :: NameSource,
      -- ^ source of new names
   State nodeKey nodeInfo arcInfo
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph :: PureGraph (nodeKey,Node) (arcInfo,Arc),
      -- ^ current annotated graph
   State nodeKey nodeInfo arcInfo -> nodeKey -> nodeInfo
toNodeInfo :: nodeKey -> nodeInfo
      -- ^ current node info
   }

-- ------------------------------------------------------------------------
-- Functions
-- ------------------------------------------------------------------------

pureGraphToGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => SimpleSource (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
   -> GraphConnection nodeInfo () arcInfo ()
pureGraphToGraph :: SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> GraphConnection nodeInfo () arcInfo ()
pureGraphToGraph (SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
simpleSource
      :: SimpleSource (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)) =
   let
      source1 ::
         Source (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
                (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
      source1 :: Source
  (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
  (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
source1 = SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> Source
     (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
     (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource SimpleSource (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
simpleSource

      source2 ::
         Source (State nodeKey nodeInfo arcInfo,
               CannedGraph nodeInfo () arcInfo ())
            [Update nodeInfo () arcInfo ()]
      source2 :: Source
  (State nodeKey nodeInfo arcInfo,
   CannedGraph nodeInfo () arcInfo ())
  [Update nodeInfo () arcInfo ()]
source2 = ((PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
 -> IO
      (State nodeKey nodeInfo arcInfo,
       CannedGraph nodeInfo () arcInfo ()))
-> (State nodeKey nodeInfo arcInfo
    -> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
    -> IO
         (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()]))
-> Source
     (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
     (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> Source
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
     [Update nodeInfo () arcInfo ()]
forall x1 state x2 d1 d2.
(x1 -> IO (state, x2))
-> (state -> d1 -> IO (state, d2))
-> Source x1 d1
-> Source (state, x2) d2
foldSourceIO (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
(PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
getStateFn State nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
State nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()])
foldStateFn Source
  (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
  (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
source1

      source3 ::
         Source (State nodeKey nodeInfo arcInfo,
               CannedGraph nodeInfo () arcInfo ())
            (Update nodeInfo () arcInfo ())
      source3 :: Source
  (State nodeKey nodeInfo arcInfo,
   CannedGraph nodeInfo () arcInfo ())
  (Update nodeInfo () arcInfo ())
source3 = ([Update nodeInfo () arcInfo ()] -> Update nodeInfo () arcInfo ())
-> Source
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
     [Update nodeInfo () arcInfo ()]
-> Source
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
     (Update nodeInfo () arcInfo ())
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2 [Update nodeInfo () arcInfo ()] -> Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
MultiUpdate Source
  (State nodeKey nodeInfo arcInfo,
   CannedGraph nodeInfo () arcInfo ())
  [Update nodeInfo () arcInfo ()]
source2

      addConnection :: GraphConnection nodeInfo () arcInfo ()
addConnection Update nodeInfo () arcInfo () -> IO ()
doUpdate =
         do
            ((State nodeKey nodeInfo arcInfo
state,CannedGraph nodeInfo () arcInfo ()
cannedGraph),Sink (Update nodeInfo () arcInfo ())
sink)<- Source
  (State nodeKey nodeInfo arcInfo,
   CannedGraph nodeInfo () arcInfo ())
  (Update nodeInfo () arcInfo ())
-> (Update nodeInfo () arcInfo () -> IO ())
-> IO
     ((State nodeKey nodeInfo arcInfo,
       CannedGraph nodeInfo () arcInfo ()),
      Sink (Update nodeInfo () arcInfo ()))
forall sinkSource x delta.
CanAddSinks sinkSource x delta =>
sinkSource -> (delta -> IO ()) -> IO (x, Sink delta)
addNewSink Source
  (State nodeKey nodeInfo arcInfo,
   CannedGraph nodeInfo () arcInfo ())
  (Update nodeInfo () arcInfo ())
source3 Update nodeInfo () arcInfo () -> IO ()
doUpdate
            NameSourceBranch
nameSourceBranch <- NameSource -> IO NameSourceBranch
branch (State nodeKey nodeInfo arcInfo -> NameSource
forall nodeKey nodeInfo arcInfo.
State nodeKey nodeInfo arcInfo -> NameSource
nameSource State nodeKey nodeInfo arcInfo
state)

            let
               graphConnectionData :: GraphConnectionData nodeInfo () arcInfo ()
graphConnectionData = 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 nodeInfo () arcInfo ()
graphState = CannedGraph nodeInfo () arcInfo ()
cannedGraph,
                  deRegister :: IO ()
deRegister = Sink (Update nodeInfo () arcInfo ()) -> IO ()
forall source. HasInvalidate source => source -> IO ()
invalidate Sink (Update nodeInfo () arcInfo ())
sink,
                  graphUpdate :: Update nodeInfo () arcInfo () -> IO ()
graphUpdate = (\ Update nodeInfo () arcInfo ()
update -> IO ()
forall (m :: * -> *). Monad m => m ()
done),
                     -- updates from the client are ignored
                  nameSourceBranch :: NameSourceBranch
nameSourceBranch = NameSourceBranch
nameSourceBranch
                  }

            GraphConnectionData nodeInfo () arcInfo ()
-> IO (GraphConnectionData nodeInfo () arcInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return GraphConnectionData nodeInfo () arcInfo ()
graphConnectionData
   in
      GraphConnection nodeInfo () arcInfo ()
addConnection


getStateFn
   :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
   -> IO (State nodeKey nodeInfo arcInfo,CannedGraph nodeInfo () arcInfo ())
getStateFn :: (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
getStateFn (PureGraph nodeKey arcInfo
pureGraph0,nodeKey -> nodeInfo
toNodeInfo0) =
   do
      NameSource
nameSource <- NameSourceBranch -> IO NameSource
useBranch NameSourceBranch
initialBranch

      (PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph1,[Update nodeInfo () arcInfo ()]
updates0)
         <- NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> PureGraph nodeKey arcInfo
-> (nodeKey -> nodeInfo)
-> (nodeKey -> nodeInfo)
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> PureGraph nodeKey arcInfo
-> (nodeKey -> nodeInfo)
-> (nodeKey -> nodeInfo)
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
modifyPureGraph NameSource
nameSource PureGraph (nodeKey, Node) (arcInfo, Arc)
forall nodeInfo arcInfo. Ord nodeInfo => PureGraph nodeInfo arcInfo
emptyPureGraph PureGraph nodeKey arcInfo
pureGraph0
            ([Char] -> nodeKey -> nodeInfo
forall a. HasCallStack => [Char] -> a
error [Char]
"PureGraphToGraph: no old nodes") nodeKey -> nodeInfo
toNodeInfo0
      let
         state :: State nodeKey nodeInfo arcInfo
state = State :: forall nodeKey nodeInfo arcInfo.
NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> (nodeKey -> nodeInfo)
-> State nodeKey nodeInfo arcInfo
State {
            nameSource :: NameSource
nameSource = NameSource
nameSource,
            pureGraph :: PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph = PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph1,
            toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo = nodeKey -> nodeInfo
toNodeInfo0
            }

         updates1 :: [Update nodeInfo () arcInfo ()]
updates1 = [Update nodeInfo () arcInfo ()]
forall nodeInfo arcInfo. [Update nodeInfo () arcInfo ()]
typeUpdates [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [Update nodeInfo () arcInfo ()]
updates0

         cannedGraph :: CannedGraph nodeInfo () arcInfo ()
cannedGraph = CannedGraph :: forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel]
-> CannedGraph nodeLabel nodeTypeLabel arcLabel arcTypeLabel
CannedGraph {updates :: [Update nodeInfo () arcInfo ()]
updates = [Update nodeInfo () arcInfo ()]
updates1}

      (State nodeKey nodeInfo arcInfo,
 CannedGraph nodeInfo () arcInfo ())
-> IO
     (State nodeKey nodeInfo arcInfo,
      CannedGraph nodeInfo () arcInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (State nodeKey nodeInfo arcInfo
state,CannedGraph nodeInfo () arcInfo ()
cannedGraph)

foldStateFn
   :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => State nodeKey nodeInfo arcInfo
   -> (PureGraph nodeKey arcInfo,nodeKey -> nodeInfo)
   -> IO (State nodeKey nodeInfo arcInfo,[Update nodeInfo () arcInfo ()])
foldStateFn :: State nodeKey nodeInfo arcInfo
-> (PureGraph nodeKey arcInfo, nodeKey -> nodeInfo)
-> IO
     (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()])
foldStateFn State nodeKey nodeInfo arcInfo
state (PureGraph nodeKey arcInfo
pureGraph0,nodeKey -> nodeInfo
toNodeInfo1) =
   do
      (PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph1,[Update nodeInfo () arcInfo ()]
updates)
         <- NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> PureGraph nodeKey arcInfo
-> (nodeKey -> nodeInfo)
-> (nodeKey -> nodeInfo)
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo, Eq nodeInfo) =>
NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> PureGraph nodeKey arcInfo
-> (nodeKey -> nodeInfo)
-> (nodeKey -> nodeInfo)
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
modifyPureGraph (State nodeKey nodeInfo arcInfo -> NameSource
forall nodeKey nodeInfo arcInfo.
State nodeKey nodeInfo arcInfo -> NameSource
nameSource State nodeKey nodeInfo arcInfo
state) (State nodeKey nodeInfo arcInfo
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
forall nodeKey nodeInfo arcInfo.
State nodeKey nodeInfo arcInfo
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph State nodeKey nodeInfo arcInfo
state) PureGraph nodeKey arcInfo
pureGraph0
            (State nodeKey nodeInfo arcInfo -> nodeKey -> nodeInfo
forall nodeKey nodeInfo arcInfo.
State nodeKey nodeInfo arcInfo -> nodeKey -> nodeInfo
toNodeInfo State nodeKey nodeInfo arcInfo
state) nodeKey -> nodeInfo
toNodeInfo1
      (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()])
-> IO
     (State nodeKey nodeInfo arcInfo, [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (State nodeKey nodeInfo arcInfo
state {pureGraph :: PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph = PureGraph (nodeKey, Node) (arcInfo, Arc)
pureGraph1,toNodeInfo :: nodeKey -> nodeInfo
toNodeInfo = nodeKey -> nodeInfo
toNodeInfo1},[Update nodeInfo () arcInfo ()]
updates)


modifyPureGraph :: (Ord nodeKey,Ord arcInfo,Eq nodeInfo)
   => NameSource
      -- ^ How we generate new Node and Arc values
   -> PureGraph (nodeKey,Node) (arcInfo,Arc)
      -- ^ the old graph, annotated with corresponding node and arc values
   -> PureGraph nodeKey arcInfo
      -- ^ the new graph
   -> (nodeKey -> nodeInfo)
      -- ^ old toNodeInfo function
   -> (nodeKey -> nodeInfo)
      -- ^ new toNodeInfo function
   -> IO (PureGraph (nodeKey,Node) (arcInfo,Arc),
      [Update nodeInfo () arcInfo ()])
      -- ^ the new annotated graph, and the changes to get to it.
modifyPureGraph :: NameSource
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
-> PureGraph nodeKey arcInfo
-> (nodeKey -> nodeInfo)
-> (nodeKey -> nodeInfo)
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
modifyPureGraph NameSource
nameSource
      (pg :: PureGraph (nodeKey, Node) (arcInfo, Arc)
pg @ (PureGraph Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, Arc))
oldFM0 :: PureGraph (nodeKey,Node) (arcInfo,Arc)))
      (PureGraph Map nodeKey (NodeData nodeKey arcInfo)
newFM0 :: PureGraph nodeKey arcInfo)
      (nodeKey -> nodeInfo
oldToNodeInfo :: nodeKey -> nodeInfo)
      (nodeKey -> nodeInfo
toNodeInfo :: nodeKey -> nodeInfo) =
   do
      -- Node-generating mechanism.  We generate nodes dynamically as we
      -- look them up.
      (IORef (Map nodeKey Node)
nodeIORef :: IORef (Map.Map nodeKey Node)) <- Map nodeKey Node -> IO (IORef (Map nodeKey Node))
forall a. a -> IO (IORef a)
newIORef Map nodeKey Node
forall k a. Map k a
Map.empty
      let
         lookupNode :: nodeKey -> IO Node
         lookupNode :: nodeKey -> IO Node
lookupNode nodeKey
nodeKey = case PureGraph (nodeKey, Node) (arcInfo, Arc) -> nodeKey -> Maybe Node
forall nodeKey arcInfo arc.
Ord nodeKey =>
PureGraph (nodeKey, Node) (arcInfo, arc) -> nodeKey -> Maybe Node
lookupPureNode PureGraph (nodeKey, Node) (arcInfo, Arc)
pg nodeKey
nodeKey of
            Just Node
node -> Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
node
            Maybe Node
Nothing ->
               do
                  Map nodeKey Node
fm <- IORef (Map nodeKey Node) -> IO (Map nodeKey Node)
forall a. IORef a -> IO a
readIORef IORef (Map nodeKey Node)
nodeIORef
                  case nodeKey -> Map nodeKey Node -> Maybe Node
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup nodeKey
nodeKey Map nodeKey Node
fm of
                     Just Node
node -> Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
node
                     Maybe Node
Nothing ->
                        do
                           [Char]
nodeStr <- NameSource -> IO [Char]
getNewName NameSource
nameSource
                           let
                              node :: Node
node = [Char] -> Node
forall stringClass.
StringClass stringClass =>
[Char] -> stringClass
fromString [Char]
nodeStr
                           IORef (Map nodeKey Node) -> Map nodeKey Node -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map nodeKey Node)
nodeIORef (nodeKey -> Node -> Map nodeKey Node -> Map nodeKey Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert nodeKey
nodeKey Node
node Map nodeKey Node
fm)
                           Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
node


         oldFM0List :: [((nodeKey,Node),
            NodeData (nodeKey,Node) (arcInfo,Arc))]
         oldFM0List :: [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
oldFM0List = Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, Arc))
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, Arc))
oldFM0

         newFM0List :: [(nodeKey,NodeData nodeKey arcInfo)]
         newFM0List :: [(nodeKey, NodeData nodeKey arcInfo)]
newFM0List = Map nodeKey (NodeData nodeKey arcInfo)
-> [(nodeKey, NodeData nodeKey arcInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList Map nodeKey (NodeData nodeKey arcInfo)
newFM0

         -- type arguments for generalisedMerge

         -- a :: ((nodeKey,Node),NodeData (nodeKey,Node)
         --       (arcInfo,Arc))
         -- b :: (nodeKey,NodeData nodeKey arcInfo)
         -- c :: [Update nodeInfo () arcInfo ()]
         toKey1 :: ((nodeKey,Node),NodeData (nodeKey,Node)
            (arcInfo,Arc)) -> nodeKey
         toKey1 :: ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> nodeKey
toKey1 = (nodeKey, Node) -> nodeKey
forall a b. (a, b) -> a
fst ((nodeKey, Node) -> nodeKey)
-> (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
    -> (nodeKey, Node))
-> ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> nodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> (nodeKey, Node)
forall a b. (a, b) -> a
fst

         toKey2 :: (nodeKey,NodeData nodeKey arcInfo) -> nodeKey
         toKey2 :: (nodeKey, NodeData nodeKey arcInfo) -> nodeKey
toKey2 = (nodeKey, NodeData nodeKey arcInfo) -> nodeKey
forall a b. (a, b) -> a
fst

         compareFn :: ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> (nodeKey, NodeData nodeKey arcInfo) -> Ordering
compareFn ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
a (nodeKey, NodeData nodeKey arcInfo)
b = nodeKey -> nodeKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> nodeKey
toKey1 ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
a) ((nodeKey, NodeData nodeKey arcInfo) -> nodeKey
toKey2 (nodeKey, NodeData nodeKey arcInfo)
b)

         mergeFn ::
            Maybe ((nodeKey,Node),
               NodeData (nodeKey,Node) (arcInfo,Arc))
            -> Maybe (nodeKey,NodeData nodeKey arcInfo)
            -> IO (Maybe ((nodeKey,Node),
                  NodeData (nodeKey,Node)
               (arcInfo,Arc)),Maybe [Update nodeInfo () arcInfo ()])
         mergeFn :: Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> Maybe (nodeKey, NodeData nodeKey arcInfo)
-> IO
     (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
      Maybe [Update nodeInfo () arcInfo ()])
mergeFn (Just ((nodeKey
nodeKey,Node
node),NodeData (nodeKey, Node) (arcInfo, Arc)
nodeData)) Maybe (nodeKey, NodeData nodeKey arcInfo)
Nothing =
            -- this node must be deleted
            do
               let
                  update1 :: Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update1 = Node -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
DeleteNode Node
node
               ([],[Update nodeInfo () arcInfo ()]
updates) <- [ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo) =>
[ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
modifyArcs (NodeData (nodeKey, Node) (arcInfo, Arc)
-> [ArcData (nodeKey, Node) (arcInfo, Arc)]
forall nodeInfo arcInfo.
NodeData nodeInfo arcInfo -> [ArcData nodeInfo arcInfo]
parents NodeData (nodeKey, Node) (arcInfo, Arc)
nodeData) []
                  Node
node NameSource
nameSource nodeKey -> IO Node
lookupNode
               (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
 Maybe [Update nodeInfo () arcInfo ()])
-> IO
     (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
      Maybe [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
forall a. Maybe a
Nothing,[Update nodeInfo () arcInfo ()]
-> Maybe [Update nodeInfo () arcInfo ()]
forall a. a -> Maybe a
Just (Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
update1Update nodeInfo () arcInfo ()
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. a -> [a] -> [a]
:[Update nodeInfo () arcInfo ()]
updates))
         mergeFn Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
Nothing (Just (nodeKey
nodeKey,NodeData nodeKey arcInfo
nodeData)) =
            -- this node must be added
            do
               Node
node <- nodeKey -> IO Node
lookupNode nodeKey
nodeKey
               let
                  nodeInfo :: nodeInfo
nodeInfo = nodeKey -> nodeInfo
toNodeInfo nodeKey
nodeKey
                  update1 :: Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel
update1 = Node
-> NodeType
-> nodeInfo
-> Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> NodeType
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNode Node
node NodeType
theNodeType nodeInfo
nodeInfo
               ([ArcData (nodeKey, Node) (arcInfo, Arc)]
arcDatas,[Update nodeInfo () arcInfo ()]
updates) <- [ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo) =>
[ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
modifyArcs [] (NodeData nodeKey arcInfo -> [ArcData nodeKey arcInfo]
forall nodeInfo arcInfo.
NodeData nodeInfo arcInfo -> [ArcData nodeInfo arcInfo]
parents NodeData nodeKey arcInfo
nodeData)
                  Node
node NameSource
nameSource nodeKey -> IO Node
lookupNode
               (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
 Maybe [Update nodeInfo () arcInfo ()])
-> IO
     (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
      Maybe [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
forall a. a -> Maybe a
Just ((nodeKey
nodeKey,Node
node),
                  NodeData :: forall nodeInfo arcInfo.
[ArcData nodeInfo arcInfo] -> NodeData nodeInfo arcInfo
NodeData {parents :: [ArcData (nodeKey, Node) (arcInfo, Arc)]
parents = [ArcData (nodeKey, Node) (arcInfo, Arc)]
arcDatas}),
                     [Update nodeInfo () arcInfo ()]
-> Maybe [Update nodeInfo () arcInfo ()]
forall a. a -> Maybe a
Just (Update nodeInfo () arcInfo ()
forall nodeTypeLabel arcLabel arcTypeLabel.
Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel
update1Update nodeInfo () arcInfo ()
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. a -> [a] -> [a]
:[Update nodeInfo () arcInfo ()]
updates))
         mergeFn (Just (nn :: (nodeKey, Node)
nn @(nodeKey
nodeKey1,Node
node),NodeData (nodeKey, Node) (arcInfo, Arc)
nodeData1))
               (Just (nodeKey
nodeKey2,NodeData nodeKey arcInfo
nodeData2)) =
            -- node needs to be neither added nor deleted, but the NodeData
            -- might have changed and we might need to change the nodeData
            do
               ([ArcData (nodeKey, Node) (arcInfo, Arc)]
arcDatas,[Update nodeInfo () arcInfo ()]
updates1) <- [ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
forall nodeKey arcInfo nodeInfo.
(Ord nodeKey, Ord arcInfo) =>
[ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
modifyArcs (NodeData (nodeKey, Node) (arcInfo, Arc)
-> [ArcData (nodeKey, Node) (arcInfo, Arc)]
forall nodeInfo arcInfo.
NodeData nodeInfo arcInfo -> [ArcData nodeInfo arcInfo]
parents NodeData (nodeKey, Node) (arcInfo, Arc)
nodeData1)
                  (NodeData nodeKey arcInfo -> [ArcData nodeKey arcInfo]
forall nodeInfo arcInfo.
NodeData nodeInfo arcInfo -> [ArcData nodeInfo arcInfo]
parents NodeData nodeKey arcInfo
nodeData2)
                  Node
node NameSource
nameSource nodeKey -> IO Node
lookupNode
               let
                  nodeInfo1 :: nodeInfo
nodeInfo1 = nodeKey -> nodeInfo
oldToNodeInfo nodeKey
nodeKey1
                  nodeInfo2 :: nodeInfo
nodeInfo2 = nodeKey -> nodeInfo
toNodeInfo nodeKey
nodeKey2

                  updates2 :: [Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel]
updates2 = if nodeInfo
nodeInfo1 nodeInfo -> nodeInfo -> Bool
forall a. Eq a => a -> a -> Bool
== nodeInfo
nodeInfo2
                     then
                        []
                     else [Node
-> nodeInfo -> Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Node
-> nodeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
SetNodeLabel Node
node nodeInfo
nodeInfo2]

                  updates :: [Update nodeInfo () arcInfo ()]
updates = [Update nodeInfo () arcInfo ()]
updates1 [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [Update nodeInfo () arcInfo ()]
forall nodeTypeLabel arcLabel arcTypeLabel.
[Update nodeInfo nodeTypeLabel arcLabel arcTypeLabel]
updates2

               (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
 Maybe [Update nodeInfo () arcInfo ()])
-> IO
     (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
      Maybe [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
forall a. a -> Maybe a
Just ((nodeKey, Node)
nn,NodeData :: forall nodeInfo arcInfo.
[ArcData nodeInfo arcInfo] -> NodeData nodeInfo arcInfo
NodeData {parents :: [ArcData (nodeKey, Node) (arcInfo, Arc)]
parents = [ArcData (nodeKey, Node) (arcInfo, Arc)]
arcDatas}),[Update nodeInfo () arcInfo ()]
-> Maybe [Update nodeInfo () arcInfo ()]
forall a. a -> Maybe a
Just [Update nodeInfo () arcInfo ()]
updates)

      ([((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
newFM1List,[[Update nodeInfo () arcInfo ()]]
updatess0)
         <- [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
-> [(nodeKey, NodeData nodeKey arcInfo)]
-> (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
    -> (nodeKey, NodeData nodeKey arcInfo) -> Ordering)
-> (Maybe
      ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
    -> Maybe (nodeKey, NodeData nodeKey arcInfo)
    -> IO
         (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
          Maybe [Update nodeInfo () arcInfo ()]))
-> IO
     ([((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))],
      [[Update nodeInfo () arcInfo ()]])
forall (m :: * -> *) a b c.
Monad m =>
[a]
-> [b]
-> (a -> b -> Ordering)
-> (Maybe a -> Maybe b -> m (Maybe a, Maybe c))
-> m ([a], [c])
generalisedMerge [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
oldFM0List [(nodeKey, NodeData nodeKey arcInfo)]
newFM0List ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> (nodeKey, NodeData nodeKey arcInfo) -> Ordering
compareFn Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))
-> Maybe (nodeKey, NodeData nodeKey arcInfo)
-> IO
     (Maybe ((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc)),
      Maybe [Update nodeInfo () arcInfo ()])
mergeFn

      -- To make the updates consistent, sort them into the order
      -- (delete arcs) (delete nodes) (add nodes) (set node labels) (add arcs)
      let
         pg1 :: PureGraph (nodeKey, Node) (arcInfo, Arc)
pg1 = Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, Arc))
-> PureGraph (nodeKey, Node) (arcInfo, Arc)
forall nodeInfo arcInfo.
Map nodeInfo (NodeData nodeInfo arcInfo)
-> PureGraph nodeInfo arcInfo
PureGraph ([((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
-> Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, Arc))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, Arc))]
newFM1List)


         updates0 :: [Update nodeInfo () arcInfo ()]
updates0 = [[Update nodeInfo () arcInfo ()]]
-> [Update nodeInfo () arcInfo ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Update nodeInfo () arcInfo ()]]
updatess0

         updates1 :: [Update nodeInfo () arcInfo ()]
updates1 =
               [ Update nodeInfo () arcInfo ()
update | (update :: Update nodeInfo () arcInfo ()
update @ (DeleteArc Arc
_ )) <- [Update nodeInfo () arcInfo ()]
updates0 ]
            [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [ Update nodeInfo () arcInfo ()
update | (update :: Update nodeInfo () arcInfo ()
update @ (DeleteNode Node
_ )) <- [Update nodeInfo () arcInfo ()]
updates0 ]
            [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [ Update nodeInfo () arcInfo ()
update | (update :: Update nodeInfo () arcInfo ()
update @ (NewNode Node
_ NodeType
_ nodeInfo
_ )) <- [Update nodeInfo () arcInfo ()]
updates0 ]
            [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [ Update nodeInfo () arcInfo ()
update | (update :: Update nodeInfo () arcInfo ()
update @ (NewArc Arc
_ ArcType
_ arcInfo
_ Node
_ Node
_ )) <- [Update nodeInfo () arcInfo ()]
updates0 ]
            [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
-> [Update nodeInfo () arcInfo ()]
forall a. [a] -> [a] -> [a]
++ [ Update nodeInfo () arcInfo ()
update | (update :: Update nodeInfo () arcInfo ()
update @ (SetNodeLabel Node
_ nodeInfo
_)) <- [Update nodeInfo () arcInfo ()]
updates0 ]

      (PureGraph (nodeKey, Node) (arcInfo, Arc),
 [Update nodeInfo () arcInfo ()])
-> IO
     (PureGraph (nodeKey, Node) (arcInfo, Arc),
      [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (PureGraph (nodeKey, Node) (arcInfo, Arc)
pg1,[Update nodeInfo () arcInfo ()]
updates1)

lookupPureNode :: Ord nodeKey
   => PureGraph (nodeKey,Node) (arcInfo,arc)
   -> nodeKey
   -> Maybe Node
lookupPureNode :: PureGraph (nodeKey, Node) (arcInfo, arc) -> nodeKey -> Maybe Node
lookupPureNode (PureGraph Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, arc))
fm) nodeKey
nodeKey0 =
  case (((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))
 -> Bool)
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ ((nodeKey
nodeKey1, Node
_), NodeData (nodeKey, Node) (arcInfo, arc)
_) -> nodeKey
nodeKey1 nodeKey -> nodeKey -> Bool
forall a. Eq a => a -> a -> Bool
== nodeKey
nodeKey0) ([((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
 -> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))])
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
forall a b. (a -> b) -> a -> b
$ Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, arc))
-> [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (nodeKey, Node) (NodeData (nodeKey, Node) (arcInfo, arc))
fm of
      ((nodeKey
_,Node
node),NodeData (nodeKey, Node) (arcInfo, arc)
_) : [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
_  -> Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node
      [((nodeKey, Node), NodeData (nodeKey, Node) (arcInfo, arc))]
_ -> Maybe Node
forall a. Maybe a
Nothing

modifyArcs :: (Ord nodeKey,Ord arcInfo)
   -- Invariant.  fromArcs should only be generated by modifyArcs or
   -- else [].  This means we can assume it is sorted.

   => [ArcData (nodeKey,Node) (arcInfo,Arc)]
   -> [ArcData nodeKey arcInfo]
   -> Node -> NameSource -> (nodeKey -> IO Node)
   -> IO ([ArcData (nodeKey,Node) (arcInfo,Arc)],
      [Update nodeInfo () arcInfo ()])
modifyArcs :: [ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> Node
-> NameSource
-> (nodeKey -> IO Node)
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
modifyArcs ([ArcData (nodeKey, Node) (arcInfo, Arc)]
fromArcs :: [ArcData (nodeKey,Node) (arcInfo,Arc)]) [ArcData nodeKey arcInfo]
ontoArcs0
      Node
sourceNode NameSource
nameSource nodeKey -> IO Node
lookupNode =
   let
      toKey :: ArcData (nodeKey,Node) (arcInfo,Arc) ->
         ArcData nodeKey arcInfo
      toKey :: ArcData (nodeKey, Node) (arcInfo, Arc) -> ArcData nodeKey arcInfo
toKey ArcData (nodeKey, Node) (arcInfo, Arc)
arcData0 = ArcData :: forall nodeInfo arcInfo.
arcInfo -> nodeInfo -> ArcData nodeInfo arcInfo
ArcData {
         arcInfo :: arcInfo
arcInfo = (arcInfo, Arc) -> arcInfo
forall a b. (a, b) -> a
fst ((arcInfo, Arc) -> arcInfo)
-> (ArcData (nodeKey, Node) (arcInfo, Arc) -> (arcInfo, Arc))
-> ArcData (nodeKey, Node) (arcInfo, Arc)
-> arcInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArcData (nodeKey, Node) (arcInfo, Arc) -> (arcInfo, Arc)
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> arcInfo
arcInfo (ArcData (nodeKey, Node) (arcInfo, Arc) -> arcInfo)
-> ArcData (nodeKey, Node) (arcInfo, Arc) -> arcInfo
forall a b. (a -> b) -> a -> b
$ ArcData (nodeKey, Node) (arcInfo, Arc)
arcData0,
         target :: nodeKey
target = (nodeKey, Node) -> nodeKey
forall a b. (a, b) -> a
fst ((nodeKey, Node) -> nodeKey)
-> (ArcData (nodeKey, Node) (arcInfo, Arc) -> (nodeKey, Node))
-> ArcData (nodeKey, Node) (arcInfo, Arc)
-> nodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArcData (nodeKey, Node) (arcInfo, Arc) -> (nodeKey, Node)
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> nodeInfo
target (ArcData (nodeKey, Node) (arcInfo, Arc) -> nodeKey)
-> ArcData (nodeKey, Node) (arcInfo, Arc) -> nodeKey
forall a b. (a -> b) -> a -> b
$ ArcData (nodeKey, Node) (arcInfo, Arc)
arcData0
         }

      -- (1) sort ontoArcs.  (fromArcs should already be sorted)
      ontoArcs1 :: [ArcData nodeKey arcInfo]
ontoArcs1 = [ArcData nodeKey arcInfo] -> [ArcData nodeKey arcInfo]
forall a. Ord a => [a] -> [a]
sort [ArcData nodeKey arcInfo]
ontoArcs0

      -- (2) define functions for generalisedMerge
      compareFn :: ArcData (nodeKey,Node) (arcInfo,Arc)
         -> ArcData nodeKey arcInfo -> Ordering
      compareFn :: ArcData (nodeKey, Node) (arcInfo, Arc)
-> ArcData nodeKey arcInfo -> Ordering
compareFn ArcData (nodeKey, Node) (arcInfo, Arc)
arc1 ArcData nodeKey arcInfo
arc2 = ArcData nodeKey arcInfo -> ArcData nodeKey arcInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ArcData (nodeKey, Node) (arcInfo, Arc) -> ArcData nodeKey arcInfo
toKey ArcData (nodeKey, Node) (arcInfo, Arc)
arc1) ArcData nodeKey arcInfo
arc2

      mergeFn :: Maybe (ArcData (nodeKey,Node) (arcInfo,Arc))
         -> Maybe (ArcData nodeKey arcInfo)
         -> IO (Maybe (ArcData (nodeKey,Node) (arcInfo,Arc)),
            Maybe (Update nodeInfo () arcInfo ()))
      mergeFn :: Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
-> Maybe (ArcData nodeKey arcInfo)
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
mergeFn (Just ArcData (nodeKey, Node) (arcInfo, Arc)
arcData) Maybe (ArcData nodeKey arcInfo)
Nothing =
         (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
 Maybe (Update nodeInfo () arcInfo ()))
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
forall a. Maybe a
Nothing,Update nodeInfo () arcInfo ()
-> Maybe (Update nodeInfo () arcInfo ())
forall a. a -> Maybe a
Just (Arc -> Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc -> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
DeleteArc ((arcInfo, Arc) -> Arc
forall a b. (a, b) -> b
snd ((arcInfo, Arc) -> Arc)
-> (ArcData (nodeKey, Node) (arcInfo, Arc) -> (arcInfo, Arc))
-> ArcData (nodeKey, Node) (arcInfo, Arc)
-> Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArcData (nodeKey, Node) (arcInfo, Arc) -> (arcInfo, Arc)
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> arcInfo
arcInfo (ArcData (nodeKey, Node) (arcInfo, Arc) -> Arc)
-> ArcData (nodeKey, Node) (arcInfo, Arc) -> Arc
forall a b. (a -> b) -> a -> b
$ ArcData (nodeKey, Node) (arcInfo, Arc)
arcData)))
      mergeFn Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
Nothing (Just ArcData nodeKey arcInfo
arcData0) =
         do
            [Char]
arcStr <- NameSource -> IO [Char]
getNewName NameSource
nameSource
            let
               arc :: Arc
               arc :: Arc
arc = [Char] -> Arc
forall stringClass.
StringClass stringClass =>
[Char] -> stringClass
fromString [Char]
arcStr

            (Node
targetNode :: Node) <- nodeKey -> IO Node
lookupNode (ArcData nodeKey arcInfo -> nodeKey
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> nodeInfo
target ArcData nodeKey arcInfo
arcData0)

            let
               arcInfo1 :: arcInfo
arcInfo1 = ArcData nodeKey arcInfo -> arcInfo
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> arcInfo
arcInfo ArcData nodeKey arcInfo
arcData0

               arcData1 :: ArcData (nodeKey, Node) (arcInfo, Arc)
arcData1 = ArcData :: forall nodeInfo arcInfo.
arcInfo -> nodeInfo -> ArcData nodeInfo arcInfo
ArcData {
                  arcInfo :: (arcInfo, Arc)
arcInfo = (arcInfo
arcInfo1,Arc
arc),
                  target :: (nodeKey, Node)
target = (ArcData nodeKey arcInfo -> nodeKey
forall nodeInfo arcInfo. ArcData nodeInfo arcInfo -> nodeInfo
target ArcData nodeKey arcInfo
arcData0,Node
targetNode)
                  }
            (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
 Maybe (Update nodeInfo () arcInfo ()))
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (ArcData (nodeKey, Node) (arcInfo, Arc)
-> Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
forall a. a -> Maybe a
Just ArcData (nodeKey, Node) (arcInfo, Arc)
arcData1,Update nodeInfo () arcInfo ()
-> Maybe (Update nodeInfo () arcInfo ())
forall a. a -> Maybe a
Just
               (Arc
-> ArcType
-> arcInfo
-> Node
-> Node
-> Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
Arc
-> ArcType
-> arcLabel
-> Node
-> Node
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArc Arc
arc ArcType
theArcType arcInfo
arcInfo1 Node
targetNode Node
sourceNode))
      mergeFn (Just ArcData (nodeKey, Node) (arcInfo, Arc)
arcData1) (Just ArcData nodeKey arcInfo
_) = (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
 Maybe (Update nodeInfo () arcInfo ()))
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (ArcData (nodeKey, Node) (arcInfo, Arc)
-> Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
forall a. a -> Maybe a
Just ArcData (nodeKey, Node) (arcInfo, Arc)
arcData1,Maybe (Update nodeInfo () arcInfo ())
forall a. Maybe a
Nothing)
   in
      [ArcData (nodeKey, Node) (arcInfo, Arc)]
-> [ArcData nodeKey arcInfo]
-> (ArcData (nodeKey, Node) (arcInfo, Arc)
    -> ArcData nodeKey arcInfo -> Ordering)
-> (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
    -> Maybe (ArcData nodeKey arcInfo)
    -> IO
         (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
          Maybe (Update nodeInfo () arcInfo ())))
-> IO
     ([ArcData (nodeKey, Node) (arcInfo, Arc)],
      [Update nodeInfo () arcInfo ()])
forall (m :: * -> *) a b c.
Monad m =>
[a]
-> [b]
-> (a -> b -> Ordering)
-> (Maybe a -> Maybe b -> m (Maybe a, Maybe c))
-> m ([a], [c])
generalisedMerge [ArcData (nodeKey, Node) (arcInfo, Arc)]
fromArcs [ArcData nodeKey arcInfo]
ontoArcs1 ArcData (nodeKey, Node) (arcInfo, Arc)
-> ArcData nodeKey arcInfo -> Ordering
compareFn Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
-> Maybe (ArcData nodeKey arcInfo)
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
forall nodeInfo.
Maybe (ArcData (nodeKey, Node) (arcInfo, Arc))
-> Maybe (ArcData nodeKey arcInfo)
-> IO
     (Maybe (ArcData (nodeKey, Node) (arcInfo, Arc)),
      Maybe (Update nodeInfo () arcInfo ()))
mergeFn

-- ----------------------------------------------------------------------
-- Node and Arc types
-- We only have one of each.
-- ----------------------------------------------------------------------

theNodeType :: NodeType
theNodeType :: NodeType
theNodeType = [Char] -> NodeType
forall stringClass.
StringClass stringClass =>
[Char] -> stringClass
fromString [Char]
""

theArcType :: ArcType
theArcType :: ArcType
theArcType = [Char] -> ArcType
forall stringClass.
StringClass stringClass =>
[Char] -> stringClass
fromString [Char]
""

typeUpdates :: [Update nodeInfo () arcInfo ()]
typeUpdates :: [Update nodeInfo () arcInfo ()]
typeUpdates = [NodeType -> () -> Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
NodeType
-> nodeTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewNodeType NodeType
theNodeType (),ArcType -> () -> Update nodeInfo () arcInfo ()
forall nodeLabel nodeTypeLabel arcLabel arcTypeLabel.
ArcType
-> arcTypeLabel
-> Update nodeLabel nodeTypeLabel arcLabel arcTypeLabel
NewArcType ArcType
theArcType ()]