graph-rewriting-0.4.8: GraphRewriting/Pattern.hs

-- | Patterns allow monadic scrutinisation of the graph (modifications are not possible) while keeping track of matched nodes. A 'Pattern' is interpreted by 'runPattern' that returns a result for each position in the graph where the pattern matches. It is allowed to 'fail' inside the 'Pattern' monad, indicating that the pattern does not match, which corresponds to conditional rewriting.
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)


-- | Apply a pattern on a graph returning a result for each matching position in the graph together with the matched nodes.
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

-- combinators ---------------------------------------------------------------

-- | probe a pattern returning the matches it has on the graph
matches ∷ Pattern n a → Pattern n [Match]
matches p = Pattern $ \m → do
	lma ← liftM (runReaderT $ pattern p m) ask
	return ([], map fst lma)

-- | choice
(<|>) ∷ Pattern n a → Pattern n a → Pattern n a
(<|>) = mplus

-- | choice over a list of patterns
anyOf ∷ [Pattern n a] → Pattern n a
anyOf [] = fail "anyOf []"
anyOf xs = foldr1 (<|>) xs

-- | 'fail' if given pattern succeeds, succeed if it fails.
--requireFailure ∷ Pattern n a → Pattern n ()
--requireFailure p = require . not =<< probe p

-- TODO: Control.Monad.guard
-- | conditional rewriting: 'fail' when predicate is not met
require ∷ Monad m ⇒ Bool → m ()
require p = unless p $ fail "requirement not met"

-- | 'fail' when monadic predicate is not met
requireM ∷ Monad m ⇒ m Bool → m ()
requireM p = p >>= require

-- inspections that yield a list packed into a pattern match -----------------

-- | Lift a scrutinisation from 'Reader' to 'Pattern'. Attention: This does not contribute to returned 'Match'.
liftReader ∷ Reader (Graph n) a → Pattern n a
liftReader r = Pattern $ \m → do
	x ← liftM (runReader r) ask
	return ([],x)

-- | any node anywhere in the graph
node ∷ View v n ⇒ Pattern n v
node = liftReader . inspectNode =<< liftMatches readNodeList

-- | a reference to the lastly matched node
previous ∷ Pattern n Node
previous = liftM head history

-- | any edge anywhere in the graph
edge ∷ Pattern n Edge
edge = liftList readEdgeList

-- | node that is connected to given edge
nodeAt ∷ View v n ⇒ Edge → Pattern n v
nodeAt e = liftReader . inspectNode =<< liftMatches (attachedNodes e)

-- | edge that is attached to given node
edgeOf ∷ View [Port] n ⇒ Node → Pattern n Edge
edgeOf = liftList . attachedEdges

-- | node that is connected to the given node, but not that node itself
neighbour ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v
neighbour n = liftReader . inspectNode =<< liftMatches (neighbours n)

-- | node that is connected to the given node, permitting the node itself
relative ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v
relative n = liftReader . inspectNode =<< liftMatches (relatives n)

-- | nodes connected to given port of the specified node, not including the node itself
adverse ∷ (View [Port] n, View v n) ⇒ Port → Node → Pattern n v
adverse p n = liftReader . inspectNode =<< liftMatches (adverseNodes n p)

-- controlling history and future --------------------------------------------

-- | list of nodes matched until now with the most recent node in head position
history ∷ Pattern n Match
history = Pattern $ \m → return ([],m)

-- | only match nodes in the next node pattern that have not been matched before
nextFresh ∷ Pattern n a → Pattern n a
nextFresh = restrictOverlap $ \hist (n:ns) → not (n ∈ hist)

-- | only accept the given node in the next match
nextIs ∷ Node → Pattern n a → Pattern n a
nextIs next = restrictOverlap $ \hist (n:ns) → n ≡ next

-- | First match is the history with the most recently matched node in head position. Second match is the future with the next matched node in head position.
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"

-- | Nodes in the future may not be matched more than once.
linear ∷ Pattern n a → Pattern n a
linear = restrictOverlap $ \hist future → length future ≡ length (nub future)