ExtendedRegExChar.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
	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@]	Implements 'Test.QuickCheck.Arbitrary' & defines tests based on it.
-}

module Grecce.QC.ExtendedRegExChar(
-- * Types
-- ** Data-types
--	AlternativesChar(..),
--	PatternChar(..),
--	RepeatablePatternChar(..),
-- ** Type-synonyms
--	Testable,
-- * Functions
--	deconstructAlternativesChar,
--	deconstructPatternChar,
--	deconstructRepeatablePatternChar,
	quickChecks
) where

import			Control.Applicative((<$>))
import			Grecce.QC.MetaChar()
import			RegExDot.DSL((-:), (?:), (+:), (<~>))
import			RegExDot.RegEx((+~))
import			Test.QuickCheck((==>))
import qualified	RegExChar.ExtendedRegExChar		as ExtendedRegExChar	--CAVEAT: beware of the similar name.
import qualified	RegExChar.MetaChar			as MetaChar
import qualified	RegExDot.Anchor				as Anchor
import qualified	RegExDot.BracketExpressionMember	as BracketExpressionMember
import qualified	RegExDot.Consumer			as Consumer
import qualified	RegExDot.ConsumptionBounds		as ConsumptionBounds
import qualified	RegExDot.ConsumptionProfile		as ConsumptionProfile
import qualified	RegExDot.Meta				as Meta
import qualified	RegExDot.RegEx				as RegEx
import qualified	RegExDot.RegExOpts			as RegExOpts
import qualified	RegExDot.Repeatable			as Repeatable
import qualified	RegExDot.Result				as Result
import qualified	Test.QuickCheck
import qualified	ToolShed.SelfValidate			as SelfValidate

-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'.
newtype AlternativesChar	= MkAlternativesChar (RegEx.Alternatives Char) deriving (Eq, Read, Show)

-- | Accessor.
deconstructAlternativesChar :: AlternativesChar -> RegEx.Alternatives Char
deconstructAlternativesChar (MkAlternativesChar a)	= a

instance SelfValidate.SelfValidator AlternativesChar where
	isValid	= SelfValidate.isValid . deconstructAlternativesChar

instance Consumer.Consumer AlternativesChar where
	consumptionProfile	= Consumer.consumptionProfile . deconstructAlternativesChar
	starHeight		= Consumer.starHeight . deconstructAlternativesChar

instance Test.QuickCheck.Arbitrary AlternativesChar	where
	arbitrary	= MkAlternativesChar . RegEx.MkAlternatives . map ExtendedRegExChar.extendedRegEx <$> (
		Test.QuickCheck.elements [1, 2]	>>= Test.QuickCheck.vector {-[ExtendedRegExChar]-}
	 ) --TODO: permit zero alternatives.
#if !(MIN_VERSION_QuickCheck(2,1,0))
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'.
newtype PatternChar	= MkPatternChar (RegEx.Pattern Char) deriving (Eq, Read, Show)

-- | Accessor.
deconstructPatternChar :: PatternChar -> RegEx.Pattern Char
deconstructPatternChar (MkPatternChar pattern)	= pattern

instance SelfValidate.SelfValidator PatternChar	where
	isValid	= SelfValidate.isValid . deconstructPatternChar

instance Consumer.Consumer PatternChar	where
	consumptionProfile	= Consumer.consumptionProfile . deconstructPatternChar
	starHeight		= Consumer.starHeight . deconstructPatternChar

instance Test.QuickCheck.Arbitrary PatternChar	where
	arbitrary	= MkPatternChar <$> Test.QuickCheck.frequency [
		(4,	RegEx.Require . MetaChar.deconstruct <$> Test.QuickCheck.arbitrary {-MetaChar-}),
		(1,	RegEx.CaptureGroup . deconstructAlternativesChar <$> Test.QuickCheck.arbitrary {-AlternativesChar-})
	 ] --CAVEAT: may recurse forever if 'RegEx.CaptureGroup / RegEx.Require' is too high.
#if ! (MIN_VERSION_QuickCheck(2,1,0))
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'.
newtype RepeatablePatternChar	= MkRepeatablePatternChar (Repeatable.Repeatable PatternChar)	deriving (Eq, Read, Show)

-- | Accessor.
deconstructRepeatablePatternChar :: RepeatablePatternChar -> Repeatable.Repeatable PatternChar
deconstructRepeatablePatternChar (MkRepeatablePatternChar repeatable)	= repeatable

instance SelfValidate.SelfValidator RepeatablePatternChar	where
	isValid	= SelfValidate.isValid . deconstructRepeatablePatternChar

instance Consumer.Consumer RepeatablePatternChar	where
	consumptionProfile	= Consumer.consumptionProfile . deconstructRepeatablePatternChar
	starHeight		= Consumer.starHeight . deconstructRepeatablePatternChar

instance Test.QuickCheck.Arbitrary RepeatablePatternChar	where
	arbitrary	= do
		patternChar	<- Test.QuickCheck.arbitrary
		fewest		<- Test.QuickCheck.elements [0 .. 9]	--Could be more, but this is an adequate test.
		most		<- Test.QuickCheck.oneof [return {-to Gen-monad-} Nothing, Just <$> Test.QuickCheck.elements [max fewest 1 .. 9]]
		isGreedy	<- Test.QuickCheck.arbitrary {-Bool-}

		let
			repetitionBounds :: Repeatable.RepetitionBounds
			repetitionBounds	= (fewest, most)

		return {-to Gen-monad-} $ MkRepeatablePatternChar Repeatable.MkRepeatable {
			Repeatable.base			= patternChar,
			Repeatable.repetitionBounds	= repetitionBounds,
			Repeatable.isGreedy		= Repeatable.hasPreciseBounds repetitionBounds || isGreedy	--Only specify non-greedy where space exists.
		}
