diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,5 +1,5 @@ #!/usr/bin/env runhaskell -import qualified Distribution.Simple +import qualified Distribution.Simple -main = Distribution.Simple.defaultMain +main = Distribution.Simple.defaultMain diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -55,3 +55,12 @@ * Used new constant 'RegExDot.Anchor.unanchored'. * Added details to any failure to parse the command-line arguments. * Used new test-modules from 'toolshed-0.14.0.0'. +0.9.0.11 + * Refactored 'Grecce.Test.QC.QuickChecks'. + * Replaced calls to 'error' from inside the IO-monad, with 'Control.Monad.fail'. + * Trapped command-line arguments to which garbage has been appended. + * Added files to build .deb to 'regexchar.cabal'. + * Tested with 'haskell-platform-2013.2.0.0'. + * Replaced preprocessor-directives with 'build-depends' constraints in 'regexchar.cabal'. +0.9.0.12 + * Either replaced instances of '(<$>)' with 'fmap' to avoid ambiguity between "Control.Applicative" & "Prelude" which (from 'base-4.8') also exports this symbol, or hid the symbol when importing the "Prelude".. diff --git a/changelog.Debian b/changelog.Debian new file mode 100644 --- /dev/null +++ b/changelog.Debian @@ -0,0 +1,20 @@ +regexchar (0.9.0.6-1) experimental; urgency=low + + * New release. + +regexchar (0.9.0.7-1) experimental; urgency=low + + * Uploaded to . + +regexchar (0.9.0.8-1) experimental; urgency=low + + * + + -- Alistair Ward Wed, 12 Jan 2011 00:00:00 +0000 + +regexchar (0.9.0.10-1) experimental; urgency=low + + * + + -- Alistair Ward Sat, 06 May 2012 00:00:00 +0000 + diff --git a/debian/DEBIAN/control b/debian/DEBIAN/control new file mode 100644 --- /dev/null +++ b/debian/DEBIAN/control @@ -0,0 +1,14 @@ +Package: regexchar +Version: 0.9.0.12-1 +Section: text +Priority: optional +#Architecture: i386 +Architecture: amd64 +Depends: libc6 +Installed-size: 3496 +Maintainer: Dr. Alistair Ward +Provides: +Homepage: http://functionalley.eu +Description: POSIX extended regular-expression engine. + POSIX extended regex-engine, specialised from the underlying polymorphic engine regexdot, to merely process character-lists, as is typically required. + diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -1,4 +1,4 @@ -# Copyright (C) 2010 Dr. Alistair Ward +# Copyright (C) 2010-2014 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 @@ -42,17 +42,17 @@ PATH=~/.cabal/bin:$$PATH runhaskell Setup $@ --hyperlink-source --executables #Amend path to find 'HsColour', as required for 'hyperlink-source'. hlint: - @$@ -i 'Use ||' src/ + @$@ -i 'Use ||' src/ +RTS -N sdist: - runhaskell Setup $@ + TAR_OPTIONS='--format=ustar' runhaskell Setup $@ check: cabal upload --check --verbose=3 dist/*.tar.gz; rpm: $(PACKAGE_NAME).spec rpmbuild -bb --nodeps -- $^ - mv -- `find /usr/src/packages/ -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./ + mv -- `find ~/rpmbuild -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./ rpmlint: $(PACKAGE_NAME).spec @$@ $^ diff --git a/man/man1/grecce.1 b/man/man1/grecce.1 --- a/man/man1/grecce.1 +++ b/man/man1/grecce.1 @@ -200,9 +200,9 @@ .IP \(bu Home-page: \fBhttp://functionalley.eu\fR .IP \(bu -Source-documentation is generated by \fBHaddock\fR, & is available in the distribution. +Source-documentation is generated by "\fBHaddock\fR", & is available in the distribution. .IP \(bu -.I http://www.haskell.org/haddock/ +.B http://www.haskell.org/haddock/ .IP \(bu \fBRegExDot\fR, the polymorphic regex-engine from which this is built. diff --git a/regexchar.cabal b/regexchar.cabal --- a/regexchar.cabal +++ b/regexchar.cabal @@ -1,8 +1,8 @@ ---Package-properties +-- Package-properties Name: regexchar -Version: 0.9.0.10 +Version: 0.9.0.12 Cabal-Version: >= 1.6 -Copyright: (C) 2010 Dr. Alistair Ward +Copyright: (C) 2010-2015 Dr. Alistair Ward License: GPL License-file: LICENSE Author: Dr. Alistair Ward @@ -11,17 +11,18 @@ Build-Type: Simple Description: Provides a POSIX, extended regex-engine, specialised from the underlying /polymorphic/ package /regexdot/, to merely process the traditional character-lists. Category: Regex, Text -Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0, GHC == 7.4 +Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0, GHC == 7.4, GHC == 7.6, GHC == 7.10 Homepage: http://functionalley.eu Maintainer: regexchar functionalley eu Bug-reports: regexchar functionalley eu Data-files: data/*.txt -Extra-Source-Files: changelog copyright makefile man/man1/grecce.1 regexchar.spec +Extra-Source-Files: changelog copyright changelog.Debian debian/DEBIAN/control makefile man/man1/grecce.1 regexchar.spec flag threaded Description: Link with the threaded runtime. default: True +-- Turn on using: 'runhaskell ./Setup.hs configure -f llvm'. flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. manual: True @@ -40,9 +41,9 @@ containers, parsec == 3.*, regexdot >= 0.11.1.0, - toolshed == 0.14.* + toolshed >= 0.14 - GHC-options: -Wall + GHC-options: -Wall -fno-warn-tabs if impl(ghc >= 7.4.1) GHC-prof-options: -prof -fprof-auto -fprof-cafs @@ -71,21 +72,16 @@ Build-depends: array, Cabal >= 1.6 && < 2, + parallel >= 3.0, QuickCheck >= 2.4, regex-base, regex-posix - GHC-options: -Wall -O2 + GHC-options: -Wall -O2 -fno-warn-tabs GHC-prof-options: -prof -auto-all -caf-all if flag(threaded) - Build-depends: parallel >= 3.0 GHC-options: -threaded - - if impl(ghc >= 6.12) - GHC-options: -feager-blackholing - else - Build-depends: parallel if impl(ghc >= 7.0) GHC-options: -rtsopts diff --git a/regexchar.spec b/regexchar.spec --- a/regexchar.spec +++ b/regexchar.spec @@ -1,4 +1,4 @@ -# Copyright (C) 2012 Dr. Alistair Ward +# Copyright (C) 2012-2014 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 @@ -24,7 +24,7 @@ Summary: A re-implementation of egrep, using a specialisation of a polymorphic regex-engine Name: regexchar -Version: 0.9.0.10 +Version: 0.9.0.12 Release: 1 License: GPLv3 #From '/usr/share/doc/packages/rpm/GROUPS'. @@ -49,8 +49,8 @@ cd '%package/' #Descend into the build-directory. runhaskell Setup copy --destdir=%buildroot #Install the package in the target-directory. rm -rf '%buildroot%_libdir/' #Remove unrequired libraries. -mkdir -p -- '%buildroot%_docdir' && mv -- changelog copyright LICENSE '%buildroot%_docdir/' -mkdir -p -- '%buildroot%_mandir' && mv -- 'man/man1' '%buildroot%_mandir/' +mkdir -p -- '%buildroot%_docdir' && mv changelog copyright LICENSE '%buildroot%_docdir/' +mkdir -p -- '%buildroot%_mandir' && mv 'man/man1' '%buildroot%_mandir/' %clean make --directory='%package' clobber @@ -67,4 +67,5 @@ %changelog * Wed May 09 2012 Alistair Ward 0.9.0.10-1 Removed "rm -rf -- '%buildroot'" from build, for security. -Corrected "Paths" modul, even though it's unused. +Corrected "Paths" module, even though it's unused. + diff --git a/src/Grecce/Grep.hs b/src/Grecce/Grep.hs --- a/src/Grecce/Grep.hs +++ b/src/Grecce/Grep.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE CPP #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -30,10 +29,10 @@ grep ) where -import Control.Applicative((<$>)) import Control.Arrow((&&&)) import qualified Control.Arrow import qualified Control.Monad +import qualified Control.Parallel.Strategies import qualified Data.List import qualified Grecce.CommandOptions as CommandOptions import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar @@ -44,10 +43,6 @@ import qualified System.Exit import qualified System.IO -#if MIN_VERSION_parallel(3,0,0) -import qualified Control.Parallel.Strategies -#endif - type LineNumber = Int type Matches = Int @@ -70,7 +65,7 @@ if isEOF then if listFilesWithMatches - then return {-to IO-monad-} $ System.Exit.ExitFailure 1 --No match has been found, otherwise we'd have exited earlier. + then return {-to IO-monad-} $ System.Exit.ExitFailure 1 -- No match has been found, otherwise we'd have exited earlier. else if listFilesWithoutMatch then putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess else do @@ -80,7 +75,7 @@ then System.Exit.ExitFailure 1 else System.Exit.ExitSuccess else {-not EOF-} do - line <- getLine --Process line-at-a-time, to provide instant feedback. + line <- getLine -- Process line-at-a-time, to provide instant feedback. let lineNumber' :: LineNumber @@ -97,10 +92,10 @@ else id ) line' - matchFilterStdIn lineNumber' $ succ matches --Recurse. + matchFilterStdIn lineNumber' $ succ matches -- Recurse. onFailure, onMismatch :: IO System.Exit.ExitCode - onFailure = matchFilterStdIn lineNumber' matches --Recurse + onFailure = matchFilterStdIn lineNumber' matches -- Recurse onMismatch | invertMatch = onSuccess line | otherwise = onFailure @@ -130,7 +125,7 @@ matchFilter :: [String] -> [String] matchFilter = {-#SCC "matchFilter" #-} ( if countMatches - then return {-to List-monad-} . show . length --Substitute the list of matches, with its length. + then return {-to List-monad-} . show . length -- Substitute the list of matches, with its length. else id ) . ( let @@ -163,15 +158,11 @@ isEmpty :: Bool isEmpty = null results in do - results -#if MIN_VERSION_parallel(3,0,0) - <- concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq -#else - <- concatMap -#endif - ( + results <- ( + concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq ( uncurry identifySource . Control.Arrow.second (matchFilter . {-#SCC "lines" #-} lines {-chops '\n'-}) - ) . zip fileNames <$> mapM readFile fileNames + ) . zip fileNames + ) `fmap` mapM readFile fileNames mapM_ putStrLn results @@ -187,9 +178,9 @@ CommandOptions.listFilesWithMatches, CommandOptions.listFilesWithoutMatch, CommandOptions.verbose - ] --Divvy-up. + ] -- Divvy-up. ---Separate the regEx & the names of the input-data files to feed it. +-- Separate the regEx & the names of the input-data files to feed it. extendedRegExChar :: ExtendedRegExChar.ExtendedRegExChar fileNames :: [String] (extendedRegExChar, fileNames) = case CommandOptions.extendedRegExChar commandOptions of @@ -198,7 +189,7 @@ | null nonOptions -> error "Undefined regex." | otherwise -> read . head &&& tail $ nonOptions ---Combine the regex & options, to create a complete task-description. +-- Combine the regex & options, to create a complete task-description. regExOpts :: RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar regExOpts = RegExDot.RegExOpts.MkRegExOpts { RegExDot.RegExOpts.compilationOptions = CommandOptions.compilationOptions commandOptions, @@ -206,7 +197,7 @@ RegExDot.RegExOpts.regEx = extendedRegExChar } ---Define functions used to format the output. +-- Define functions used to format the output. separate :: ShowS separate = showChar ':' diff --git a/src/Grecce/Test/Assert/RegExOptsChar.hs b/src/Grecce/Test/Assert/RegExOptsChar.hs --- a/src/Grecce/Test/Assert/RegExOptsChar.hs +++ b/src/Grecce/Test/Assert/RegExOptsChar.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -43,10 +43,9 @@ -- isMatch ) where -import Control.Applicative((<$>)) import qualified Control.Arrow import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -import qualified RegExChar.RegExOptsChar as RegExOptsChar --CAVEAT: beware of the similar name. +import qualified RegExChar.RegExOptsChar as RegExOptsChar -- CAVEAT: beware of the similar name. import qualified RegExDot.CompilationOptions import qualified RegExDot.ExecutionOptions import qualified Text.Regex.Base.RegexLike as RegexLike @@ -80,13 +79,15 @@ * To facilitate parsing, each line in the file has the format of @show Test@. -} readTests :: String -> IO [Test] -readTests fileName = map ( - \line -> case reads line of - [(test, _)] -> test - _ -> error $ "Grecce.Test.Assert.RegExOptsChar.readTests:\tfailed to parse " ++ show fileName ++ "; " ++ show line ++ "." - ) . filter ( - (/= '#') . head --Remove comments. - ) . filter ( - not . null --Remove blank lines. - ) . lines <$> readFile fileName +readTests fileName = ( + map ( + \line -> case reads line of + [(test, _)] -> test + _ -> error $ "Grecce.Test.Assert.RegExOptsChar.readTests:\tfailed to parse " ++ show fileName ++ "; " ++ show line ++ "." + ) . filter ( + (/= '#') . head -- Remove comments. + ) . filter ( + not . null -- Remove blank lines. + ) . lines + ) `fmap` readFile fileName diff --git a/src/Grecce/Test/Performance/ExtendedRegEx.hs b/src/Grecce/Test/Performance/ExtendedRegEx.hs --- a/src/Grecce/Test/Performance/ExtendedRegEx.hs +++ b/src/Grecce/Test/Performance/ExtendedRegEx.hs @@ -1,5 +1,5 @@ {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -50,6 +50,7 @@ -- tailorTest ) where +import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. import Control.Applicative((<$>), (<*>)) import qualified Control.Arrow import Control.Arrow((&&&)) @@ -66,7 +67,7 @@ import qualified ToolShed.System.TimePure solitary :: Bool -solitary = True --Currently required because of the disastrous performance of "Text.Regex.Posix" on 'Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES'. +solitary = True -- Currently required because of the disastrous performance of "Text.Regex.Posix" on 'Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES'. type GetAndRunTestRange a = [a] -> IO () type GenerateAndRunTest = Test.Performance.ExtendedRegExTest.TestGenerator Char -> Test.Performance.ExtendedRegExTest.TestComplexity -> IO (ExtendedRegExChar.InputData, [(Double, String)]) @@ -77,10 +78,10 @@ * If the specified maximum 'Test.Performance.ExtendedRegExTest.TestComplexity' is set to the special value '0', then it is increased linearly, without limit. -} run :: RegExDot.ExecutionOptions.ExecutionOptions -> Test.Performance.ExtendedRegExTest.TestComplexity -> Either [Test.Performance.ExtendedRegExTestsNegative.TestName] [Test.Performance.ExtendedRegExTestsPositive.TestName] -> IO () -run executionOptions 0 testRange = run executionOptions maxBound testRange --Run the specified test-range, without any upper bound to 'Test.Performance.ExtendedRegExTest.TestComplexity'. +run executionOptions 0 testRange = run executionOptions maxBound testRange -- Run the specified test-range, without any upper bound to 'Test.Performance.ExtendedRegExTest.TestComplexity'. run executionOptions maxTestComplexity (Left negativeTestRange) = runNegativeTestRange negativeTestRange where runNegativeTestRange :: GetAndRunTestRange Test.Performance.ExtendedRegExTestsNegative.TestName - runNegativeTestRange [] = runNegativeTestRange [minBound .. maxBound] --Run all the tests, to the specified maximum 'Test.Performance.ExtendedRegExTest.TestComplexity'. + runNegativeTestRange [] = runNegativeTestRange [minBound .. maxBound] -- Run all the tests, to the specified maximum 'Test.Performance.ExtendedRegExTest.TestComplexity'. runNegativeTestRange testRange = sequence_ $ ( \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where @@ -91,13 +92,13 @@ ) [ isMismatch, if solitary - then const True --CAVEAT: should be 'undefined'. - else not . (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool --CAVEAT: . + then const True -- CAVEAT: should be 'undefined'. + else not . (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool -- CAVEAT: . ] ) . Control.Arrow.second ( ( \extendedRegEx -> ( - RegExDot.RegEx./~ RegExDot.RegExOpts.MkRegExOpts { --CAVEAT: . + RegExDot.RegEx./~ RegExDot.RegExOpts.MkRegExOpts { -- CAVEAT: . RegExDot.RegExOpts.compilationOptions = ToolShed.Defaultable.defaultValue, RegExDot.RegExOpts.executionOptions = executionOptions, RegExDot.RegExOpts.regEx = extendedRegEx @@ -108,7 +109,7 @@ run executionOptions maxTestComplexity (Right positiveTestRange) = runPositiveTestRange positiveTestRange where runPositiveTestRange :: GetAndRunTestRange Test.Performance.ExtendedRegExTestsPositive.TestName - runPositiveTestRange [] = runPositiveTestRange [minBound .. maxBound] --Run all the tests, to the specified maximum 'Test.Performance.ExtendedRegExTest.TestComplexity'. + runPositiveTestRange [] = runPositiveTestRange [minBound .. maxBound] -- Run all the tests, to the specified maximum 'Test.Performance.ExtendedRegExTest.TestComplexity'. runPositiveTestRange testRange = sequence_ $ ( \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where @@ -120,11 +121,11 @@ if RegExDot.ExecutionOptions.requireMatchList executionOptions then if solitary then const "" --- else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> String --CAVEAT: . - else (\(_, _, _, s) -> show s) . ((Text.Regex.Posix.=~ extendedRegExCharString) :: String -> (String, String, String, [String])) --CAVEAT: . +-- else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> String -- CAVEAT: . + else (\(_, _, _, s) -> show s) . ((Text.Regex.Posix.=~ extendedRegExCharString) :: String -> (String, String, String, [String])) -- CAVEAT: . else show . if solitary - then const True --CAVEAT: should be 'undefined'. - else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool --CAVEAT: . + then const True -- CAVEAT: should be 'undefined'. + else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool -- CAVEAT: . ] ) ) . Control.Arrow.second ( @@ -135,10 +136,10 @@ RegExDot.RegExOpts.compilationOptions = ToolShed.Defaultable.defaultValue, RegExDot.RegExOpts.executionOptions = executionOptions, RegExDot.RegExOpts.regEx = extendedRegEx - } --Similar to 'RegexLike.makeRegexOpts', but without the requirement to read the regex. + } -- Similar to 'RegexLike.makeRegexOpts', but without the requirement to read the regex. in if RegExDot.ExecutionOptions.requireMatchList executionOptions - then show . (RegExDot.RegEx.+~ regExOpts) --CAVEAT: . - else show . (RegExDot.RegEx.=~ regExOpts) --CAVEAT: . + then show . (RegExDot.RegEx.+~ regExOpts) -- CAVEAT: . + else show . (RegExDot.RegEx.=~ regExOpts) -- CAVEAT: . ) &&& show . ExtendedRegExChar.MkExtendedRegExChar False {-hasNonCapturingTopLevelAlternatives-} ) . testGenerator diff --git a/src/Grecce/Test/Performance/ExtendedRegExTest.hs b/src/Grecce/Test/Performance/ExtendedRegExTest.hs --- a/src/Grecce/Test/Performance/ExtendedRegExTest.hs +++ b/src/Grecce/Test/Performance/ExtendedRegExTest.hs @@ -47,5 +47,5 @@ -- | Implementer contracts to generate an appropriate 'Test'. class TestGeneratorRepository a where - query :: a -> Maybe (TestGenerator Char) --CAVEAT: polymorphism reduced, to avoid requirement for non-portable Haskell-extensions. + query :: a -> Maybe (TestGenerator Char) -- CAVEAT: polymorphism reduced, to avoid requirement for non-portable Haskell-extensions. diff --git a/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs b/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs --- a/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs +++ b/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs @@ -162,7 +162,7 @@ LINEAR_FRACTAL_RANGES, let base :: RegExDot.Repeatable.Repetitions - base = 2 --Arbitrarily. + base = 2 -- Arbitrarily. bounds :: RegExDot.Repeatable.RepetitionBounds bounds = (0, Just base) @@ -194,7 +194,7 @@ BINARY_TREE_FRACTAL, let base :: RegExDot.Repeatable.Repetitions - base = 2 --Arbitrarily. + base = 2 -- Arbitrarily. in (`replicate` testChar) . (base ^) &&& RegExDot.RegEx.dock . head . ( ( iterate ( diff --git a/src/Grecce/Test/QC/ExtendedRegExChar.hs b/src/Grecce/Test/QC/ExtendedRegExChar.hs --- a/src/Grecce/Test/QC/ExtendedRegExChar.hs +++ b/src/Grecce/Test/QC/ExtendedRegExChar.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -37,10 +36,9 @@ quickChecks ) where -import Control.Applicative((<$>)) import qualified Data.Maybe import Grecce.Test.QC.MetaChar() -import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar --CAVEAT: beware of the similar name. +import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -- CAVEAT: beware of the similar name. import qualified RegExChar.MetaChar as MetaChar import qualified RegExDot.Anchor import qualified RegExDot.BracketExpressionMember @@ -74,12 +72,9 @@ starHeight = RegExDot.Consumer.starHeight . deconstructAlternativesChar instance Test.QuickCheck.Arbitrary AlternativesChar where - arbitrary = MkAlternativesChar . RegExDot.RegEx.MkAlternatives . map ExtendedRegExChar.extendedRegEx <$> ( + arbitrary = (MkAlternativesChar . RegExDot.RegEx.MkAlternatives . map ExtendedRegExChar.extendedRegEx) `fmap` ( 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 + ) -- TODO: permit zero alternatives. -- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. newtype PatternChar = MkPatternChar (RegExDot.RegEx.Pattern Char) deriving (Eq, Read, Show) @@ -96,13 +91,10 @@ starHeight = RegExDot.Consumer.starHeight . deconstructPatternChar instance Test.QuickCheck.Arbitrary PatternChar where - arbitrary = MkPatternChar <$> Test.QuickCheck.frequency [ - (4, RegExDot.RegEx.Require . MetaChar.deconstruct <$> Test.QuickCheck.arbitrary {-MetaChar-}), - (1, RegExDot.RegEx.CaptureGroup . deconstructAlternativesChar <$> Test.QuickCheck.arbitrary {-AlternativesChar-}) - ] --CAVEAT: may recurse forever if 'RegExDot.RegEx.CaptureGroup / RegExDot.RegEx.Require' is too high. -#if ! (MIN_VERSION_QuickCheck(2,1,0)) - coarbitrary = undefined --CAVEAT: stops warnings from ghc. -#endif + arbitrary = MkPatternChar `fmap` Test.QuickCheck.frequency [ + (4, (RegExDot.RegEx.Require . MetaChar.deconstruct) `fmap` Test.QuickCheck.arbitrary {-MetaChar-}), + (1, (RegExDot.RegEx.CaptureGroup . deconstructAlternativesChar) `fmap` Test.QuickCheck.arbitrary {-AlternativesChar-}) + ] -- CAVEAT: may recurse forever if 'RegExDot.RegEx.CaptureGroup / RegExDot.RegEx.Require' is too high. -- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. newtype RepeatablePatternChar = MkRepeatablePatternChar (RegExDot.Repeatable.Repeatable PatternChar) deriving (Eq, Read, Show) @@ -121,8 +113,8 @@ 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]] + 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 `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] isGreedy <- Test.QuickCheck.arbitrary {-Bool-} let @@ -132,16 +124,13 @@ return {-to Gen-monad-} $ MkRepeatablePatternChar RegExDot.Repeatable.MkRepeatable { RegExDot.Repeatable.base = patternChar, RegExDot.Repeatable.repetitionBounds = repetitionBounds, - RegExDot.Repeatable.isGreedy = RegExDot.Repeatable.hasPreciseBounds repetitionBounds || isGreedy --Only specify non-greedy where space exists. + RegExDot.Repeatable.isGreedy = RegExDot.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 {-RegExDot.Repeatable.Repeatable PatternChar-}) <$> Test.QuickCheck.vector 2 {-[RepeatablePatternChar]-} + concatenation <- map (fmap deconstructPatternChar {-replace base-} . deconstructRepeatablePatternChar {-RegExDot.Repeatable.Repeatable PatternChar-}) `fmap` Test.QuickCheck.vector 2 {-[RepeatablePatternChar]-} hasSternAnchor <- Test.QuickCheck.arbitrary {-Bool-} return {-to Gen-monad-} $ ExtendedRegExChar.MkExtendedRegExChar False RegExDot.RegEx.MkExtendedRegEx { @@ -150,10 +139,6 @@ RegExDot.RegEx.sternAnchor = if hasSternAnchor then Just RegExDot.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'. @@ -170,7 +155,7 @@ RegExDot.ConsumptionProfile.hasSpecificRequirement = b } = RegExDot.Consumer.consumptionProfile r - prop_consumptionProfile2 r = RegExDot.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. + prop_consumptionProfile2 r = RegExDot.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 RegExDot.ConsumptionProfile.MkConsumptionProfile { RegExDot.ConsumptionProfile.hasSpecificRequirement = hasSpecificRequirement, @@ -178,7 +163,7 @@ } = RegExDot.Consumer.consumptionProfile r prop_io = Test.QuickCheck.label "prop_io" . ToolShed.Test.ReversibleIO.isReversible - prop_io' r = Test.QuickCheck.label "prop_io'" $ ToolShed.Test.ReversibleIO.isReversible r' where r' = ExtendedRegExChar.extendedRegEx r --Check "RegExDot.RegEx.ExtendedRegEx Char" too. + prop_io' r = Test.QuickCheck.label "prop_io'" $ ToolShed.Test.ReversibleIO.isReversible r' where r' = ExtendedRegExChar.extendedRegEx r -- Check "RegExDot.RegEx.ExtendedRegEx Char" too. prop_isValid r = Test.QuickCheck.label "prop_isValid" $ ToolShed.SelfValidate.isValid r prop_starHeight r = Test.QuickCheck.label "prop_starHeight" $ (RegExDot.Consumer.starHeight r == 0) == RegExDot.ConsumptionBounds.isPrecise (RegExDot.Consumer.getConsumptionBounds r) @@ -186,7 +171,7 @@ prop_double :: Double -> Test.QuickCheck.Property prop_double d = Test.QuickCheck.label "prop_double" $ RegExDot.RegEx.extractDataFromMatchList `fmap` RegExDot.Result.getMatchList result == Just s where s :: String - s = show $ d * 1e6 --Implementation of show, uses exponential notation, when the number is large. + s = show $ d * 1e6 -- Implementation of show, uses exponential notation, when the number is large. result :: RegExDot.RegEx.Result Char result = s +~ RegExDot.RegExOpts.mkRegEx ( diff --git a/src/Grecce/Test/QC/MetaChar.hs b/src/Grecce/Test/QC/MetaChar.hs --- a/src/Grecce/Test/QC/MetaChar.hs +++ b/src/Grecce/Test/QC/MetaChar.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -34,40 +33,29 @@ quickChecks ) where -import Control.Applicative((<$>)) import qualified Data.List -import qualified RegExChar.MetaChar as MetaChar --CAVEAT: beware of the similar name. +import qualified RegExChar.MetaChar as MetaChar -- CAVEAT: beware of the similar name. import qualified RegExDot.BracketExpression import qualified RegExDot.BracketExpressionMember import qualified RegExDot.Meta import qualified Test.QuickCheck import qualified ToolShed.Test.ReversibleIO --- 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` [RegExDot.Meta.shortcutToken, RegExDot.BracketExpression.negationToken]) [' ' .. '~'] --TODO: permit all characters. +testCharacters = filter (`notElem` [RegExDot.Meta.shortcutToken, RegExDot.BracketExpression.negationToken]) [' ' .. '~'] -- TODO: permit all characters. instance Test.QuickCheck.Arbitrary MetaChar.MetaChar where - arbitrary = Test.QuickCheck.oneof $ map (MetaChar.MkMetaChar <$>) [ + arbitrary = Test.QuickCheck.oneof $ map (fmap MetaChar.MkMetaChar) [ return {-to Gen-monad-} RegExDot.Meta.Any, - RegExDot.Meta.Literal <$> Test.QuickCheck.elements testCharacters, - RegExDot.Meta.AnyOf . map RegExDot.BracketExpressionMember.Literal . Data.List.nub <$> arbitraryCharList 1 16, --Test.QuickCheck.vector 16 {-Char-}, - RegExDot.Meta.NoneOf . map RegExDot.BracketExpressionMember.Literal . Data.List.nub <$> arbitraryCharList 1 4 + RegExDot.Meta.Literal `fmap` Test.QuickCheck.elements testCharacters, + (RegExDot.Meta.AnyOf . map RegExDot.BracketExpressionMember.Literal . Data.List.nub) `fmap` arbitraryCharList 1 16, -- Test.QuickCheck.vector 16 {-Char-}, + (RegExDot.Meta.NoneOf . map RegExDot.BracketExpressionMember.Literal . Data.List.nub) `fmap` 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 + (take (min j $ i `max` l) . Data.List.nub . Data.List.filter (`elem` testCharacters)) `fmap` Test.QuickCheck.vector maxBound {-Char-} type Testable = MetaChar.MetaChar -> Test.QuickCheck.Property diff --git a/src/Grecce/Test/QC/QuickChecks.hs b/src/Grecce/Test/QC/QuickChecks.hs --- a/src/Grecce/Test/QC/QuickChecks.hs +++ b/src/Grecce/Test/QC/QuickChecks.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {- Copyright (C) 2010 Dr. Alistair Ward @@ -26,6 +25,7 @@ run ) where +import qualified Control.Arrow import qualified Grecce.Test.QC.ExtendedRegExChar as Test.QC.ExtendedRegExChar import qualified Grecce.Test.QC.MetaChar as Test.QC.MetaChar import qualified Grecce.Test.QC.RepeatableMetaChar as Test.QC.RepeatableMetaChar @@ -35,18 +35,15 @@ The single Boolean flag enables verbose output. -} run :: Bool -> IO () -run isVerbose = - putStrLn "MetaChar" >> Test.QC.MetaChar.quickChecks checker - >> putStrLn "RepeatableMetaChar" >> Test.QC.RepeatableMetaChar.quickChecks checker - >> putStrLn "ExtendedRegExChar" >> Test.QC.ExtendedRegExChar.quickChecks checker - where - checker :: Test.QuickCheck.Testable t => t -> IO () - checker - | isVerbose = -#if MIN_VERSION_QuickCheck(2,4,0) - Test.QuickCheck.verboseCheck -#else - error "Grecce.Test.QC.QuickChecks:\t'Test.QuickCheck.verboseCheck' is only available as of 'QuickCheck-2.4'." -#endif - | otherwise = Test.QuickCheck.quickCheck +run isVerbose = mapM_ ( + uncurry (>>) . Control.Arrow.first putStrLn + ) [ + ("MetaChar", Test.QC.MetaChar.quickChecks checker), + ("RepeatableMetaChar", Test.QC.RepeatableMetaChar.quickChecks checker), + ("ExtendedRegExChar", Test.QC.ExtendedRegExChar.quickChecks checker) + ] where + checker :: Test.QuickCheck.Testable t => t -> IO () + checker + | isVerbose = Test.QuickCheck.verboseCheck + | otherwise = Test.QuickCheck.quickCheck diff --git a/src/Grecce/Test/QC/RepeatableMetaChar.hs b/src/Grecce/Test/QC/RepeatableMetaChar.hs --- a/src/Grecce/Test/QC/RepeatableMetaChar.hs +++ b/src/Grecce/Test/QC/RepeatableMetaChar.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE CPP #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -33,7 +32,6 @@ ) where import qualified Data.Maybe -import Control.Applicative((<$>)) import Grecce.Test.QC.MetaChar() import qualified RegExChar.MetaChar as MetaChar import qualified RegExDot.Consumer @@ -61,8 +59,8 @@ 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]] + fewest <- Test.QuickCheck.elements [0 .. 9] -- Could be more, but this is an adequate test. + most <- Test.QuickCheck.oneof [return Nothing, Just `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] isGreedy <- Test.QuickCheck.arbitrary let @@ -72,11 +70,8 @@ return {-to Gen-monad-} . MkRepeatableMetaChar $ RegExDot.Repeatable.MkRepeatable { RegExDot.Repeatable.base = metaChar, RegExDot.Repeatable.repetitionBounds = repetitionBounds, - RegExDot.Repeatable.isGreedy = RegExDot.Repeatable.hasPreciseBounds repetitionBounds || isGreedy --Only specify 'non-greedy' where space exists. + RegExDot.Repeatable.isGreedy = RegExDot.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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,5 @@ {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -28,17 +28,8 @@ [@TODO@] Coordinate the output of 'printVersion' with the definition in '.cabal'; this may not be feasible. -} -module Main( --- * Types --- ** Type-synonyms --- CommandLineAction, --- * Functions --- read', --- readCommandArg, - main -) where +module Main(main) where -import Control.Applicative((<$>)) import qualified Data.List import qualified Data.Version import qualified Distribution.Package @@ -51,7 +42,7 @@ import qualified Grecce.Test.Performance.ExtendedRegExTestsNegative as Test.Performance.ExtendedRegExTestsNegative import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive import qualified Grecce.Test.QC.QuickChecks as Test.QC.QuickChecks -import qualified Paths_regexchar as Paths --Either local stub, or package-instance autogenerated by 'Setup.hs build'. +import qualified Paths_regexchar as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'. import qualified RegExDot.CompilationOptions import qualified RegExDot.ExecutionOptions import qualified System.Console.GetOpt as G @@ -62,17 +53,17 @@ import qualified ToolShed.Defaultable -- | Used to thread user-defined command-line options, though the list of functions which implement them. -type CommandLineAction = CommandOptions.CommandOptions -> IO CommandOptions.CommandOptions --Supplied as the type-argument to 'G.OptDescr'. +type CommandLineAction = CommandOptions.CommandOptions -> IO CommandOptions.CommandOptions -- Supplied as the type-argument to 'G.OptDescr'. -- | On failure to parse the specified string, returns an explanatory error. read' :: Read a => String -> String -> a read' errorMessage s = case reads s of - [(x, _)] -> x + [(x, "")] -> x _ -> error $ errorMessage ++ show s -- | On failure to parse a command-line argument, returns an explanatory error. readCommandArg :: Read a => String -> a -readCommandArg = read' "Failed to parse command-line argument " +readCommandArg = read' "failed to parse command-line argument " {- | * Parses the command-line arguments, to determine 'CommandOptions.CommandOptions'. @@ -87,7 +78,7 @@ usageMessage :: String usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList ++ " [, ...]" ---Define the command-line options, & the 'CommandLineAction's used to handle them. +-- Define the command-line options, & the 'CommandLineAction's used to handle them. optDescrList :: [G.OptDescr CommandLineAction] optDescrList = [ -- String [String] (G.ArgDescr CommandLineAction) String @@ -132,7 +123,7 @@ ] where printVersion, printUsage :: IO CommandOptions.CommandOptions - printVersion = System.IO.hPutStrLn System.IO.stderr (Distribution.Text.display packageIdentifier ++ "\n\nCopyright (C) 2010 " ++ author ++ ".\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by " ++ author ++ ".") >> System.Exit.exitWith System.Exit.ExitSuccess where + printVersion = System.IO.hPutStrLn System.IO.stderr (Distribution.Text.display packageIdentifier ++ "\n\nCopyright (C) 2010-2015 " ++ author ++ ".\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by " ++ author ++ ".") >> System.Exit.exitWith System.Exit.ExitSuccess where packageIdentifier :: Distribution.Package.PackageIdentifier packageIdentifier = Distribution.Package.PackageIdentifier { Distribution.Package.pkgName = Distribution.Package.PackageName "grecce", @@ -153,10 +144,10 @@ uncurry $ Test.Performance.ExtendedRegEx.run (CommandOptions.executionOptions commandOptions) ) (readCommandArg s) >> System.Exit.exitWith System.Exit.ExitSuccess - readExtendedRegExCharFromFile s commandOptions = (head . dropWhile null . lines <$> readFile s) >>= (`setExtendedRegExChar` commandOptions) + readExtendedRegExCharFromFile s commandOptions = ((head . dropWhile null . lines) `fmap` readFile s) >>= (`setExtendedRegExChar` commandOptions) assertFromFile fileName commandOptions = do - failedTests <- Test.Assert.RegExOptsChar.findFailures (CommandOptions.compilationOptions commandOptions) (CommandOptions.executionOptions commandOptions) <$> Test.Assert.RegExOptsChar.readTests fileName + failedTests <- Test.Assert.RegExOptsChar.findFailures (CommandOptions.compilationOptions commandOptions) (CommandOptions.executionOptions commandOptions) `fmap` Test.Assert.RegExOptsChar.readTests fileName if null failedTests then System.Exit.exitWith System.Exit.ExitSuccess @@ -166,7 +157,7 @@ System.Exit.exitWith $ System.Exit.ExitFailure 2 assertPosixFromFile fileName _ = do - failedTests <- Test.Assert.RegExOptsChar.findFailuresPosix <$> Test.Assert.RegExOptsChar.readTests fileName + failedTests <- Test.Assert.RegExOptsChar.findFailuresPosix `fmap` Test.Assert.RegExOptsChar.readTests fileName if null failedTests then System.Exit.exitWith System.Exit.ExitSuccess @@ -176,7 +167,7 @@ System.Exit.exitWith $ System.Exit.ExitFailure 2 setExtendedRegExChar s commandOptions = case CommandOptions.extendedRegExChar commandOptions of - Just extendedRegExChar -> error $ "The regex has already been defined as /" ++ show extendedRegExChar ++ "/" + Just extendedRegExChar -> fail $ "The regex has already been defined as /" ++ show extendedRegExChar ++ "/" _ -> return {-to IO-monad-} commandOptions { CommandOptions.extendedRegExChar = Just $ readCommandArg s } abortTrialRepetitionsOnInherentFailure, {-abortTrialRepetitionsOnZeroConsumption, bypassInputDataForLiberalConsumer,-} catchIncompatibleAnchors, checkExistenceOfInelasticTail, checkForUnconsumableData, moderateGreed, permitReorderingOfAlternatives, preferAlternativesWhichFeedTheGreedy, preferAlternativesWhichMimickUnrolling, preferFewerRepeatedAlternatives, unrollRepeatedSingletonAlternative, useFirstMatchAmongAlternatives, validateMinConsumptionOfAlternatives :: CommandOptions.ExecutionOptionsMutator @@ -209,8 +200,8 @@ -- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr Action] -> [String] -> ([Action], [String], [String]) case G.getOpt G.RequireOrder optDescrList args of (commandLineActions, nonOptions, []) -> do - commandOptions <- Data.List.foldl' (>>=) (return {-to IO-monad-} ToolShed.Defaultable.defaultValue) commandLineActions --Sequentially transform the 'CommandOptions', using 'CommandLineAction's corresponding to the specified command-line flags. + commandOptions <- Data.List.foldl' (>>=) (return {-to IO-monad-} ToolShed.Defaultable.defaultValue) commandLineActions -- Sequentially transform the 'CommandOptions', using 'CommandLineAction's corresponding to the specified command-line flags. - Grep.grep commandOptions nonOptions --Perform the requested match, against the list of input-data files. - (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concat errors ++ usageMessage --Throw. + Grep.grep commandOptions nonOptions -- Perform the requested match, against the list of input-data files. + (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concat errors ++ usageMessage -- Throw. diff --git a/src/RegExChar/ExtendedRegExChar.hs b/src/RegExChar/ExtendedRegExChar.hs --- a/src/RegExChar/ExtendedRegExChar.hs +++ b/src/RegExChar/ExtendedRegExChar.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -33,6 +33,7 @@ (/~) ) where +import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. import Control.Applicative((<$>), (<*>)) import qualified Data.List import qualified RegExChar.MetaChar as MetaChar @@ -47,7 +48,7 @@ import qualified ToolShed.Data.Pair import qualified ToolShed.SelfValidate -infix 4 +~, =~, /~ --Same as (==) & (/=). +infix 4 +~, =~, /~ -- Same as (==) & (/=). -- | Specialise a 'RegExDot.RegEx.ExtendedRegEx' for 'Char', & encapsulate it to permit tailored instance-declarations. data ExtendedRegExChar = MkExtendedRegExChar { @@ -85,14 +86,14 @@ }, "" ) - ] --The order of adjacent zero-width assertions is irrelevant. + ] -- The order of adjacent zero-width assertions is irrelevant. | otherwise = let extendedRegExCharParser :: Parsec.Parser ExtendedRegExChar extendedRegExCharParser = reduce {-correct prior assumption-} <$> alternativesParser {-assume non-capturing top-level Alternatives-} where reduce :: RegExDot.RegEx.Alternatives Char -> ExtendedRegExChar reduce alternatives | RegExDot.RegEx.isSingletonAlternatives alternatives = MkExtendedRegExChar False . head $ RegExDot.RegEx.deconstructAlternatives alternatives - | otherwise = MkExtendedRegExChar True $ RegExDot.Anchor.unanchored <~> RegExDot.RegEx.CaptureGroup alternatives -: [] --Infer non-capturing top-level 'RegExDot.RegEx.Alternatives' from the presence of 'RegExDot.RegEx.alternativeExtendedRegExSeparatorToken's. + | otherwise = MkExtendedRegExChar True $ RegExDot.Anchor.unanchored <~> RegExDot.RegEx.CaptureGroup alternatives -: [] -- Infer non-capturing top-level 'RegExDot.RegEx.Alternatives' from the presence of 'RegExDot.RegEx.alternativeExtendedRegExSeparatorToken's. alternativesParser :: Parsec.Parser (RegExDot.RegEx.Alternatives Char) alternativesParser = RegExDot.RegEx.MkAlternatives <$> extendedRegExParser `Parsec.sepBy1` (Parsec.char RegExDot.RegEx.alternativeExtendedRegExSeparatorToken "RegExDot.RegEx.alternativeExtendedRegExSeparatorToken " ++ show RegExDot.RegEx.alternativeExtendedRegExSeparatorToken) where @@ -107,7 +108,7 @@ ToolShed.Data.Pair.mirror Parsec.char RegExDot.RegEx.captureGroupDelimiters ) alternativesParser {-recurse-} "RegExDot.RegEx.captureGroupDelimiters " ++ show RegExDot.RegEx.captureGroupDelimiters - extendedRegEx' <- extendedRegExParser --Recurse. + extendedRegEx' <- extendedRegExParser -- Recurse. return {-to ParsecT-monad-} $ RegExDot.RegEx.transformExtendedRegEx ((repeatableRequirementList ++) . (repeatableCaptureGroup :)) extendedRegEx' { RegExDot.RegEx.bowAnchor = maybeBowAnchor } ) <|> ( @@ -139,11 +140,11 @@ ] in ( - error . ("readsPrec RegExChar.ExtendedRegExChar:\tparse-error; " ++) . show --Failure to parse. + error . ("readsPrec RegExChar.ExtendedRegExChar:\tparse-error; " ++) . show -- Failure to parse. ) `either` ( \pair@(extendedRegExChar, _) -> if ToolShed.SelfValidate.isValid extendedRegExChar then [pair] - else error $ ToolShed.SelfValidate.getFirstError extendedRegExChar --Parsed OK, but invalid. + else error $ ToolShed.SelfValidate.getFirstError extendedRegExChar -- Parsed OK, but invalid. ) $ Parsec.parse ( (,) <$> extendedRegExCharParser <*> Parsec.getInput ) "ExtendedRegExChar" s @@ -174,7 +175,7 @@ RegExDot.RegEx.CaptureGroup alternatives -> showChar ( fst RegExDot.RegEx.captureGroupDelimiters ) . foldr (.) ( - showChar $ snd RegExDot.RegEx.captureGroupDelimiters --Initial value. + showChar $ snd RegExDot.RegEx.captureGroupDelimiters -- Initial value. ) ( showAlternatives alternatives ) @@ -188,14 +189,14 @@ :: InputData -- ^ The input-data string. -> RegExDot.RegExOpts.RegExOpts ExtendedRegExChar -- ^ The match-options, parameterised by the regex-specification. -> RegExDot.RegEx.Result Char -inputData +~ regExOpts = inputData RegExDot.RegEx.+~ fmap extendedRegEx regExOpts --CAVEAT: . +inputData +~ regExOpts = inputData RegExDot.RegEx.+~ fmap extendedRegEx regExOpts -- CAVEAT: . -- | A veneer over the underlying polymorphic operator, 'RegExDot.RegEx.=~'. (=~) :: InputData -- ^ The input-data string. -> RegExDot.RegExOpts.RegExOpts ExtendedRegExChar -- ^ The match-options, parameterised by the regex-specification. -> Bool -inputData =~ regExOpts = inputData RegExDot.RegEx.=~ fmap extendedRegEx regExOpts --CAVEAT: . +inputData =~ regExOpts = inputData RegExDot.RegEx.=~ fmap extendedRegEx regExOpts -- CAVEAT: . -- | Pattern-mismatch operator. (/~) diff --git a/src/RegExChar/MetaChar.hs b/src/RegExChar/MetaChar.hs --- a/src/RegExChar/MetaChar.hs +++ b/src/RegExChar/MetaChar.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -60,6 +60,7 @@ deconstruct ) where +import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. import Control.Applicative((<$>), (<*>)) import Control.Arrow((***)) import qualified Data.Char @@ -154,7 +155,7 @@ literalBracketExpressionTerminator <- Parsec.option [] {-default-} $ return {-to List-monad-} . RegExDot.BracketExpressionMember.Literal <$> ( Parsec.char (snd RegExDot.BracketExpression.delimiterTokens) "Literal Bracket-expression terminator " ++ show (snd RegExDot.BracketExpression.delimiterTokens) - ) --If the first item in a BracketExpression (or negated BracketExpression) is the terminator-token, then it is treated as a 'RegExDot.BracketExpressionMember.Literal'. + ) -- If the first item in a BracketExpression (or negated BracketExpression) is the terminator-token, then it is treated as a 'RegExDot.BracketExpressionMember.Literal'. cTor . (literalBracketExpressionTerminator ++) <$> Parsec.many {-potentially zero-} ( Parsec.choice [ @@ -165,7 +166,7 @@ return {-to ParsecT-monad-} $ case RegExDot.BracketExpressionMember.findPredicate c of Just showablePredicate -> RegExDot.BracketExpressionMember.Predicate showablePredicate - _ -> RegExDot.BracketExpressionMember.Literal c --Escaped literal. + _ -> RegExDot.BracketExpressionMember.Literal c -- Escaped literal. ) "Perl-style shortcut", Parsec.try ( uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.string posixCharacterClassDelimiters) ( @@ -176,7 +177,7 @@ Just showablePredicate -> return {-to ParsecT-monad-} $ RegExDot.BracketExpressionMember.Predicate showablePredicate _ -> Parsec.unexpected $ "MetaChar.metaCharParser:\tunrecognised Posix Character-class; " ++ show identifier ) "Posix Character-class " ++ show posixCharacterClassDelimiters - ), --Regurgitate erroneously consumed input. + ), -- Regurgitate erroneously consumed input. Parsec.try ( ( do @@ -188,10 +189,10 @@ rangeStart, bracketExpressionRangeToken, rangeEnd - ] $ \c -> rangeStart <= c && c <= rangeEnd --Create custom predicate, utilising "Ord Char". + ] $ \c -> rangeStart <= c && c <= rangeEnd -- Create custom predicate, utilising "Ord Char". ) "Bracket-expression range" - ), --Regurgitate erroneously consumed input. - RegExDot.BracketExpressionMember.Literal <$> Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] "RegExDot.BracketExpressionMember.Literal" --TODO: the first Char-member can be a literal ']'. + ), -- Regurgitate erroneously consumed input. + RegExDot.BracketExpressionMember.Literal <$> Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] "RegExDot.BracketExpressionMember.Literal" -- TODO: the first Char-member can be a literal ']'. ] "Bracket-expression member" ) "Bracket-expression member-list" ) "RegExDot.BracketExpression.delimiterTokens " ++ show RegExDot.BracketExpression.delimiterTokens, @@ -200,7 +201,7 @@ instance Read MetaChar where readsPrec _ = ( - (error . ("readsPrec RegExChar.MetaChar:\tparse-error; " ++) . show) `either` return + (fail . ("readsPrec RegExChar.MetaChar:\tparse-error; " ++) . show) `either` return ) . Parsec.parse ( (,) <$> metaCharParser <*> Parsec.getInput ) "MetaChar" @@ -236,15 +237,15 @@ RegExDot.BracketExpressionMember.Predicate showablePredicate -> shows showablePredicate RegExDot.BracketExpressionMember.Literal literal -> ( if literal `elem` [ - bracketExpressionRangeToken, --CAVEAT: only unambiguously literal when at the start or end of a "BracketExpression". + bracketExpressionRangeToken, -- CAVEAT: only unambiguously literal when at the start or end of a "BracketExpression". RegExDot.Meta.shortcutToken, - snd RegExDot.BracketExpression.delimiterTokens --CAVEAT: only unambiguously literal when at the start of a "BracketExpression". + snd RegExDot.BracketExpression.delimiterTokens -- CAVEAT: only unambiguously literal when at the start of a "BracketExpression". ] then showChar RegExDot.Meta.shortcutToken else id ) . showChar literal ) ( - showChar (snd RegExDot.BracketExpression.delimiterTokens) "" --Initial value. + showChar (snd RegExDot.BracketExpression.delimiterTokens) "" -- Initial value. ) bracketExpression ) showsPrec _ (MkMetaChar (RegExDot.Meta.NoneOf bracketExpression)) = showChar x . showChar RegExDot.BracketExpression.negationToken . showString xs where (x : xs) = show . MkMetaChar $ RegExDot.Meta.AnyOf bracketExpression diff --git a/src/RegExChar/RegExOptsChar.hs b/src/RegExChar/RegExOptsChar.hs --- a/src/RegExChar/RegExOptsChar.hs +++ b/src/RegExChar/RegExOptsChar.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {- - Copyright (C) 2010 Dr. Alistair Ward + Copyright (C) 2010-2015 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 @@ -49,7 +49,6 @@ -- hasNonCapturingTopLevelAlternatives ) where -import Control.Applicative((<$>)) import qualified Data.Array.IArray import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar import qualified RegExDot.CompilationOptions @@ -62,12 +61,12 @@ import qualified RegExDot.Result import qualified RegExDot.Tree import qualified Text.Regex.Base.RegexLike as RegexLike -import Text.Regex.Base.Context() --Instance-declarations. +import Text.Regex.Base.Context() -- Instance-declarations. import qualified ToolShed.Data.List import qualified ToolShed.Defaultable import qualified ToolShed.Options -infix 4 =~ --Same as (==). +infix 4 =~ -- Same as (==). -- | Defines a specific instance of the polymorphic base-type. type RegExOptsChar = RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar @@ -88,7 +87,7 @@ setExecOpts e r = r { RegExDot.RegExOpts.executionOptions = e } getExecOpts = RegExDot.RegExOpts.executionOptions ---Newer versions of this 'Text.Regex.Base.RegexLike.RegexMaker' have additional monadic methods, which can fail on parse-errors. +-- Newer versions of this 'Text.Regex.Base.RegexLike.RegexMaker' have additional monadic methods, which can fail on parse-errors. instance RegexLike.RegexMaker RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions String where makeRegexOpts c e source = RegExDot.RegExOpts.MkRegExOpts { RegExDot.RegExOpts.compilationOptions = c, @@ -118,13 +117,13 @@ -> RegExDot.ConsumptionBounds.DataLength -- ^ The offset to use for zero-length match. -> RegExDot.RegEx.MatchList Char -- ^ The list of matches. -> [MatchDataSpan] -toMatchDataSpanList _ offset [] = [RegExDot.DataSpan.empty offset] --The whole regex matched, but consumed nothing. +toMatchDataSpanList _ offset [] = [RegExDot.DataSpan.empty offset] -- The whole regex matched, but consumed nothing. toMatchDataSpanList strictPosixCompliance _ matchList = RegExDot.DataSpanTree.extractCaptureGroups strictPosixCompliance . return {-to List-monad-} . RegExDot.Tree.Node . return {-to List-monad-} $ RegExDot.DataSpanTree.toTreeList matchList -- | Optionally remove the 2nd element from the list, where it represents the data captured by a groups of top-level 'Alternatives', which weren't explicitly delimited & therefore are non-capturing. exciseNonCapturingTopLevelAlternatives :: RegExOptsChar -> [MatchDataSpan] -> [MatchDataSpan] exciseNonCapturingTopLevelAlternatives regExOptsChar - | hasNonCapturingTopLevelAlternatives regExOptsChar = ToolShed.Data.List.excise 1 --The zeroeth represents the whole regex, the 1st represents the top-level non-capturing group of Alternatives, & the remainder represent explicitly delimited groups. + | hasNonCapturingTopLevelAlternatives regExOptsChar = ToolShed.Data.List.excise 1 -- The zeroeth represents the whole regex, the 1st represents the top-level non-capturing group of Alternatives, & the remainder represent explicitly delimited groups. | otherwise = id -- | Convert the specified list, into a zero-indexed array. @@ -142,7 +141,7 @@ -> [RegExDot.RegEx.MatchList Char] matchUntilFailure regExOptsChar inputData = shiftOffsets 0 $ matchUntilFailure' inputData where matchUntilFailure' :: ExtendedRegExChar.InputData -> [RegExDot.RegEx.MatchList Char] - matchUntilFailure' unmatchedInputData = case unmatchedInputData ExtendedRegExChar.+~ regExOptsChar of --CAVEAT: . + matchUntilFailure' unmatchedInputData = case unmatchedInputData ExtendedRegExChar.+~ regExOptsChar of -- CAVEAT: . (_, Just matchList, maybeSternAnchorResult) -> matchList : if null (RegExDot.RegEx.extractDataFromMatchList matchList) then [] else matchUntilFailure' (RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult) _ -> [] @@ -173,20 +172,22 @@ array (0,2) [(0,(1,4)),(1,(2,2)),(2,(3,1))] -} -- matchOnce :: RegExOptsChar -> ExtendedRegExChar.InputData -> Maybe RegexLike.MatchArray - matchOnce regExOptsChar inputData = toZeroIndexedArray . map snd {-span-} . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList ( - complyStrictlyWithPosix regExOptsChar - ) ( - RegExDot.RegEx.externalMatchLength $ RegExDot.Result.getPreMatch extendedRegExResult - ) <$> RegExDot.Result.getMatchList extendedRegExResult where + matchOnce regExOptsChar inputData = ( + toZeroIndexedArray . map snd {-span-} . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList ( + complyStrictlyWithPosix regExOptsChar + ) ( + RegExDot.RegEx.externalMatchLength $ RegExDot.Result.getPreMatch extendedRegExResult + ) + ) `fmap` RegExDot.Result.getMatchList extendedRegExResult where extendedRegExResult :: RegExDot.RegEx.Result Char - extendedRegExResult = inputData ExtendedRegExChar.+~ regExOptsChar --CAVEAT: . + extendedRegExResult = inputData ExtendedRegExChar.+~ regExOptsChar -- CAVEAT: . {- E.g.: ("xabcdx" RegExOptsChar.=~ "a(b(c?))*d") :: (String, Text.Regex.Base.RegexLike.MatchText String, String) ("x",array (0,2) [(0,("abcd",(1,4))),(1,("bc",(2,2))),(2,("c",(3,1)))],"x") -} -- matchOnceText :: RegExOptsChar -> ExtendedRegExChar.InputData -> Maybe (ExtendedRegExChar.InputData, MatchText ExtendedRegExChar.InputData, ExtendedRegExChar.InputData) - matchOnceText regExOptsChar inputData = case inputData ExtendedRegExChar.+~ regExOptsChar of --CAVEAT: . + matchOnceText regExOptsChar inputData = case inputData ExtendedRegExChar.+~ regExOptsChar of -- CAVEAT: . (maybeBowAnchorResult, Just matchList, maybeSternAnchorResult) -> Just ( RegExDot.RegEx.extractDataFromMatch' maybeBowAnchorResult, toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar $ toMatchDataSpanList ( @@ -203,7 +204,7 @@ True -} -- matchTest :: RegExOptsChar -> ExtendedRegExChar.InputData -> Bool - matchTest = flip (ExtendedRegExChar.=~) --CAVEAT: . + matchTest = flip (ExtendedRegExChar.=~) -- CAVEAT: . {- | * Match-operator.