{-# LANGUAGE CPP, MultiParamTypeClasses #-}

-- (c) 2002 by Martin Erwig [see file COPYRIGHT]
-- | Monadic Graph Algorithms

module Data.Graph.Inductive.Query.Monad(
    -- * Additional Graph Utilities
    mapFst, mapSnd, (><), orP,
    -- * Graph Transformer Monad
    GT(..), apply, apply', applyWith, applyWith', runGT, condMGT', recMGT',
    condMGT, recMGT,
    -- * Graph Computations Based on Graph Monads
    -- ** Monadic Graph Accessing Functions
    getNode, getContext, getNodes', getNodes, sucGT, sucM,
    -- ** Derived Graph Recursion Operators
    graphRec, graphRec', graphUFold,
    -- * Examples: Graph Algorithms as Instances of Recursion Operators
    -- ** Instances of graphRec
    graphNodesM0, graphNodesM, graphNodes, graphFilterM, graphFilter,
    -- * Example: Monadic DFS Algorithm(s)
    dfsGT, dfsM, dfsM', dffM, graphDff, graphDff',
) where


-- Why all this?
--
-- graph monad ensures single-threaded access
--  ==> we can safely use imperative updates in the graph implementation
--

import Control.Monad (ap, liftM, liftM2)
import Data.Tree

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative (..))
#endif

import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Monad

-- some additional (graph) utilities
--
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst a -> b
f (a
x,c
y) = (a -> b
f a
x,c
y)
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x,a
y) = (c
x,a -> b
f a
y)

infixr 8 ><
(><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
(a -> b
f >< :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
>< c -> d
g) (a
x,c
y) = (a -> b
f a
x,c -> d
g c
y)

orP :: (a -> Bool) -> (b -> Bool) -> (a,b) -> Bool
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP a -> Bool
p b -> Bool
q (a
x,b
y) = a -> Bool
p a
x Bool -> Bool -> Bool
|| b -> Bool
q b
y

----------------------------------------------------------------------
-- "wrapped" state transformer monad   ==
-- monadic graph transformer monad
----------------------------------------------------------------------

newtype GT m g a = MGT (m g -> m (a,g))

apply :: GT m g a -> m g -> m (a,g)
apply :: GT m g a -> m g -> m (a, g)
apply (MGT m g -> m (a, g)
f) = m g -> m (a, g)
f

apply' :: (Monad m) => GT m g a -> g -> m (a,g)
apply' :: GT m g a -> g -> m (a, g)
apply' GT m g a
gt = GT m g a -> m g -> m (a, g)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m g a
gt (m g -> m (a, g)) -> (g -> m g) -> g -> m (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m g
forall (m :: * -> *) a. Monad m => a -> m a
return

applyWith :: (Monad m) => (a -> b) -> GT m g a -> m g -> m (b,g)
applyWith :: (a -> b) -> GT m g a -> m g -> m (b, g)
applyWith a -> b
h (MGT m g -> m (a, g)
f) m g
gm = do {(a
x,g
g) <- m g -> m (a, g)
f m g
gm; (b, g) -> m (b, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
h a
x,g
g)}

applyWith' :: (Monad m) => (a -> b) -> GT m g a -> g -> m (b,g)
applyWith' :: (a -> b) -> GT m g a -> g -> m (b, g)
applyWith' a -> b
h GT m g a
gt = (a -> b) -> GT m g a -> m g -> m (b, g)
forall (m :: * -> *) a b g.
Monad m =>
(a -> b) -> GT m g a -> m g -> m (b, g)
applyWith a -> b
h GT m g a
gt (m g -> m (b, g)) -> (g -> m g) -> g -> m (b, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m g
forall (m :: * -> *) a. Monad m => a -> m a
return

runGT :: (Monad m) => GT m g a -> m g -> m a
runGT :: GT m g a -> m g -> m a
runGT GT m g a
gt m g
mg = do {(a
x,g
_) <- GT m g a -> m g -> m (a, g)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m g a
gt m g
mg; a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x}

instance (Monad m) => Functor (GT m g) where
    fmap :: (a -> b) -> GT m g a -> GT m g b
fmap  = (a -> b) -> GT m g a -> GT m g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance (Monad m) => Applicative (GT m g) where
    pure :: a -> GT m g a
pure  = a -> GT m g a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: GT m g (a -> b) -> GT m g a -> GT m g b
(<*>) = GT m g (a -> b) -> GT m g a -> GT m g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance (Monad m) => Monad (GT m g) where
  return :: a -> GT m g a
return a
x = (m g -> m (a, g)) -> GT m g a
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m g
mg->do {g
g<-m g
mg; (a, g) -> m (a, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,g
g)})
  GT m g a
f >>= :: GT m g a -> (a -> GT m g b) -> GT m g b
>>= a -> GT m g b
h  = (m g -> m (b, g)) -> GT m g b
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m g
mg->do {(a
x,g
g)<-GT m g a -> m g -> m (a, g)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m g a
f m g
mg; GT m g b -> g -> m (b, g)
forall (m :: * -> *) g a. Monad m => GT m g a -> g -> m (a, g)
apply' (a -> GT m g b
h a
x) g
g})

