blob: bc2a2340bb2dc3b1e833ff02f0d3041e41d149a9 (
plain)
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
|
--------------------------------------------------------------------------------
-- | Representation of a directed graph. In Hakyll, this is used for dependency
-- tracking.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.DirectedGraph
( DirectedGraph
, fromList
, toList
, member
, nodes
, neighbours
) where
--------------------------------------------------------------------------------
import Control.Arrow (second)
import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid (..))
import Data.Set (Set)
import qualified Data.Set as S
import Data.Typeable (Typeable)
import Prelude hiding (reverse)
--------------------------------------------------------------------------------
-- | Type used to represent a directed graph
newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a [a]}
deriving (Show, Binary, NFData, Typeable)
--------------------------------------------------------------------------------
-- | Allow users to concatenate different graphs
instance Ord a => Monoid (DirectedGraph a) where
mempty = DirectedGraph M.empty
mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $
M.unionWith (\x y -> sortUnique (x ++ y)) m1 m2
--------------------------------------------------------------------------------
-- | Construction of directed graphs
fromList :: Ord a
=> [(a, [a])] -- ^ List of (node, reachable neighbours)
-> DirectedGraph a -- ^ Resulting directed graph
fromList = DirectedGraph . M.fromList . map (second sortUnique)
--------------------------------------------------------------------------------
-- | Deconstruction of directed graphs
toList :: DirectedGraph a
-> [(a, [a])]
toList = M.toList . unDirectedGraph
--------------------------------------------------------------------------------
-- | Check if a node lies in the given graph
member :: Ord a
=> a -- ^ Node to check for
-> DirectedGraph a -- ^ Directed graph to check in
-> Bool -- ^ If the node lies in the graph
member n = M.member n . unDirectedGraph
--------------------------------------------------------------------------------
-- | Get all nodes in the graph
nodes :: Ord a
=> DirectedGraph a -- ^ Graph to get the nodes from
-> Set a -- ^ All nodes in the graph
nodes = M.keysSet . unDirectedGraph
--------------------------------------------------------------------------------
-- | Get a set of reachable neighbours from a directed graph
neighbours :: Ord a
=> a -- ^ Node to get the neighbours of
-> DirectedGraph a -- ^ Graph to search in
-> [a] -- ^ Set containing the neighbours
neighbours x dg = fromMaybe [] $ M.lookup x $ unDirectedGraph dg
--------------------------------------------------------------------------------
-- | Sort and make unique
sortUnique :: Ord a => [a] -> [a]
sortUnique = S.toAscList . S.fromList
|
