RepeatableMetaChar.hs

{-# LANGUAGE CPP #-}
{-
	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.RepeatableMetaChar(
-- * Types
-- ** Data-types
--	RepeatableMetaChar,
-- ** Type-synonyms
--	Testable,
-- * Functions
--	deconstruct,
	quickChecks
) where

import			Control.Applicative((<$>))
import			Grecce.QC.MetaChar()
import qualified	RegExChar.MetaChar		as MetaChar
import qualified	RegExDot.Consumer		as Consumer
import qualified	RegExDot.ConsumptionBounds	as ConsumptionBounds
import qualified	RegExDot.ConsumptionProfile	as ConsumptionProfile
import qualified	RegExDot.Repeatable		as Repeatable
import qualified	Test.QuickCheck
import qualified	ToolShed.SelfValidate		as SelfValidate

-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'.
newtype RepeatableMetaChar	= MkRepeatableMetaChar (Repeatable.Repeatable MetaChar.MetaChar)	deriving (Eq, Read, Show)

-- | Accessor.
deconstruct :: RepeatableMetaChar -> Repeatable.Repeatable MetaChar.MetaChar
deconstruct (MkRepeatableMetaChar repeatableMetaChar)	= repeatableMetaChar

instance SelfValidate.SelfValidator RepeatableMetaChar	where
	isValid	= SelfValidate.isValid . deconstruct

instance Consumer.Consumer RepeatableMetaChar	where
	consumptionProfile	= Consumer.consumptionProfile . deconstruct
	starHeight		= Consumer.starHeight . deconstruct

instance Test.QuickCheck.Arbitrary RepeatableMetaChar	where
	arbitrary	= do
		metaChar	<- Test.QuickCheck.arbitrary
		fewest		<- Test.QuickCheck.elements [0 .. 9]	--Could be more, but this is an adequate test.
		most		<- Test.QuickCheck.oneof [return Nothing, Just <$> Test.QuickCheck.elements [max fewest 1 .. 9]]
		isGreedy	<- Test.QuickCheck.arbitrary

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

		return {-to Gen-monad-} . MkRepeatableMetaChar $ Repeatable.MkRepeatable {
			Repeatable.base			= metaChar,
			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

type Testable	= RepeatableMetaChar -> Test.QuickCheck.Property

-- | Defines invariant properties, which must hold for any 'RepeatableMetaChar'.
quickChecks :: (Testable -> IO ()) -> IO ()
quickChecks checker	= checker `mapM_` [prop_consumptionProfile, prop_io, prop_isValid, prop_starHeight]	where
	prop_consumptionProfile, prop_io, prop_isValid, prop_starHeight :: Testable
	prop_consumptionProfile r	= Test.QuickCheck.label "prop_consumptionProfile" $ (
		case maybeMaxData of
			Nothing	-> True
			Just m	-> m >= minData
	 ) && (
		b == Consumer.getHasSpecificRequirement (Repeatable.base $ deconstruct r)
	 ) where ConsumptionProfile.MkConsumptionProfile {
		ConsumptionProfile.consumptionBounds		= (minData, maybeMaxData),
		ConsumptionProfile.hasSpecificRequirement	= b
	 } = Consumer.consumptionProfile r
	prop_io (MkRepeatableMetaChar r)		= Test.QuickCheck.label "prop_io" $ read (show r) == r
	prop_isValid r					= Test.QuickCheck.label "prop_isValid" $ SelfValidate.isValid r
	prop_starHeight (MkRepeatableMetaChar r)	= Test.QuickCheck.label "prop_starHeight" $ Consumer.starHeight r == if ConsumptionBounds.isPrecise (Consumer.getConsumptionBounds r) then 0 else 1