git.iko.soy/hakyll
on 5cc710d help sign in
hakyll/src/Hakyll/Core/DirectedGraph/Internal.hs
52 lines 1.7 kB history raw
1-- | Internal structure of the DirectedGraph type. Not exported outside of the
2-- library.
3--
4{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
5module Hakyll.Core.DirectedGraph.Internal
6 ( Node (..)
7 , DirectedGraph (..)
8 ) where
10import Prelude hiding (reverse, filter)
11import Control.Applicative ((<$>), (<*>))
12import Data.Monoid (Monoid, mempty, mappend)
13import Data.Set (Set)
14import Data.Map (Map)
15import qualified Data.Map as M
16import qualified Data.Set as S
18import Data.Binary (Binary, put, get)
19import Data.Typeable (Typeable)
21-- | A node in the directed graph
22--
23data Node a = Node
24 { nodeTag :: a -- ^ Tag identifying the node
25 , nodeNeighbours :: Set a -- ^ Edges starting at this node
26 } deriving (Show, Typeable)
28instance (Binary a, Ord a) => Binary (Node a) where
29 put (Node t n) = put t >> put n
30 get = Node <$> get <*> get
32-- | Append two nodes. Useful for joining graphs.
33--
34appendNodes :: Ord a => Node a -> Node a -> Node a
35appendNodes (Node t1 n1) (Node t2 n2)
36 | t1 /= t2 = error'
37 | otherwise = Node t1 (n1 `S.union` n2)
38 where
39 error' = error $ "Hakyll.Core.DirectedGraph.Internal.appendNodes: "
40 ++ "Appending differently tagged nodes"
42-- | Type used to represent a directed graph
43--
44newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}
45 deriving (Show, Binary, Typeable)
47-- | Allow users to concatenate different graphs
48--
49instance Ord a => Monoid (DirectedGraph a) where
50 mempty = DirectedGraph M.empty
51 mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $
52 M.unionWith appendNodes m1 m2