{-# LANGUAGE CPP, TypeFamilies #-}
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
data GraphSearch g m = GraphSearch
{ GraphSearch g m -> Vertex g -> g m
enterVertex :: Vertex g -> g m
, GraphSearch g m -> Edge g -> g m
enterEdge :: Edge g -> g m
, GraphSearch g m -> Edge g -> g m
grayTarget :: Edge g -> g m
, GraphSearch g m -> Vertex g -> g m
exitVertex :: Vertex g -> g m
, GraphSearch g m -> Edge g -> g m
blackTarget :: Edge g -> g m
}
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