module Hakyll.Core.DirectedGraph.Internal
( Node (..)
, DirectedGraph (..)
) where
import Prelude hiding (reverse, filter)
import Control.Applicative ((<$>), (<*>))
import Data.Monoid (Monoid, mempty, mappend)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Binary (Binary, put, get)
import Data.Typeable (Typeable)
data Node a = Node
{ nodeTag :: a
, nodeNeighbours :: Set a
} deriving (Show, Typeable)
instance (Binary a, Ord a) => Binary (Node a) where
put (Node t n) = put t >> put n
get = Node <$> get <*> get
appendNodes :: Ord a => Node a -> Node a -> Node a
appendNodes (Node t1 n1) (Node t2 n2)
| t1 /= t2 = error'
| otherwise = Node t1 (n1 `S.union` n2)
where
error' = error $ "Hakyll.Core.DirectedGraph.Internal.appendNodes: "
++ "Appending differently tagged nodes"
newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}
deriving (Show, Binary, Typeable)
instance Ord a => Monoid (DirectedGraph a) where
mempty = DirectedGraph M.empty
mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $
M.unionWith appendNodes m1 m2