{-# LANGUAGE CPP #-}

-- | Utility methods to automatically generate and keep track of a mapping
-- between node labels and 'Node's.
module Data.Graph.Inductive.NodeMap(
    -- * Functional Construction
    NodeMap,
    -- ** Map Construction
    new, fromGraph, mkNode, mkNode_, mkNodes, mkNodes_, mkEdge, mkEdges,
    -- ** Graph Construction
    -- | These functions mirror the construction and destruction functions in
    -- 'Data.Graph.Inductive.Graph', but use the given 'NodeMap' to look up
    -- the appropriate 'Node's.  Note that the 'insMapNode' family of functions
    -- will create new nodes as needed, but the other functions will not.
    insMapNode, insMapNode_, insMapEdge, delMapNode, delMapEdge, insMapNodes,
    insMapNodes_, insMapEdges, delMapNodes, delMapEdges, mkMapGraph,
    -- * Monadic Construction
    NodeMapM,
    -- | The following mirror the functional construction functions, but handle passing
    -- 'NodeMap's and 'Graph's behind the scenes.

    -- ** Map Construction
    run, run_, mkNodeM, mkNodesM, mkEdgeM, mkEdgesM,
    -- ** Graph Construction
    insMapNodeM, insMapEdgeM, delMapNodeM, delMapEdgeM, insMapNodesM,
    insMapEdgesM, delMapNodesM, delMapEdgesM
) where

import           Control.Monad.Trans.State
import           Data.Graph.Inductive.Graph
import           Prelude                    hiding (map)
import qualified Prelude                    as P (map)

import           Data.Map (Map)
import qualified Data.Map as M

#if MIN_VERSION_containers (0,4,2)
import Control.DeepSeq (NFData (..))
#endif

data NodeMap a =
    NodeMap { forall a. NodeMap a -> Map a Node
map :: Map a Node,
              forall a. NodeMap a -> Node
key :: Int }
    deriving (NodeMap a -> NodeMap a -> Bool
forall a. Eq a => NodeMap a -> NodeMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeMap a -> NodeMap a -> Bool
$c/= :: forall a. Eq a => NodeMap a -> NodeMap a -> Bool
== :: NodeMap a -> NodeMap a -> Bool
$c== :: forall a. Eq a => NodeMap a -> NodeMap a -> Bool
Eq, Node -> NodeMap a -> ShowS
forall a. Show a => Node -> NodeMap a -> ShowS
forall a. Show a => [NodeMap a] -> ShowS
forall a. Show a => NodeMap a -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeMap a] -> ShowS
$cshowList :: forall a. Show a => [NodeMap a] -> ShowS
show :: NodeMap a -> String
$cshow :: forall a. Show a => NodeMap a -> String
showsPrec :: Node -> NodeMap a -> ShowS
$cshowsPrec :: forall a. Show a => Node -> NodeMap a -> ShowS
Show, ReadPrec [NodeMap a]
ReadPrec (NodeMap a)
ReadS [NodeMap a]
forall a. (Ord a, Read a) => ReadPrec [NodeMap a]
forall a. (Ord a, Read a) => ReadPrec (NodeMap a)
forall a. (Ord a, Read a) => Node -> ReadS (NodeMap a)
forall a. (Ord a, Read a) => ReadS [NodeMap a]
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeMap a]
$creadListPrec :: forall a. (Ord a, Read a) => ReadPrec [NodeMap a]
readPrec :: ReadPrec (NodeMap a)
$creadPrec :: forall a. (Ord a, Read a) => ReadPrec (NodeMap a)
readList :: ReadS [NodeMap a]
$creadList :: forall a. (Ord a, Read a) => ReadS [NodeMap a]
readsPrec :: Node -> ReadS (NodeMap a)
$creadsPrec :: forall a. (Ord a, Read a) => Node -> ReadS (NodeMap a)
Read)

#if MIN_VERSION_containers (0,4,2)
instance (NFData a) => NFData (NodeMap a) where
  rnf :: NodeMap a -> ()
rnf (NodeMap Map a Node
mp Node
k) = forall a. NFData a => a -> ()
rnf Map a Node
mp seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Node
k
#endif

