-
Notifications
You must be signed in to change notification settings - Fork 0
/
ImpGraph.hs
67 lines (58 loc) · 1.7 KB
/
ImpGraph.hs
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
{-# LANGUAGE NamedFieldPuns #-}
module ImpGraph where
import Control.Monad (unless, when)
import Control.Monad.ST (ST, runST)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Map
import Data.STRef (STRef, modifySTRef, newSTRef, readSTRef)
import Text.Printf (printf)
type Label = String
data Node a = Node
{ nodeLabel :: Label
, nodeContent :: a
, isVisited :: Bool
}
data Edge b = Edge
{ edgeLabel :: Label
, edgeContent :: b
}
deriving (Show)
-- data Tree s a b = Tree (Node s a) [(Edge b, Label)]
-- newtype Graph s a b = Graph (Map Label (Tree s a b))
-- data Tree a b = Tree
newtype Graph a b
= Graph
[ ( IORef (Node a)
, [(Edge b, IORef (Node a))]
)
]
buildGraph :: IO (Graph [Char] b)
buildGraph = do
nodeA <- newIORef $ Node{nodeLabel = "A", nodeContent = "A", isVisited = False}
nodeB <- newIORef $ Node{nodeLabel = "B", nodeContent = "B", isVisited = False}
return $
Graph
[
( nodeA
, [(undefined, nodeB)]
)
,
( nodeB
, [(undefined, nodeA)]
)
]
dfs :: Graph String b -> IO ()
dfs (Graph []) = return ()
dfs (Graph ((node, links) : xs)) = do
Node{nodeLabel, nodeContent, isVisited} <- readIORef node
unless isVisited $ do
printf "nodeLabel: %s\tnodeContent: %s\n" nodeLabel nodeContent
writeIORef node (Node{nodeLabel, nodeContent, isVisited = True})
case links of
(_, successor) : ys -> do
dfs $ Graph $ (successor, ys) : xs
[] -> do
dfs $ Graph xs
return ()
main :: IO ()
main = buildGraph >>= dfs