condMGT' :: (Monad m) => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT' :: (s -> Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT' s -> Bool
p GT m s a
f GT m s a
g = (m s -> m (a, s)) -> GT m s a
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m s
mg->do {s
h<-m s
mg; if s -> Bool
p s
h then GT m s a -> m s -> m (a, s)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m s a
f m s
mg else GT m s a -> m s -> m (a, s)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m s a
g m s
mg})

recMGT' :: (Monad m) => (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT' :: (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT' s -> Bool
p GT m s a
mg a -> b -> b
f b
u = (s -> Bool) -> GT m s b -> GT m s b -> GT m s b
forall (m :: * -> *) s a.
Monad m =>
(s -> Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT' s -> Bool
p (b -> GT m s b
forall (m :: * -> *) a. Monad m => a -> m a
return b
u)
                            (do {a
x<-GT m s a
mg;b
y<-(s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
forall (m :: * -> *) s a b.
Monad m =>
(s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT' s -> Bool
p GT m s a
mg a -> b -> b
f b
u;b -> GT m s b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> b
f a
x b
y)})

condMGT :: (Monad m) => (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT :: (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT m s -> m Bool
p GT m s a
f GT m s a
g = (m s -> m (a, s)) -> GT m s a
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m s
mg->do {Bool
b<-m s -> m Bool
p m s
mg; if Bool
b then GT m s a -> m s -> m (a, s)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m s a
f m s
mg else GT m s a -> m s -> m (a, s)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply GT m s a
g m s
mg})

recMGT :: (Monad m) => (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT :: (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT m s -> m Bool
p GT m s a
mg a -> b -> b
f b
u = (m s -> m Bool) -> GT m s b -> GT m s b -> GT m s b
forall (m :: * -> *) s a.
Monad m =>
(m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT m s -> m Bool
p (b -> GT m s b
forall (m :: * -> *) a. Monad m => a -> m a
return b
u)
                          (do {a
x<-GT m s a
mg;b
y<-(m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
forall (m :: * -> *) s a b.
Monad m =>
(m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT m s -> m Bool
p GT m s a
mg a -> b -> b
f b
u;b -> GT m s b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> b
f a
x b
y)})


----------------------------------------------------------------------
-- graph computations based on state monads/graph monads
----------------------------------------------------------------------


-- some monadic graph accessing functions
--
getNode :: (GraphM m gr) => GT m (gr a b) Node
getNode :: GT m (gr a b) Node
getNode = (m (gr a b) -> m (Node, gr a b)) -> GT m (gr a b) Node
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m (gr a b)
mg->do {((Adj b
_,Node
v,a
_,Adj b
_),gr a b
g) <- m (gr a b) -> m (Context a b, gr a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m (GDecomp gr a b)
matchAnyM m (gr a b)
mg; (Node, gr a b) -> m (Node, gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Node
v,gr a b
g)})

getContext :: (GraphM m gr) => GT m (gr a b) (Context a b)
getContext :: GT m (gr a b) (Context a b)
getContext = (m (gr a b) -> m (Context a b, gr a b))
-> GT m (gr a b) (Context a b)
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT m (gr a b) -> m (Context a b, gr a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m (GDecomp gr a b)
matchAnyM

-- some functions defined by using the do-notation explicitly
-- Note: most of these can be expressed as an instance of graphRec
--
getNodes' :: (Graph gr,GraphM m gr) => GT m (gr a b) [Node]
getNodes' :: GT m (gr a b) [Node]
getNodes' = (gr a b -> Bool)
-> GT m (gr a b) [Node]
-> GT m (gr a b) [Node]
-> GT m (gr a b) [Node]
forall (m :: * -> *) s a.
Monad m =>
(s -> Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT' gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return []) GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) [Node]
nodeGetter

getNodes :: (GraphM m gr) => GT m (gr a b) [Node]
getNodes :: GT m (gr a b) [Node]
getNodes = (m (gr a b) -> m Bool)
-> GT m (gr a b) [Node]
-> GT m (gr a b) [Node]
-> GT m (gr a b) [Node]
forall (m :: * -> *) s a.
Monad m =>
(m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT m (gr a b) -> m Bool
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m Bool
isEmptyM ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return []) GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) [Node]
nodeGetter

nodeGetter :: (GraphM m gr) => GT m (gr a b) [Node]
nodeGetter :: GT m (gr a b) [Node]
nodeGetter = (Node -> [Node] -> [Node])
-> GT m (gr a b) Node
-> GT m (gr a b) [Node]
-> GT m (gr a b) [Node]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) GT m (gr a b) Node
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) Node
getNode GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) [Node]
getNodes

sucGT :: (GraphM m gr) => Node -> GT m (gr a b) (Maybe [Node])
sucGT :: Node -> GT m (gr a b) (Maybe [Node])
sucGT Node
v = (m (gr a b) -> m (Maybe [Node], gr a b))
-> GT m (gr a b) (Maybe [Node])
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m (gr a b)
mg->do (MContext a b
c,gr a b
g) <- Node -> m (gr a b) -> m (MContext a b, gr a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
Node -> m (gr a b) -> m (Decomp gr a b)
matchM Node
v m (gr a b)
mg
                       case MContext a b
c of
                         Just (Adj b
_,Node
_,a
_,Adj b
s) -> (Maybe [Node], gr a b) -> m (Maybe [Node], gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> Maybe [Node]
forall a. a -> Maybe a
Just (((b, Node) -> Node) -> Adj b -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (b, Node) -> Node
forall a b. (a, b) -> b
snd Adj b
s),gr a b
g)
                         MContext a b
Nothing        -> (Maybe [Node], gr a b) -> m (Maybe [Node], gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Node]
forall a. Maybe a
Nothing,gr a b
g)
              )

sucM :: (GraphM m gr) => Node -> m (gr a b) -> m (Maybe [Node])
sucM :: Node -> m (gr a b) -> m (Maybe [Node])
sucM Node
v = GT m (gr a b) (Maybe [Node]) -> m (gr a b) -> m (Maybe [Node])
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT (Node -> GT m (gr a b) (Maybe [Node])
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
Node -> GT m (gr a b) (Maybe [Node])
sucGT Node
v)



----------------------------------------------------------------------
-- some derived graph recursion operators
----------------------------------------------------------------------

--
-- graphRec :: GraphMonad a b c -> (c -> d -> d) -> d -> GraphMonad a b d
-- graphRec f g u = cond isEmpty (return u)
--                               (do x <- f
--                                   y <- graphRec f g u
--                                   return (g x y))

-- | encapsulates a simple recursion schema on graphs
graphRec :: (GraphM m gr) => GT m (gr a b) c ->
                           (c -> d -> d) -> d -> GT m (gr a b) d
graphRec :: GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
graphRec = (m (gr a b) -> m Bool)
-> GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
forall (m :: * -> *) s a b.
Monad m =>
(m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT m (gr a b) -> m Bool
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m Bool
isEmptyM

graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c ->
                           (c -> d -> d) -> d -> GT m (gr a b) d
graphRec' :: GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
graphRec' = (gr a b -> Bool)
-> GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
forall (m :: * -> *) s a b.
Monad m =>
(s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT' gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty

graphUFold :: (GraphM m gr) => (Context a b -> c -> c) -> c -> GT m (gr a b) c
graphUFold :: (Context a b -> c -> c) -> c -> GT m (gr a b) c
graphUFold = GT m (gr a b) (Context a b)
-> (Context a b -> c -> c) -> c -> GT m (gr a b) c
forall (m :: * -> *) (gr :: * -> * -> *) a b c d.
GraphM m gr =>
GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
graphRec GT m (gr a b) (Context a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) (Context a b)
getContext



----------------------------------------------------------------------
-- Examples: graph algorithms as instances of recursion operators
----------------------------------------------------------------------

-- instances of graphRec
--
graphNodesM0 :: (GraphM m gr) => GT m (gr a b) [Node]
graphNodesM0 :: GT m (gr a b) [Node]
graphNodesM0 = GT m (gr a b) Node
-> (Node -> [Node] -> [Node]) -> [Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b c d.
GraphM m gr =>
GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d
graphRec GT m (gr a b) Node
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) Node
getNode (:) []

graphNodesM :: (GraphM m gr) => GT m (gr a b) [Node]
graphNodesM :: GT m (gr a b) [Node]
graphNodesM = (Context a b -> [Node] -> [Node]) -> [Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b c.
GraphM m gr =>
(Context a b -> c -> c) -> c -> GT m (gr a b) c
graphUFold (\(Adj b
_,Node
v,a
_,Adj b
_)->(Node
vNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:)) []

graphNodes :: (GraphM m gr) => m (gr a b) -> m [Node]
graphNodes :: m (gr a b) -> m [Node]
graphNodes = GT m (gr a b) [Node] -> m (gr a b) -> m [Node]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
GT m (gr a b) [Node]
graphNodesM

graphFilterM :: (GraphM m gr) => (Context a b -> Bool) ->
                              GT m (gr a b) [Context a b]
graphFilterM :: (Context a b -> Bool) -> GT m (gr a b) [Context a b]
graphFilterM Context a b -> Bool
p = (Context a b -> [Context a b] -> [Context a b])
-> [Context a b] -> GT m (gr a b) [Context a b]
forall (m :: * -> *) (gr :: * -> * -> *) a b c.
GraphM m gr =>
(Context a b -> c -> c) -> c -> GT m (gr a b) c
graphUFold (\Context a b
c [Context a b]
cs->if Context a b -> Bool
p Context a b
c then Context a b
cContext a b -> [Context a b] -> [Context a b]
forall a. a -> [a] -> [a]
:[Context a b]
cs else [Context a b]
cs) []

graphFilter :: (GraphM m gr) => (Context a b -> Bool) -> m (gr a b) -> m [Context a b]
graphFilter :: (Context a b -> Bool) -> m (gr a b) -> m [Context a b]
graphFilter Context a b -> Bool
p = GT m (gr a b) [Context a b] -> m (gr a b) -> m [Context a b]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT ((Context a b -> Bool) -> GT m (gr a b) [Context a b]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
(Context a b -> Bool) -> GT m (gr a b) [Context a b]
graphFilterM Context a b -> Bool
p)




----------------------------------------------------------------------
-- Example: monadic dfs algorithm(s)
----------------------------------------------------------------------

-- | Monadic graph algorithms are defined in two steps:
--
--  (1) define the (possibly parameterized) graph transformer (e.g., dfsGT)
--  (2) run the graph transformer (applied to arguments) (e.g., dfsM)
--

dfsGT :: (GraphM m gr) => [Node] -> GT m (gr a b) [Node]
dfsGT :: [Node] -> GT m (gr a b) [Node]
dfsGT []     = [Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return []
dfsGT (Node
v:[Node]
vs) = (m (gr a b) -> m ([Node], gr a b)) -> GT m (gr a b) [Node]
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m (gr a b)
mg->
               do (MContext a b
mc,gr a b
g') <- Node -> m (gr a b) -> m (MContext a b, gr a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
Node -> m (gr a b) -> m (Decomp gr a b)
matchM Node
v m (gr a b)
mg
                  case MContext a b
mc of
                    Just (Adj b
_,Node
_,a
_,Adj b
s) -> ([Node] -> [Node])
-> GT m (gr a b) [Node] -> gr a b -> m ([Node], gr a b)
forall (m :: * -> *) a b g.
Monad m =>
(a -> b) -> GT m g a -> g -> m (b, g)
applyWith' (Node
vNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:) ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Node]
dfsGT (((b, Node) -> Node) -> Adj b -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (b, Node) -> Node
forall a b. (a, b) -> b
snd Adj b
s[Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++[Node]
vs)) gr a b
g'
                    MContext a b
Nothing        -> GT m (gr a b) [Node] -> gr a b -> m ([Node], gr a b)
forall (m :: * -> *) g a. Monad m => GT m g a -> g -> m (a, g)
apply' ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Node]
dfsGT [Node]
vs) gr a b
g'  )

-- | depth-first search yielding number of nodes
dfsM :: (GraphM m gr) => [Node] -> m (gr a b) -> m [Node]
dfsM :: [Node] -> m (gr a b) -> m [Node]
dfsM [Node]
vs = GT m (gr a b) [Node] -> m (gr a b) -> m [Node]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Node]
dfsGT [Node]
vs)

dfsM' :: (GraphM m gr) => m (gr a b) -> m [Node]
dfsM' :: m (gr a b) -> m [Node]
dfsM' m (gr a b)
mg = do {[Node]
vs <- m (gr a b) -> m [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m [Node]
nodesM m (gr a b)
mg; GT m (gr a b) [Node] -> m (gr a b) -> m [Node]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT ([Node] -> GT m (gr a b) [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Node]
dfsGT [Node]
vs) m (gr a b)
mg}


-- | depth-first search yielding dfs forest
dffM :: (GraphM m gr) => [Node] -> GT m (gr a b) [Tree Node]
dffM :: [Node] -> GT m (gr a b) [Tree Node]
dffM [Node]
vs = (m (gr a b) -> m ([Tree Node], gr a b))
-> GT m (gr a b) [Tree Node]
forall (m :: * -> *) g a. (m g -> m (a, g)) -> GT m g a
MGT (\m (gr a b)
mg->
          do gr a b
g<-m (gr a b)
mg
             Bool
b<-m (gr a b) -> m Bool
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m Bool
isEmptyM m (gr a b)
mg
             if Bool
bBool -> Bool -> Bool
||[Node] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
vs then ([Tree Node], gr a b) -> m ([Tree Node], gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],gr a b
g) else
                let (Node
v:[Node]
vs') = [Node]
vs in
                do (MContext a b
mc,gr a b
g1) <- Node -> m (gr a b) -> m (MContext a b, gr a b)
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
Node -> m (gr a b) -> m (Decomp gr a b)
matchM Node
v m (gr a b)
mg
                   case MContext a b
mc of
                     MContext a b
Nothing -> GT m (gr a b) [Tree Node] -> m (gr a b) -> m ([Tree Node], gr a b)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply ([Node] -> GT m (gr a b) [Tree Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Tree Node]
dffM [Node]
vs') (gr a b -> m (gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return gr a b
g1)
                     Just Context a b
c  -> do ([Tree Node]
ts, gr a b
g2) <- GT m (gr a b) [Tree Node] -> m (gr a b) -> m ([Tree Node], gr a b)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply ([Node] -> GT m (gr a b) [Tree Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Tree Node]
dffM (Context a b -> [Node]
forall a b. Context a b -> [Node]
suc' Context a b
c)) (gr a b -> m (gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return gr a b
g1)
                                   ([Tree Node]
ts',gr a b
g3) <- GT m (gr a b) [Tree Node] -> m (gr a b) -> m ([Tree Node], gr a b)
forall (m :: * -> *) g a. GT m g a -> m g -> m (a, g)
apply ([Node] -> GT m (gr a b) [Tree Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Tree Node]
dffM [Node]
vs') (gr a b -> m (gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return gr a b
g2)
                                   ([Tree Node], gr a b) -> m ([Tree Node], gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> [Tree Node] -> Tree Node
forall a. a -> Forest a -> Tree a
Node (Context a b -> Node
forall a b. Context a b -> Node
node' Context a b
c) [Tree Node]
tsTree Node -> [Tree Node] -> [Tree Node]
forall a. a -> [a] -> [a]
:[Tree Node]
ts',gr a b
g3)
          )

graphDff :: (GraphM m gr) => [Node] -> m (gr a b) -> m [Tree Node]
graphDff :: [Node] -> m (gr a b) -> m [Tree Node]
graphDff [Node]
vs = GT m (gr a b) [Tree Node] -> m (gr a b) -> m [Tree Node]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT ([Node] -> GT m (gr a b) [Tree Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Tree Node]
dffM [Node]
vs)

graphDff' :: (GraphM m gr) => m (gr a b) -> m [Tree Node]
graphDff' :: m (gr a b) -> m [Tree Node]
graphDff' m (gr a b)
mg = do {[Node]
vs <- m (gr a b) -> m [Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
m (gr a b) -> m [Node]
nodesM m (gr a b)
mg; GT m (gr a b) [Tree Node] -> m (gr a b) -> m [Tree Node]
forall (m :: * -> *) g a. Monad m => GT m g a -> m g -> m a
runGT ([Node] -> GT m (gr a b) [Tree Node]
forall (m :: * -> *) (gr :: * -> * -> *) a b.
GraphM m gr =>
[Node] -> GT m (gr a b) [Tree Node]
dffM [Node]
vs) m (gr a b)
mg}