Internal.hs

{-# LANGUAGE UnicodeSyntax, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module GraphRewriting.Graph.Internal where

import Control.Monad.State
import Data.IntMap as Map (IntMap, lookup)
import Data.IntSet (IntSet)
import Control.Monad.Reader.Class


-- | Hypergraph that holds nodes of type @n@. Nodes can be referenced by type 'Node', edges by type 'Edge', see "GraphRewriting.Graph.Read" and "GraphRewriting.Graph.Write"
data Graph n = Graph {nodeMap ∷ IntMap n, edgeMap ∷ IntMap IntSet, nextKey ∷ Int}

type Rewrite n = State (Graph n)

newtype Node = Node {nKey ∷ Int} deriving (Eq, Ord)
newtype Port = Edge {eKey ∷ Int} deriving (Eq, Ord)
type Edge = Port -- ^ a hyperedge really, connecting a non-empty subset of the graph's nodes (see 'attachedNodes')

instance Show Node where show = show . nKey
instance Show Edge where show = show . eKey

instance MonadReader s (State s) where
	ask = get
	local mod reader = liftM (evalState reader . mod) ask

readRef ∷ Monad m ⇒ Int → IntMap a → m a
readRef key = maybe (fail "readRef: referentiation failed") return . Map.lookup key

readEdge ∷ MonadReader (Graph n) r ⇒ Edge → r IntSet
readEdge (Edge p) = readRef p =<< asks edgeMap

modifyNodeMap ∷ (IntMap n → IntMap n) → Rewrite n ()
modifyNodeMap f = modify $ \g → g {nodeMap = f $ nodeMap g}

modifyEdgeMap ∷ (IntMap IntSet → IntMap IntSet) → Rewrite n ()
modifyEdgeMap f = modify $ \g → g {edgeMap = f $ edgeMap g}

newRef ∷ Rewrite n Int
newRef = do
	i ← gets nextKey
	modify $ \g → g {nextKey = i + 1}
	return i