-- | 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)