-- | Create a new, empty mapping.
new :: NodeMap a
new :: forall a. NodeMap a
new = NodeMap { map :: Map a Node
map = forall k a. Map k a
M.empty, key :: Node
key = Node
0 }

-- LNode = (Node, a)

-- | Generate a mapping containing the nodes in the given graph.
fromGraph :: (Ord a, Graph g) => g a b -> NodeMap a
fromGraph :: forall a (g :: * -> * -> *) b.
(Ord a, Graph g) =>
g a b -> NodeMap a
fromGraph g a b
g =
    let ns :: [LNode a]
ns = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes g a b
g
        aux :: (b, k) -> (Map k b, b) -> (Map k b, b)
aux (b
n, k
a) (Map k b
m', b
k') = (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
a b
n Map k b
m', forall a. Ord a => a -> a -> a
max b
n b
k')
        (Map a Node
m, Node
k) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {b}.
(Ord k, Ord b) =>
(b, k) -> (Map k b, b) -> (Map k b, b)
aux (forall k a. Map k a
M.empty, Node
0) [LNode a]
ns
    in NodeMap { map :: Map a Node
map = Map a Node
m, key :: Node
key = Node
kforall a. Num a => a -> a -> a
+Node
1 }

-- | Generate a labelled node from the given label.  Will return the same node
-- for the same label.
mkNode :: (Ord a) => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode :: forall a. Ord a => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode m :: NodeMap a
m@(NodeMap Map a Node
mp Node
k) a
a =
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a Map a Node
mp of
        Just Node
i        -> ((Node
i, a
a), NodeMap a
m)
        Maybe Node
Nothing        ->
            let m' :: NodeMap a
m' = NodeMap { map :: Map a Node
map = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
a Node
k Map a Node
mp, key :: Node
key = Node
kforall a. Num a => a -> a -> a
+Node
1 }
            in ((Node
k, a
a), NodeMap a
m')

-- | Generate a labelled node and throw away the modified 'NodeMap'.
mkNode_ :: (Ord a) => NodeMap a -> a -> LNode a
mkNode_ :: forall a. Ord a => NodeMap a -> a -> LNode a
mkNode_ NodeMap a
m a
a = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Ord a => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode NodeMap a
m a
a

-- | Generate a 'LEdge' from the node labels.
mkEdge :: (Ord a) => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge :: forall a b. Ord a => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge (NodeMap Map a Node
m Node
_) (a
a1, a
a2, b
b) =
    do Node
n1 <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a1 Map a Node
m
       Node
n2 <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a2 Map a Node
m
       forall (m :: * -> *) a. Monad m => a -> m a
return (Node
n1, Node
n2, b
b)

-- | Generates a list of 'LEdge's.
mkEdges :: (Ord a) => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges :: forall a b. Ord a => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges NodeMap a
m = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. Ord a => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge NodeMap a
m)

-- | Construct a list of nodes.
mkNodes :: (Ord a) => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes :: forall a. Ord a => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes = forall a b c. (a -> b -> (c, a)) -> a -> [b] -> ([c], a)
map' forall a. Ord a => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode

map' :: (a -> b -> (c, a)) -> a -> [b] -> ([c], a)
map' :: forall a b c. (a -> b -> (c, a)) -> a -> [b] -> ([c], a)
map' a -> b -> (c, a)
_ a
a [] = ([], a
a)
map' a -> b -> (c, a)
f a
a (b
b:[b]
bs) =
    let (c
c, a
a') = a -> b -> (c, a)
f a
a b
b
        ([c]
cs, a
a'') = forall a b c. (a -> b -> (c, a)) -> a -> [b] -> ([c], a)
map' a -> b -> (c, a)
f a
a' [b]
bs
    in (c
cforall a. a -> [a] -> [a]
:[c]
cs, a
a'')

-- | Construct a list of nodes and throw away the modified 'NodeMap'.
mkNodes_ :: (Ord a) => NodeMap a -> [a] -> [LNode a]
mkNodes_ :: forall a. Ord a => NodeMap a -> [a] -> [LNode a]
mkNodes_ NodeMap a
m [a]
as = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Ord a => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes NodeMap a
m [a]
as

insMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a)
insMapNode :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a)
insMapNode NodeMap a
m a
a g a b
g =
    let (LNode a
n, NodeMap a
m') = forall a. Ord a => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode NodeMap a
m a
a
    in (forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode LNode a
n g a b
g, NodeMap a
m', LNode a
n)

insMapNode_ :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b
insMapNode_ :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> g a b
insMapNode_ NodeMap a
m a
a g a b
g =
    let (g a b
g', NodeMap a
_, LNode a
_) = forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a)
insMapNode NodeMap a
m a
a g a b
g
    in g a b
