Internal.hs

module GraphRewriting.Pattern.Internal where

import Prelude.Unicode
import GraphRewriting.Graph.Types
import Control.Monad.Reader


newtype Pattern n a = Pattern {pattern ∷ Match → ReaderT (Graph n) [] (Match, a)}

type Match = [Node]

instance Monad (Pattern n) where
	return x = Pattern $ \m → return ([],x)
	p >>= f = Pattern $ \m → do
		(m1,x) ← pattern p m
		(m2,y) ← pattern (f x) (m1 ⧺ m)
		return (m1 ⧺ m2, y)
	fail str = Pattern $ \m → lift []

instance MonadPlus (Pattern n) where
	mzero = fail "empty result list"
	mplus p q = Pattern $ \m → do
		g ← ask
		lift $ runReaderT (pattern p m) g ⧺ runReaderT (pattern q m) g

liftList ∷ Reader (Graph n) [a] → Pattern n a
liftList r = Pattern $ \m → do
	xs ← liftM (runReader r) ask
	lift [([],x) | x ← xs]

liftMatches ∷ Reader (Graph n) [Node] → Pattern n Node
liftMatches r = Pattern $ \m → do
	ns ← liftM (runReader r) ask
	lift [([n],n) | n ← ns]