MetaChar.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.

 [@TODO@]	Test /Perl-style shortcuts/ & /Posix Character-classes/.
-}

module Grecce.Test.QC.MetaChar(
-- * Types
-- ** Type-synonyms
--	Testable,
-- * Constants
--	testCharacters,
-- * Functions
	quickChecks
) where

import			Control.Applicative((<$>))
import qualified	Data.List
import qualified	RegExChar.MetaChar			as MetaChar	--CAVEAT: beware of the similar name.
import qualified	RegExDot.BracketExpression		as BracketExpression
import qualified	RegExDot.BracketExpressionMember	as BracketExpressionMember
import qualified	RegExDot.Meta				as Meta
import qualified	Test.QuickCheck

-- CAVEAT: module "Test.QuickCheck.Arbitrary" defines an instance of this from package "Quickcheck-2.1.0.1".
#if !(MIN_VERSION_QuickCheck(2,1,0))
instance Test.QuickCheck.Arbitrary Char	where
	arbitrary	= Test.QuickCheck.elements testCharacters
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

testCharacters :: String
testCharacters	= filter (`notElem` [Meta.shortcutToken, BracketExpression.negationToken]) [' ' .. '~']	--TODO: permit all characters.

instance Test.QuickCheck.Arbitrary MetaChar.MetaChar	where
	arbitrary	= Test.QuickCheck.oneof $ map (MetaChar.MkMetaChar <$>) [
		return {-to Gen-monad-} Meta.Any,
		Meta.Literal <$> Test.QuickCheck.elements testCharacters,
		Meta.AnyOf . map BracketExpressionMember.Literal . Data.List.nub <$> arbitraryCharList 1 16,	--Test.QuickCheck.vector 16 {-Char-},
		Meta.NoneOf . map BracketExpressionMember.Literal . Data.List.nub <$> arbitraryCharList 1 4
	 ] where
		arbitraryCharList :: Int -> Int -> Test.QuickCheck.Gen String
		arbitraryCharList i j	= do
			l	<- Test.QuickCheck.arbitrary {-Int-}

			take (min j $ i `max` l) . Data.List.nub . Data.List.filter (`elem` testCharacters) <$> Test.QuickCheck.vector maxBound {-Char-}
#if ! (MIN_VERSION_QuickCheck(2,1,0))
	coarbitrary	= undefined	--CAVEAT: stops warnings from ghc.
#endif

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

-- | Defines invariant properties, which must hold for any 'MetaChar.MetaChar'.
quickChecks :: (Testable -> IO ()) -> IO ()
quickChecks checker	= checker `mapM_` [prop_io]	where
	prop_io :: Testable
	prop_io m	= Test.QuickCheck.label "prop_io" $ read (show m) == m