g'

insMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a, b) -> g a b -> g a b
insMapEdge :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> (a, a, b) -> g a b -> g a b
insMapEdge NodeMap a
m (a, a, b)
e g a b
g =
    let (Just LEdge b
e') = forall a b. Ord a => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge NodeMap a
m (a, a, b)
e
    in forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge LEdge b
e' g a b
g

delMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b
delMapNode :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> g a b
delMapNode NodeMap a
m a
a g a b
g =
    let (Node
n, a
_) = forall a. Ord a => NodeMap a -> a -> LNode a
mkNode_ NodeMap a
m a
a
    in forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> gr a b
delNode Node
n g a b
g

delMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a) -> g a b -> g a b
delMapEdge :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> (a, a) -> g a b -> g a b
delMapEdge NodeMap a
m (a
n1, a
n2) g a b
g =
    let Just (Node
n1', Node
n2', ()
_) = forall a b. Ord a => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge NodeMap a
m (a
n1, a
n2, ())
    in forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Edge -> gr a b -> gr a b
delEdge (Node
n1', Node
n2') g a b
g

insMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])
insMapNodes :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])
insMapNodes NodeMap a
m [a]
as g a b
g =
    let ([LNode a]
ns, NodeMap a
m') = forall a. Ord a => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes NodeMap a
m [a]
as
    in (forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
ns g a b
g, NodeMap a
m', [LNode a]
ns)

insMapNodes_ :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b
insMapNodes_ :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> g a b
insMapNodes_ NodeMap a
m [a]
as g a b
g =
    let (g a b
g', NodeMap a
_, [LNode a]
_) = forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])
insMapNodes NodeMap a
m [a]
as g a b
g
    in g a b
g'

insMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a, b)] -> g a b -> g a b
insMapEdges :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [(a, a, b)] -> g a b -> g a b
insMapEdges NodeMap a
m [(a, a, b)]
es g a b
g =
    let Just [LEdge b]
es' = forall a b. Ord a => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges NodeMap a
m [(a, a, b)]
es
    in forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge b]
es' g a b
g

delMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b
delMapNodes :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> g a b
delMapNodes NodeMap a
m [a]
as g a b
g =
    let ns :: [Node]
ns = forall a b. (a -> b) -> [a] -> [b]
P.map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Ord a => NodeMap a -> [a] -> [LNode a]
mkNodes_ NodeMap a
m [a]
as
    in forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> gr a b
delNodes [Node]
ns g a b
g

delMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a)] -> g a b -> g a b
delMapEdges :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [(a, a)] -> g a b -> g a b
delMapEdges NodeMap a
m [(a, a)]
ns g a b
g =
    let Just [LEdge ()]
ns' =  forall a b. Ord a => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges NodeMap a
m forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
P.map (\(a
a, a
b) -> (a
a, a
b, ())) [(a, a)]
ns
        ns'' :: [Edge]
ns'' = forall a b. (a -> b) -> [a] -> [b]
P.map (\(Node
a, Node
b, ()
_) -> (Node
a, Node
b)) [LEdge ()]
ns'
    in forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Edge] -> gr a b -> gr a b
delEdges [Edge]
ns'' g a b
g

