Meta.hs

{-
	Copyright (C) 2010 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Describes the set of polymorphic data, which can be matched.

	* Only permits a match against exactly one polymorphic datum, which distinguishes it from a /zero-width assertion/, like an /anchor/, /word-boundary/, or /look-ahead assertion/.

	* Designed to be used by a polymorphic /regex/-engine, to implement the traditional meta-characters; @. [] [^]@.

	* Permits /Perl-style shortcuts/ for commonly used 'Meta'-data, to be canned & assigned a single-'Char' mnemonic for subsequent reference;
	the implementation of 'Read' looks for a back-slashed 'Char', for which it expects there to be a corresponding canned 'Meta'.
	Since this class is polymorphic, it has no knowledge of what shortcuts might be appropriate for the chosen type-parameter,
	so the expansion from the back-slashed 'Char' to corresponding 'Meta'-data, is performed through the 'expand' interface of the 'ShortcutExpander' class, which should be implemented elsewhere.
-}

module RegExDot.Meta(
-- * Type-classes
	ShortcutExpander(..),
-- * Types
-- ** Data-types
	Meta(..),
-- * Constants
	shortcutToken,
	anyToken,
	tokens,
-- * Functions
-- ** Predicates
	isMatch
) where

import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	RegExDot.BracketExpression		as BracketExpression
import qualified	RegExDot.BracketExpressionMember	as BracketExpressionMember
import qualified	RegExDot.Consumer			as Consumer
import qualified	RegExDot.ConsumptionProfile		as ConsumptionProfile
import qualified	RegExDot.ShowablePredicate		as ShowablePredicate
import qualified	ToolShed.SelfValidate

{- |
	* The interface via which /Perl-style shortcut/s are expanded, in a manner appropriate to the chosen type-parameter.

	* Since the expansion of /Perl-style shortcut/s, is more restricted inside than outside a 'BracketExpression.BracketExpression',
	the former is considered to be a superclass, providing a base from which to build alternative implementations.
-}
class BracketExpressionMember.ShortcutExpander m => ShortcutExpander m	where
	expand	:: Char -> Meta m	-- ^ Expand a /Perl-style shortcut/.

-- | Declares a polymorphic data-type.
data Meta m =
	Any							-- ^ Any datum matches. Equivalent to @NoneOf []@, but more efficient. CAVEAT: independent of the type-parameter @a@.
	| Literal m						-- ^ The datum matches, if it's equal to the specified value. Equivalent to @AnyOf [BracketExpression.Literal x]@, but more efficient.
	| AnyOf (BracketExpression.BracketExpression m)		-- ^ The datum matches, if 'BracketExpression.containsMatch'.
	| NoneOf (BracketExpression.BracketExpression m)	-- ^ The datum matches, if @not BracketExpression.containsMatch@.
	| Predicate (ShowablePredicate.ShowablePredicate m)	-- ^ The datum matches if 'ShowablePredicate.ShowablePredicate'.
	deriving (
		Eq
--		Read,	-- Specialised below.
--		Show	-- Specialised below.
	)

instance ToolShed.SelfValidate.SelfValidator (Meta m)	where
	getErrors _	= []

instance Show m => Show (Meta m)	where
	showsPrec _ Any					= showChar anyToken
	showsPrec _ (Literal m)				= shows m
	showsPrec _ (AnyOf bracketExpression)		= shows bracketExpression
	showsPrec _ (NoneOf bracketExpression)		= showChar x . showChar BracketExpression.negationToken . showString xs	where (x : xs)	= show $ AnyOf bracketExpression
	showsPrec _ (Predicate showablePredicate)	= shows showablePredicate

instance (ShortcutExpander m, Read m) => Read (Meta m)	where
	readsPrec _ []				= []		-- No parse.
	readsPrec _ (' ' : s)			= reads s	-- Consume white-space.
	readsPrec _ ('\t' : s)			= reads s	-- Consume white-space.
	readsPrec _ ('.' : s)			= [(Any, s)]
	readsPrec _ ('[' : '^' : noneOf)	= Control.Arrow.first NoneOf `map` reads (fst BracketExpression.delimiterTokens : noneOf) {-Reconstruct without negation, & recurse-}
	readsPrec _ anyOf@('[' : _)		= Control.Arrow.first AnyOf `map` reads anyOf {-singleton-}
	readsPrec _ ('\\' : c : s)		= [(expand c, s)]
	readsPrec _ literal			= Control.Arrow.first Literal `map` reads literal {-singleton-}

instance Consumer.Consumer (Meta m)	where
	consumptionProfile meta	= let
		hasSpecificDataRequirement :: Bool
		hasSpecificDataRequirement	= case meta of
			Any		-> False
			NoneOf []	-> False
			_		-> True
	 in ConsumptionProfile.MkConsumptionProfile {
		ConsumptionProfile.consumptionBounds		= (1, Just 1),
		ConsumptionProfile.hasSpecificRequirement	= hasSpecificDataRequirement,
		ConsumptionProfile.canConsumeAnything		= not hasSpecificDataRequirement
	 }

	starHeight _	= 0

instance Control.DeepSeq.NFData m => Control.DeepSeq.NFData (Meta m)	where
	rnf Any					= ()
	rnf (Literal m)				= Control.DeepSeq.rnf m
	rnf (AnyOf bracketExpression)		= Control.DeepSeq.rnf bracketExpression
	rnf (NoneOf bracketExpression)		= Control.DeepSeq.rnf bracketExpression
	rnf (Predicate showablePredicate)	= Control.DeepSeq.rnf showablePredicate

-- | True if the specified datum matches.
isMatch :: Eq m
	=> m		-- ^ The input datum.
	-> Meta m	-- ^ The meta-entity against which the input datum is to be matched.
	-> Bool		-- ^ The result of the match-operation.
isMatch _ Any					= True
isMatch datum (Literal literal)			= datum == literal
isMatch datum (AnyOf bracketExpression)		= datum `BracketExpression.containsMatch` bracketExpression
isMatch datum (NoneOf bracketExpression)	= not $ datum `isMatch` AnyOf bracketExpression	-- This implementation leverages future enhancements to 'AnyOf'.
isMatch datum (Predicate showablePredicate)	= ShowablePredicate.predicate showablePredicate datum

-- | The token used to precede a /Perl-style shortcut/, when in the 'String'-form.
shortcutToken :: Char
shortcutToken	= '\\'

-- | The token used to denote 'Any', when in the 'String'-form.
anyToken :: Char
anyToken	= '.'

-- | The set of 'Char' to which a specific meaning is attributed, when reading from 'String'.
tokens :: String
tokens	= [shortcutToken, anyToken] ++ BracketExpression.tokens