{-# LANGUAGE CPP, TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Graph.Algorithm
-- Copyright   :  (C) 2011 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  type families
--
-- Functions and data structures common to graph search algorithms
----------------------------------------------------------------------------

module Data.Graph.Algorithm
  ( GraphSearch(..)
  ) where

import Control.Monad
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

import Data.Graph.Class

-- | Graph search visitor
data GraphSearch g m = GraphSearch
  { GraphSearch g m -> Vertex g -> g m
enterVertex :: Vertex g -> g m -- ^ Called the first time a vertex is discovered
  , GraphSearch g m -> Edge g -> g m
enterEdge   :: Edge g   -> g m -- ^ Called the first time an edge is discovered, before enterVertex
  , GraphSearch g m -> Edge g -> g m
grayTarget  :: Edge g   -> g m -- ^ Called when we encounter a back edge to a vertex we're still processing
  , GraphSearch g m -> Vertex g -> g m
exitVertex  :: Vertex g -> g m -- ^ Called once we have processed all descendants of a vertex
  , GraphSearch g m -> Edge g -> g m
blackTarget :: Edge g   -> g m -- ^ Called when we encounter a cross edge to a vertex we've already finished
  }

instance Graph g => Functor (GraphSearch g) where
  fmap :: (a -> b) -> GraphSearch g a -> GraphSearch g b
fmap a -> b
f (GraphSearch Vertex g -> g a
a Edge g -> g a
b Edge g -> g a
c Vertex g -> g a
d Edge g -> g a
e) = (Vertex g -> g b)
-> (Edge g -> g b)
-> (Edge g -> g b)
-> (Vertex g -> g b)
-> (Edge g -> g b)
-> GraphSearch g b
forall (g :: * -> *) m.
(Vertex g -> g m)
-> (Edge g -> g m)
-> (Edge g -> g m)
-> (Vertex g -> g m)
-> (Edge g -> g m)
-> GraphSearch g m
GraphSearch
    ((a -> b) -> g a -> g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f (g a -> g b) -> (Vertex g -> g a) -> Vertex g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g a
a)
    ((a -> b) -> g a -> g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f (g a -> g b) -> (Edge g -> g a) -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge g -> g a
b)
    ((a -> b) -> g a -> g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f (g a -> g b) -> (Edge g -> g a) -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge g -> g a
c)
    ((a -> b) -> g a -> g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f (g a -> g b) -> (Vertex g -> g a) -> Vertex g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g a
d)
    ((a -> b) -> g a -> g b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f (g a -> g b) -> (Edge g -> g a) -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge g -> g a
e)

instance Graph g => Applicative (GraphSearch g) where
  pure :: a -> GraphSearch g a
pure a
a = (Vertex g -> g a)
-> (Edge g -> g a)
-> (Edge g -> g a)
-> (Vertex g -> g a)
-> (Edge g -> g a)
-> GraphSearch g a
forall (g :: * -> *) m.
(Vertex g -> g m)
-> (Edge g -> g m)
-> (Edge g -> g m)
-> (Vertex g -> g m)
-> (Edge g -> g m)
-> GraphSearch g m
GraphSearch
    (g a -> Vertex g -> g a
forall a b. a -> b -> a
const (a -> g a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
    (g a -> Edge g -> g a
forall a b. a -> b -> a
const (a -> g a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
    (g a -> Edge g -> g a
forall a b. a -> b -> a
const (a -> g a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
    (g a -> Vertex g -> g a
forall a b. a -> b -> a
const (a -> g a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
    (g a -> Edge g -> g a
forall a b. a -> b -> a
const (a -> g a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))

  GraphSearch g (a -> b)
m <*> :: GraphSearch g (a -> b) -> GraphSearch g a -> GraphSearch g b
<*> GraphSearch g a
n = (Vertex g -> g b)
-> (Edge g -> g b)
-> (Edge g -> g b)
-> (Vertex g -> g b)
-> (Edge g -> g b)
-> GraphSearch g b
forall (g :: * -> *) m.
(Vertex g -> g m)
-> (Edge g -> g m)
-> (Edge g -> g m)
-> (Vertex g -> g m)
-> (Edge g -> g m)
-> GraphSearch g m
GraphSearch
    (\Vertex g
v -> GraphSearch g (a -> b) -> Vertex g -> g (a -> b)
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
enterVertex GraphSearch g (a -> b)
m Vertex g
v g (a -> b) -> g a -> g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` GraphSearch g a -> Vertex g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
enterVertex GraphSearch g a
n Vertex g
v)
    (\Edge g
e -> GraphSearch g (a -> b) -> Edge g -> g (a -> b)
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
enterEdge GraphSearch g (a -> b)
m Edge g
e g (a -> b) -> g a -> g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`   GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
enterEdge GraphSearch g a
n Edge g
e)
    (\Edge g
e -> GraphSearch g (a -> b) -> Edge g -> g (a -> b)
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
grayTarget GraphSearch g (a -> b)
m Edge g
e g (a -> b) -> g a -> g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`  GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
grayTarget GraphSearch g a
n Edge g
e)
    (\Vertex g
v -> GraphSearch g (a -> b) -> Vertex g -> g (a -> b)
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
exitVertex GraphSearch g (a -> b)
m Vertex g
v g (a -> b) -> g a -> g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`  GraphSearch g a -> Vertex g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
exitVertex GraphSearch g a
n Vertex g
v)
    (\Edge g
e -> GraphSearch g (a -> b) -> Edge g -> g (a -> b)
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
blackTarget GraphSearch g (a -> b)
m Edge g
e g (a -> b) -> g a -> g b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
blackTarget GraphSearch g a
n Edge g
e)

instance Graph g => Monad (GraphSearch g) where
  return :: a -> GraphSearch g a
return = a -> GraphSearch g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  GraphSearch g a
m >>= :: GraphSearch g a -> (a -> GraphSearch g b) -> GraphSearch g b
>>= a -> GraphSearch g b
f = (Vertex g -> g b)
-> (Edge g -> g b)
-> (Edge g -> g b)
-> (Vertex g -> g b)
-> (Edge g -> g b)
-> GraphSearch g b
forall (g :: * -> *) m.
(Vertex g -> g m)
-> (Edge g -> g m)
-> (Edge g -> g m)
-> (Vertex g -> g m)
-> (Edge g -> g m)
-> GraphSearch g m
GraphSearch
    (\Vertex g
v -> GraphSearch g a -> Vertex g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
enterVertex GraphSearch g a
m Vertex g
v g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Vertex g -> g b) -> Vertex g -> g b
forall a b. (a -> b) -> a -> b
$ Vertex g
v) ((Vertex g -> g b) -> g b) -> (a -> Vertex g -> g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphSearch g b -> Vertex g -> g b
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
enterVertex (GraphSearch g b -> Vertex g -> g b)
-> (a -> GraphSearch g b) -> a -> Vertex g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GraphSearch g b
f)
    (\Edge g
e -> GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
enterEdge GraphSearch g a
m Edge g
e g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Edge g -> g b) -> Edge g -> g b
forall a b. (a -> b) -> a -> b
$ Edge g
e)   ((Edge g -> g b) -> g b) -> (a -> Edge g -> g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphSearch g b -> Edge g -> g b
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
enterEdge (GraphSearch g b -> Edge g -> g b)
-> (a -> GraphSearch g b) -> a -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GraphSearch g b
f)
    (\Edge g
e -> GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
grayTarget GraphSearch g a
m Edge g
e g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Edge g -> g b) -> Edge g -> g b
forall a b. (a -> b) -> a -> b
$ Edge g
e)  ((Edge g -> g b) -> g b) -> (a -> Edge g -> g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphSearch g b -> Edge g -> g b
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
grayTarget (GraphSearch g b -> Edge g -> g b)
-> (a -> GraphSearch g b) -> a -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GraphSearch g b
f)
    (\Vertex g
v -> GraphSearch g a -> Vertex g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
exitVertex GraphSearch g a
m Vertex g
v g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Vertex g -> g b) -> Vertex g -> g b
forall a b. (a -> b) -> a -> b
$ Vertex g
v)  ((Vertex g -> g b) -> g b) -> (a -> Vertex g -> g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphSearch g b -> Vertex g -> g b
forall (g :: * -> *) m. GraphSearch g m -> Vertex g -> g m
exitVertex (GraphSearch g b -> Vertex g -> g b)
-> (a -> GraphSearch g b) -> a -> Vertex g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GraphSearch g b
f)
    (\Edge g
e -> GraphSearch g a -> Edge g -> g a
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
blackTarget GraphSearch g a
m Edge g
e g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Edge g -> g b) -> Edge g -> g b
forall a b. (a -> b) -> a -> b
$ Edge g
e) ((Edge g -> g b) -> g b) -> (a -> Edge g -> g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphSearch g b -> Edge g -> g b
forall (g :: * -> *) m. GraphSearch g m -> Edge g -> g m
blackTarget (GraphSearch g b -> Edge g -> g b)
-> (a -> GraphSearch g b) -> a -> Edge g -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GraphSearch g b
f)

instance (Graph g, Semigroup m) => Semigroup (GraphSearch g m) where
  <> :: GraphSearch g m -> GraphSearch g m -> GraphSearch g m
(<>) = (m -> m -> m)
-> GraphSearch g m -> GraphSearch g m -> GraphSearch g m
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>)

instance (Graph g, Monoid m) => Monoid (GraphSearch g m) where
  mempty :: GraphSearch g m
mempty = m -> GraphSearch g m
forall (m :: * -> *) a. Monad m => a -> m a
return m
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
  mappend = liftM2 mappend
#endif