mkMapGraph :: (Ord a, DynGraph g) => [a] -> [(a, a, b)] -> (g a b, NodeMap a)
mkMapGraph :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[a] -> [(a, a, b)] -> (g a b, NodeMap a)
mkMapGraph [a]
ns [(a, a, b)]
es =
    let ([LNode a]
ns', NodeMap a
m') = forall a. Ord a => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes forall a. NodeMap a
new [a]
ns
        Just [LEdge b]
es' = forall a b. Ord a => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges NodeMap a
m' [(a, a, b)]
es
    in (forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode a]
ns' [LEdge b]
es', NodeMap a
m')

-- | Graph construction monad; handles passing both the 'NodeMap' and the
-- 'Graph'.
type NodeMapM a b g r = State (NodeMap a, g a b) r

-- | Run a construction; return the value of the computation, the modified
-- 'NodeMap', and the modified 'Graph'.
run :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> (r, (NodeMap a, g a b))
run :: forall (g :: * -> * -> *) a b r.
(DynGraph g, Ord a) =>
g a b -> NodeMapM a b g r -> (r, (NodeMap a, g a b))
run g a b
g NodeMapM a b g r
m = forall s a. State s a -> s -> (a, s)
runState NodeMapM a b g r
m (forall a (g :: * -> * -> *) b.
(Ord a, Graph g) =>
g a b -> NodeMap a
fromGraph g a b
g, g a b
g)

-- | Run a construction and only return the 'Graph'.
run_ :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> g a b
run_ :: forall (g :: * -> * -> *) a b r.
(DynGraph g, Ord a) =>
g a b -> NodeMapM a b g r -> g a b
run_ g a b
g NodeMapM a b g r
m = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (g :: * -> * -> *) a b r.
(DynGraph g, Ord a) =>
g a b -> NodeMapM a b g r -> (r, (NodeMap a, g a b))
run g a b
g NodeMapM a b g r
m

{- not used
liftN1 :: (Ord a, DynGraph g) => (NodeMap a -> (c, NodeMap a)) -> NodeMapM a b g c
liftN1 f =
    do (m, g) <- get
       let (r, m') = f m
       put (m', g)
       return r

liftN1' :: (Ord a, DynGraph g) => (NodeMap a -> c) -> NodeMapM a b g c
liftN1' f =
    do (m, g) <- get
       return $ f m
-}
liftN2 :: (NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d
liftN2 :: forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d
liftN2 NodeMap a -> c -> (d, NodeMap a)
f c
c =
    do (NodeMap a
m, g a b
g) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
       let (d
r, NodeMap a
m') = NodeMap a -> c -> (d, NodeMap a)
f NodeMap a
m c
c
       forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (NodeMap a
m', g a b
g)
       forall (m :: * -> *) a. Monad m => a -> m a
return d
r

liftN2' :: (NodeMap a -> c -> d) -> c -> NodeMapM a b g d
liftN2' :: forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> d) -> c -> NodeMapM a b g d
liftN2' NodeMap a -> c -> d
f c
c =
    do (NodeMap a
m, g a b
_) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NodeMap a -> c -> d
f NodeMap a
m c
c
{- not used
liftN3 :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> (e, NodeMap a)) -> c -> d -> NodeMapM a b g e
liftN3 f c d =
    do (m, g) <- get
       let (r, m') = f m c d
       put (m', g)
       return r

liftN3' :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> e) -> c -> d -> NodeMapM a b g e
liftN3' f c d =
    do (m, g) <- get
       return $ f m c d
-}
liftM1 :: (NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 :: forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 NodeMap a -> c -> g a b -> g a b
f c
c =
    do (NodeMap a
m, g a b
g) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
       let g' :: g a b
g' = NodeMap a -> c -> g a b -> g a b
f NodeMap a
m c
c g a b
g
       forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (NodeMap a
m, g a b
g')

liftM1' :: (NodeMap a -> c -> g a b -> (g a b, NodeMap a, d)) -> c -> NodeMapM a b g d
liftM1' :: forall a c (g :: * -> * -> *) b d.
(NodeMap a -> c -> g a b -> (g a b, NodeMap a, d))
-> c -> NodeMapM a b g d
liftM1' NodeMap a -> c -> g a b -> (g a b, NodeMap a, d)
f c
c =
    do (NodeMap a
m, g a b
g) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
       let (g a b
g', NodeMap a
m', d
r) = NodeMap a -> c -> g a b -> (g a b, NodeMap a, d)
f NodeMap a
m c
c g a b
g
       forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (NodeMap a
m', g a b
g')
       forall (m :: * -> *) a. Monad m => a -> m a
return d
r

-- | Monadic node construction.
mkNodeM :: (Ord a) => a -> NodeMapM a b g (LNode a)
mkNodeM :: forall a b (g :: * -> * -> *).
Ord a =>
a -> NodeMapM a b g (LNode a)
mkNodeM = forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d
liftN2 forall a. Ord a => NodeMap a -> a -> (LNode a, NodeMap a)
mkNode

mkNodesM :: (Ord a) => [a] -> NodeMapM a b g [LNode a]
mkNodesM :: forall a b (g :: * -> * -> *).
Ord a =>
[a] -> NodeMapM a b g [LNode a]
mkNodesM = forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d
liftN2 forall a. Ord a => NodeMap a -> [a] -> ([LNode a], NodeMap a)
mkNodes

mkEdgeM :: (Ord a) => (a, a, b) -> NodeMapM a b g (Maybe (LEdge b))
mkEdgeM :: forall a b (g :: * -> * -> *).
Ord a =>
(a, a, b) -> NodeMapM a b g (Maybe (LEdge b))
mkEdgeM = forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> d) -> c -> NodeMapM a b g d
liftN2' forall a b. Ord a => NodeMap a -> (a, a, b) -> Maybe (LEdge b)
mkEdge

mkEdgesM :: (Ord a) => [(a, a, b)] -> NodeMapM a b g (Maybe [LEdge b])
mkEdgesM :: forall a b (g :: * -> * -> *).
Ord a =>
[(a, a, b)] -> NodeMapM a b g (Maybe [LEdge b])
mkEdgesM = forall a c d b (g :: * -> * -> *).
(NodeMap a -> c -> d) -> c -> NodeMapM a b g d
liftN2' forall a b. Ord a => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b]
mkEdges

insMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a)
insMapNodeM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
a -> NodeMapM a b g (LNode a)
insMapNodeM = forall a c (g :: * -> * -> *) b d.
(NodeMap a -> c -> g a b -> (g a b, NodeMap a, d))
-> c -> NodeMapM a b g d
liftM1' forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a)
insMapNode

insMapEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g ()
insMapEdgeM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
(a, a, b) -> NodeMapM a b g ()
insMapEdgeM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> (a, a, b) -> g a b -> g a b
insMapEdge

delMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g ()
delMapNodeM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
a -> NodeMapM a b g ()
delMapNodeM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> a -> g a b -> g a b
delMapNode

delMapEdgeM :: (Ord a, DynGraph g) => (a, a) -> NodeMapM a b g ()
delMapEdgeM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
(a, a) -> NodeMapM a b g ()
delMapEdgeM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> (a, a) -> g a b -> g a b
delMapEdge

insMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a]
insMapNodesM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[a] -> NodeMapM a b g [LNode a]
insMapNodesM = forall a c (g :: * -> * -> *) b d.
(NodeMap a -> c -> g a b -> (g a b, NodeMap a, d))
-> c -> NodeMapM a b g d
liftM1' forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a])
insMapNodes

insMapEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g ()
insMapEdgesM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[(a, a, b)] -> NodeMapM a b g ()
insMapEdgesM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [(a, a, b)] -> g a b -> g a b
insMapEdges

delMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g ()
delMapNodesM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[a] -> NodeMapM a b g ()
delMapNodesM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [a] -> g a b -> g a b
delMapNodes

delMapEdgesM :: (Ord a, DynGraph g) => [(a, a)] -> NodeMapM a b g ()
delMapEdgesM :: forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[(a, a)] -> NodeMapM a b g ()
delMapEdgesM = forall a c (g :: * -> * -> *) b.
(NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g ()
liftM1 forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
NodeMap a -> [(a, a)] -> g a b -> g a b
delMapEdges