#if ! (MIN_VERSION_QuickCheck(2,1,0))
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

instance Test.QuickCheck.Arbitrary ExtendedRegExChar.ExtendedRegExChar	where
	arbitrary	= do
		hasBowAnchor	<- Test.QuickCheck.arbitrary {-Bool-}
		concatenation	<- map ((deconstructPatternChar <$> {-replace base-}) . deconstructRepeatablePatternChar {-Repeatable.Repeatable PatternChar-}) <$> Test.QuickCheck.vector 2 {-[RepeatablePatternChar]-}
		hasSternAnchor	<- Test.QuickCheck.arbitrary {-Bool-}

		return {-to Gen-monad-} $ ExtendedRegExChar.MkExtendedRegExChar False RegEx.MkExtendedRegEx {
			RegEx.bowAnchor		= if hasBowAnchor then Just Anchor.Bow else Nothing,
			RegEx.concatenation	= concatenation,
			RegEx.sternAnchor	= if hasSternAnchor then Just Anchor.Stern else Nothing
		}

#if ! (MIN_VERSION_QuickCheck(2,1,0))
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

type Testable	= ExtendedRegExChar.ExtendedRegExChar -> Test.QuickCheck.Property

-- | Defines invariant properties, which must hold for any 'ExtendedRegExChar.ExtendedRegExChar'.
quickChecks :: (Testable -> IO ()) -> IO ()
quickChecks checker	= quickChecks1 >> quickChecks2	where
	quickChecks1	= checker `mapM_` [prop_consumptionProfile, prop_consumptionProfile2, prop_io, prop_io', prop_isValid, prop_starHeight]	where
		prop_consumptionProfile, prop_consumptionProfile2, prop_io, prop_io', prop_isValid, prop_starHeight :: Testable
		prop_consumptionProfile r	= Test.QuickCheck.label "prop_consumptionProfile" $ (
			case maybeMaxData of
				Nothing	-> True
				Just m	-> m >= minData
		 ) && (
			not b == all (not . Consumer.getHasSpecificRequirement) (RegEx.concatenation $ ExtendedRegExChar.extendedRegEx r)
		 )
			where
				ConsumptionProfile.MkConsumptionProfile {
					ConsumptionProfile.consumptionBounds		= (minData, maybeMaxData),
					ConsumptionProfile.hasSpecificRequirement	= b
				} = Consumer.consumptionProfile r

		prop_consumptionProfile2 r	= RegEx.isDefined (ExtendedRegExChar.extendedRegEx r)	==> Test.QuickCheck.label "prop_consumptionProfile2" $ or [hasSpecificRequirement, canConsumeAnything]	--There's either; a requirement for at least one specific, or we can consume at least one arbitrary; input datum.
			where
				ConsumptionProfile.MkConsumptionProfile {
					ConsumptionProfile.hasSpecificRequirement	= hasSpecificRequirement,
					ConsumptionProfile.canConsumeAnything		= canConsumeAnything
				} = Consumer.consumptionProfile r

		prop_io r		= Test.QuickCheck.label "prop_io" $ read (show r) == r
		prop_io' r		= Test.QuickCheck.label "prop_io'" $ read (show r') == r'	where r' = ExtendedRegExChar.extendedRegEx r	--Check "RegEx.ExtendedRegEx Char" too.
		prop_isValid r		= Test.QuickCheck.label "prop_isValid" $ SelfValidate.isValid r
		prop_starHeight r	= Test.QuickCheck.label "prop_starHeight" $ (Consumer.starHeight r == 0) == ConsumptionBounds.isPrecise (Consumer.getConsumptionBounds r)

	quickChecks2	= Test.QuickCheck.quickCheck {-'checker' is technically the wrong type-} `mapM_` [prop_double]	where
		prop_double :: Double -> Test.QuickCheck.Property
		prop_double d	= Test.QuickCheck.label "prop_double" $ RegEx.extractDataFromMatchList `fmap` Result.getMatchList result == Just s	where
			s :: String
			s	= show $ d * 1e6	--Implementation of show, uses exponential notation, when the number is large.

			result :: RegEx.Result Char
			result = s +~ RegExOpts.mkRegEx (
				(Just Anchor.Bow, Just Anchor.Stern) <~> sign ?: digits +: map (
					Repeatable.zeroOrOne . RegEx.captureGroup . map ((Nothing, Nothing) <~>) . return {-to List-monad-}
				) [
					RegEx.Require (Meta.Literal '.') -: digits +: [],
					RegEx.Require (Meta.AnyOf $ map BracketExpressionMember.Literal "eE") -: sign ?: digits +: []
				]
			 ) where
				sign, digits :: RegEx.Pattern Char
				sign	= RegEx.Require . Meta.AnyOf $ map BracketExpressionMember.Literal "+-"
				digits	= RegEx.Require . Meta.AnyOf $ map BracketExpressionMember.Literal ['0' .. '9']