module GraphRewriting.Graph.Internal where
import Prelude.Unicode
import Control.Monad.State
import Data.IntMap as Map (IntMap, lookup)
import Data.IntSet (IntSet)
import Control.Monad.Reader
data Graph n = Graph {nodeMap ∷ IntMap n, edgeMap ∷ IntMap IntSet, nextKey ∷ Int}
newtype Rewrite n a = Rewrite {rewrite ∷ State (Graph n) a}
deriving (MonadState (Graph n), Monad, Functor, MonadFix)
newtype Node = Node {nKey ∷ Int} deriving (Eq, Ord)
newtype Port = Edge {eKey ∷ Int} deriving (Eq, Ord)
type Edge = Port
instance Show Node where show = show . nKey
instance Show Edge where show = show . eKey
instance MonadReader (Graph n) (Rewrite n) where
ask = Rewrite get
local f m = Rewrite $ liftM (evalState (rewrite m) . f) get
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 e) = maybe (fail $ "readEdge: edge with ID " ⧺ show e ⧺ " does not exist") return . readRef e =<< 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
freeRefs ∷ MonadReader (Graph n) r ⇒ r [Int]
freeRefs = enumFrom `liftM` asks nextKey
reserveRefs ∷ [Int] → Rewrite n ()
reserveRefs refs = modify $ \g → g {nextKey = maximum refs}