module GraphRewriting.Pattern (module GraphRewriting.Pattern, Pattern, Match) where
import Prelude.Unicode
import GraphRewriting.Pattern.Internal
import GraphRewriting.Graph.Read
import Control.Monad.Reader
import Data.List (nub)
runPattern ∷ Pattern n a → Graph n → [(Match,a)]
runPattern p = runReaderT $ pattern p []
evalPattern ∷ Pattern n a → Graph n → [a]
evalPattern p = map snd . runPattern p
execPattern ∷ Pattern n a → Graph n → [Match]
execPattern p = map fst . runPattern p
matches ∷ Pattern n a → Pattern n [Match]
matches p = Pattern $ \m → do
lma ← liftM (runReaderT $ pattern p m) ask
return ([], map fst lma)
(<|>) ∷ Pattern n a → Pattern n a → Pattern n a
(<|>) = mplus
anyOf ∷ [Pattern n a] → Pattern n a
anyOf [] = fail "anyOf []"
anyOf xs = foldr1 (<|>) xs
require ∷ Monad m ⇒ Bool → m ()
require p = unless p $ fail "requirement not met"
requireM ∷ Monad m ⇒ m Bool → m ()
requireM p = p >>= require
liftReader ∷ Reader (Graph n) a → Pattern n a
liftReader r = Pattern $ \m → do
x ← liftM (runReader r) ask
return ([],x)
node ∷ View v n ⇒ Pattern n v
node = liftReader . inspectNode =<< liftMatches readNodeList
previous ∷ Pattern n Node
previous = liftM head history
edge ∷ Pattern n Edge
edge = liftList readEdgeList
nodeAt ∷ View v n ⇒ Edge → Pattern n v
nodeAt e = liftReader . inspectNode =<< liftMatches (attachedNodes e)
edgeOf ∷ View [Port] n ⇒ Node → Pattern n Edge
edgeOf = liftList . attachedEdges
neighbour ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v
neighbour n = liftReader . inspectNode =<< liftMatches (neighbours n)
relative ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v
relative n = liftReader . inspectNode =<< liftMatches (relatives n)
adverse ∷ (View [Port] n, View v n) ⇒ Port → Node → Pattern n v
adverse p n = liftReader . inspectNode =<< liftMatches (adverseNodes n p)
history ∷ Pattern n Match
history = Pattern $ \m → return ([],m)
nextFresh ∷ Pattern n a → Pattern n a
nextFresh = restrictOverlap $ \hist (n:ns) → not (n ∈ hist)
nextIs ∷ Node → Pattern n a → Pattern n a
nextIs next = restrictOverlap $ \hist (n:ns) → n ≡ next
restrictOverlap ∷ (Match → Match → Bool) → Pattern n a → Pattern n a
restrictOverlap c p = Pattern $ \m → do
(m',x) ← pattern p m
if c m m' then return (m',x) else fail "requirement on history not met"
linear ∷ Pattern n a → Pattern n a
linear = restrictOverlap $ \hist future → length future ≡ length (nub future)