/usr/lib/hugs/packages/fgl/Data/Graph/Inductive/Query/Monad.hs is in libhugs-fgl-bundled 98.200609.21-5.3ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | -- (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 Data.Tree
--import Control.Monad (liftM)
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Monad
-- some additional (graph) utilities
--
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f (x,y) = (f x,y)
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd f (x,y) = (x,f y)
infixr 8 ><
(><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
(f >< g) (x,y) = (f x,g y)
orP :: (a -> Bool) -> (b -> Bool) -> (a,b) -> Bool
orP p q (x,y) = p x || q y
----------------------------------------------------------------------
-- "wrapped" state transformer monad ==
-- monadic graph transformer monad
----------------------------------------------------------------------
data GT m g a = MGT (m g -> m (a,g))
apply :: GT m g a -> m g -> m (a,g)
apply (MGT f) mg = f mg
apply' :: Monad m => GT m g a -> g -> m (a,g)
apply' gt = apply gt . return
applyWith :: Monad m => (a -> b) -> GT m g a -> m g -> m (b,g)
applyWith h (MGT f) gm = do {(x,g) <- f gm; return (h x,g)}
applyWith' :: Monad m => (a -> b) -> GT m g a -> g -> m (b,g)
applyWith' h gt = applyWith h gt . return
runGT :: Monad m => GT m g a -> m g -> m a
runGT gt mg = do {(x,_) <- apply gt mg; return x}
instance Monad m => Monad (GT m g) where
return x = MGT (\mg->do {g<-mg; return (x,g)})
f >>= h = MGT (\mg->do {(x,g)<-apply f mg; apply' (h x) g})
condMGT' :: Monad m => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT' p f g = MGT (\mg->do {h<-mg; if p h then apply f mg else apply g mg})
recMGT' :: Monad m => (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT' p mg f u = condMGT' p (return u)
(do {x<-mg;y<-recMGT' p mg f u;return (f x y)})
condMGT :: Monad m => (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a
condMGT p f g = MGT (\mg->do {b<-p mg; if b then apply f mg else apply g mg})
recMGT :: Monad m => (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b
recMGT p mg f u = condMGT p (return u)
(do {x<-mg;y<-recMGT p mg f u;return (f x 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 = MGT (\mg->do {((_,v,_,_),g) <- matchAnyM mg; return (v,g)})
getContext :: GraphM m gr => GT m (gr a b) (Context a b)
getContext = MGT 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' = condMGT' isEmpty (return [])
(do v <- getNode
vs <- getNodes
return (v:vs))
getNodes :: GraphM m gr => GT m (gr a b) [Node]
getNodes = condMGT isEmptyM (return [])
(do v <- getNode
vs <- getNodes
return (v:vs))
sucGT :: GraphM m gr => Node -> GT m (gr a b) (Maybe [Node])
sucGT v = MGT (\mg->do (c,g) <- matchM v mg
case c of
Just (_,_,_,s) -> return (Just (map snd s),g)
Nothing -> return (Nothing,g)
)
sucM :: GraphM m gr => Node -> m (gr a b) -> m (Maybe [Node])
sucM v = runGT (sucGT 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 = recMGT isEmptyM
graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c ->
(c -> d -> d) -> d -> GT m (gr a b) d
graphRec' = recMGT' isEmpty
graphUFold :: GraphM m gr => (Context a b -> c -> c) -> c -> GT m (gr a b) c
graphUFold = graphRec getContext
----------------------------------------------------------------------
-- Examples: graph algorithms as instances of recursion operators
----------------------------------------------------------------------
-- instances of graphRec
--
graphNodesM0 :: GraphM m gr => GT m (gr a b) [Node]
graphNodesM0 = graphRec getNode (:) []
graphNodesM :: GraphM m gr => GT m (gr a b) [Node]
graphNodesM = graphUFold (\(_,v,_,_)->(v:)) []
graphNodes :: GraphM m gr => m (gr a b) -> m [Node]
graphNodes = runGT graphNodesM
graphFilterM :: GraphM m gr => (Context a b -> Bool) ->
GT m (gr a b) [Context a b]
graphFilterM p = graphUFold (\c cs->if p c then c:cs else cs) []
graphFilter :: GraphM m gr => (Context a b -> Bool) -> m (gr a b) -> m [Context a b]
graphFilter p = runGT (graphFilterM 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 [] = return []
dfsGT (v:vs) = MGT (\mg->
do (mc,g') <- matchM v mg
case mc of
Just (_,_,_,s) -> applyWith' (v:) (dfsGT (map snd s++vs)) g'
Nothing -> apply' (dfsGT vs) g' )
-- | depth-first search yielding number of nodes
dfsM :: GraphM m gr => [Node] -> m (gr a b) -> m [Node]
dfsM vs = runGT (dfsGT vs)
dfsM' :: GraphM m gr => m (gr a b) -> m [Node]
dfsM' mg = do {vs <- nodesM mg; runGT (dfsGT vs) mg}
-- | depth-first search yielding dfs forest
dffM :: GraphM m gr => [Node] -> GT m (gr a b) [Tree Node]
dffM vs = MGT (\mg->
do g<-mg
b<-isEmptyM mg
if b||null vs then return ([],g) else
let (v:vs') = vs in
do (mc,g1) <- matchM v mg
case mc of
Nothing -> apply (dffM vs') (return g1)
Just c -> do (ts, g2) <- apply (dffM (suc' c)) (return g1)
(ts',g3) <- apply (dffM vs') (return g2)
return (Node (node' c) ts:ts',g3)
)
graphDff :: GraphM m gr => [Node] -> m (gr a b) -> m [Tree Node]
graphDff vs = runGT (dffM vs)
graphDff' :: GraphM m gr => m (gr a b) -> m [Tree Node]
graphDff' mg = do {vs <- nodesM mg; runGT (dffM vs) mg}
|