diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,24 @@ +# **RegExChar**. + +This is **RegExChar**, a regex-engine built from the polymorphic regex-engine 'RegExDot' as a proof of concept. + +## Installation + +It can be built and installed using [Cabal](https://www.haskell.org/cabal/users-guide/installing-packages.html). + +## Documentation + +* The directory **man/** contains the documentation. +* More information about this application can be found at [RegExChar](http://functionalley.eu/RegExChar/regExChar.html). + +## License + +For information on copying and distributing this package, see the file **LICENSE** in this directory. + +## Bug-reporting + +Bug-reports should be emailed to . + +## Author + +This application is written and maintained by Dr. Alistair Ward. diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,66 +0,0 @@ -2010-11-18 Dr. Alistair Ward - -0.9.0.0 - * First version of the package. -0.9.0.1 - * Reacted to major-number changes in the packages 'ToolShed-0.10.0.0' & 'RegExDot-0.10.0.0'. - * Created "src/RegExChar/" (& then modified module-names accordingly) & "data/" sub-directories. - * Pacified 'hlint'. - * Added a makefile. - * Qualified identifiers used in error-messages. -0.9.0.2 - * Ported to ghc-7.0.1: - Replaced the deprecated module "Test.QuickCheck.Batch", & labelled properties. - * Added the cabal-flag 'threaded', to account for the requirement to link with the threaded runtime when using a threaded version of the library package "RegExDot". -0.9.0.3 - * Parallelised processing where @grecce@ is requested to read multiple input-data files. - * Extracted matching-operation from the "Main" module, into new module "Grecce.Grep". - * Migrated modules required only by the executable 'grecce', from the directory "RegExChar" into the new directory "Grecce". - * Replaced use of @threaded@-flag in source-code, with CABAL CPP-macro. - * Added RPM-spec file. -0.9.0.4 - * Added default values of command-line flags, to usage-message. - * Reacted to migration of "RegExDot.Options" to "ToolShed.Options". - * Used new "ToolShed.Package" module. -0.9.0.5 - * Fixed negated reference to unparenthesised CPP-macro 'MIN_VERSION'. - * Protected reference in "Grecce/QC/QuickChecks.hs", to 'Test.QuickCheck.verboseCheck', using CPP-statement. -0.9.0.6 - * Amended RPM ".spec" file, to install under "/usr", rather than "/usr/local". - * Renamed package from 'RegExChar' to 'regexchar', for compatibility with Debian's ".deb"-format. - * Added directory-structure required to build ".deb" package. -0.9.0.7 - * Refined man-page to be an 'extra-source-file' in .cabal & .spec files. - * Added manually controlled "llvm" flag to "regexchar.cabal". - * Replaced references to the module "ToolShed.Package" with "Distribution.Package". - * Changed identifier for type-parameters, to better reflect its role. - * Removed dependency on archaic module "ToolShed.Arithmetic". - * Reacted to the creation of module "ToolShed.Defaultable". - * Uploaded to . -0.9.0.8 - * Amended 'regexchar.cabal' to more correctly specify dependency on package 'toolshed'. - * Used new module "ToolShed.Pair" from package toolshed-0.12.0.0. - * Relocated modules "Grecce.Assert", "Grecce.Performance" and "Grecce.QC", into new layer "Test", in module-hierarchy. - * Guarded 'eager-blackholing' flag in cabal file. -0.9.0.9 - * Recoded "RegExChar.RegExOptsChar" to the interface "Data.Array.IArray.IArray", rather than the data-type "Data.Array.Array". - * Replaced '(+ 1)' and '(- 1)' with the faster calls 'succ' and 'pred', in "RegExChar.RegExOptsChar", "Grecce.Test.Performance.ExtendedRegExTestsPositive" and "Grecce.Grep". - * Used 'Paths_regexchar.version' in 'Main', rather than hard-coding it. - * Reacted to new module-hierarchy and addition of method 'ToolShed.SelfValidate.getErrors', in toolshed-0.13.0.0, and used it to improved error-reporting in @instance Read RegExChar.ExtendedRegExChar.ExtendedRegExChar@. - * Replaced use of "Control.Monad" in "RegExChar.MetaChar" and "RegExChar.ExtendedRegExChar", with "Control.Applicative". - * Replaced "System" with "System.Environment" and "System.Exit". - * Removed dependency on "haskell98". -0.9.0.10 - * Fully qualified symbols imported from package "regexdot". - * 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.markdown b/changelog.markdown new file mode 100644 --- /dev/null +++ b/changelog.markdown @@ -0,0 +1,77 @@ +# 2010-11-18 Dr. Alistair Ward + +## 0.9.0.0 + * First version of the package. +## 0.9.0.1 + * Reacted to major-number changes in the packages **ToolShed-0.10.0.0** & **RegExDot-0.10.0.0**. + * Created **src/RegExChar/** (& then modified module-names accordingly) & **data/** sub-directories. + * Pacified **hlint**. + * Added a makefile. + * Qualified identifiers used in error-messages. +## 0.9.0.2 + * Ported to ghc-7.0.1: + Replaced the deprecated module **Test.QuickCheck.Batch**, & labelled properties. + * Added the cabal-flag **threaded**, to account for the requirement to link with the threaded runtime when using a threaded version of the library package **RegExDot**. +## 0.9.0.3 + * Parallelised processing where **grecce** is requested to read multiple input-data files. + * Extracted matching-operation from the **Main** module, into new module **Grecce.Grep**. + * Migrated modules required only by the executable **grecce**, from the directory **RegExChar** into the new directory **Grecce**. + * Replaced use of @threaded@-flag in source-code, with CABAL CPP-macro. + * Added *.spec*-file. +## 0.9.0.4 + * Added default values of command-line flags, to usage-message. + * Reacted to migration of **RegExDot.Options** to **ToolShed.Options**. + * Used new **ToolShed.Package** module. +## 0.9.0.5 + * Fixed negated reference to unparenthesised CPP-macro **MIN_VERSION**. + * Protected reference in **Grecce/QC/QuickChecks.hs**, to `Test.QuickCheck.verboseCheck`, using CPP-statement. +## 0.9.0.6 + * Amended RPM *.spec*-file, to install under **/usr**, rather than **/usr/local**. + * Renamed package from **RegExChar** to **regexchar**, for compatibility with Debian's *.deb*-format. + * Added directory-structure required to build *.deb*-package. +## 0.9.0.7 + * Redefined man-page to be an **extra-source-file** in the *.cabal*-file & the *.spec*-file. + * Added manually controlled **llvm** flag to the *.cabal*-file. + * Replaced references to the module **ToolShed.Package** with **Distribution.Package**. + * Changed identifier for type-parameters, to better reflect its role. + * Removed dependency on archaic module **ToolShed.Arithmetic**. + * Reacted to the creation of module **ToolShed.Defaultable**. + * Uploaded to [Hackage](http://hackage.haskell.org/packages/hackage.html). +## 0.9.0.8 + * Amended the *.cabal*-file to more correctly specify dependency on package **toolshed**. + * Used new module **ToolShed.Pair** from package toolshed-0.12.0.0. + * Relocated modules **Grecce.Assert**, **Grecce.Performance** and **Grecce.QC**, into new layer **Test**, in module-hierarchy. + * Guarded **eager-blackholing** flag in the *cabal*-file. +## 0.9.0.9 + * Recoded **RegExChar.RegExOptsChar** to the interface `Data.Array.IArray.IArray`, rather than the data-type `Data.Array.Array`. + * Replaced `(+ 1)` and `(- 1)` with the faster calls `succ` and `pred`, in **RegExChar.RegExOptsChar**, **Grecce.Test.Performance.ExtendedRegExTestsPositive** and **Grecce.Grep**. + * Used `Paths_regexchar.version` in **Main**, rather than hard-coding it. + * Reacted to new module-hierarchy and addition of method `ToolShed.SelfValidate.getErrors`, in **toolshed-0.13.0.0**, and used it to improved error-reporting in @instance Read RegExChar.ExtendedRegExChar.ExtendedRegExChar@. + * Replaced use of `Control.Monad` in **RegExChar.MetaChar** and **RegExChar.ExtendedRegExChar**, with `Control.Applicative`. + * Replaced `System` with `System.Environment` and `System.Exit`. + * Removed dependency on **haskell98**. +## 0.9.0.10 + * Fully qualified symbols imported from package **regexdot**. + * 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 the *.cabal*-file. + * Tested with **haskell-platform-2013.2.0.0**. + * Replaced preprocessor-directives with **build-depends** constraints in the *.cabal*-file. +## 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**.. +## 0.9.0.13 + * Added the compiler to the output returned for the command-line option **version**. + * Changed flag **threaded** in the *.cabal*-file to **manual**. + * Added **Default-language**-specification to the *.cabal*-file. + * Added file **README.markdown**. + * Converted this file to markdown-format. + * Replaced `System.Exit.exitWith System.Exit.ExitSuccess` with `System.Exit.exitSuccess`. + * Moved the entry-point to the test-suite from **Main.hs** to **Test.hs**, both to integrate with **cabal** & to minimise the dependencies of the executable. + * Partitioned the source-files into **src-lib**, **src-exe**, & **src-test** directories, & referenced them individually from the *.cabal*-file to avoid repeated compilation. + * Used **CPP** to control the import of symbols from **Control.Applicative**. + diff --git a/copyright b/copyright --- a/copyright +++ b/copyright @@ -5,7 +5,7 @@ Copyright (C) 2010-2011 Dr. Alistair Ward. All Rights Reserved. Home-page: - http://functionalley.eu + http://functionalley.eu/RegExChar/regExChar.html License: GNU GENERAL PUBLIC LICENSE Version 3; see '/usr/share/common-licenses/GPL-3' or '/usr/share/doc/licenses/gpl-3.0.txt' where available, or the local packaged file 'LICENSE'. diff --git a/debian/DEBIAN/control b/debian/DEBIAN/control --- a/debian/DEBIAN/control +++ b/debian/DEBIAN/control @@ -1,14 +1,13 @@ Package: regexchar -Version: 0.9.0.12-1 +Version: 0.9.0.13-1 Section: text Priority: optional -#Architecture: i386 Architecture: amd64 Depends: libc6 -Installed-size: 3496 +Installed-size: 3222 Maintainer: Dr. Alistair Ward Provides: -Homepage: http://functionalley.eu +Homepage: http://functionalley.eu/RegExChar/regExChar.html 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 deleted file mode 100644 --- a/makefile +++ /dev/null @@ -1,81 +0,0 @@ -# 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 -# 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 . - -.PHONY: all build check clean clobber configure copy deb haddock help hlint install lintian prof rpm rpmlint sdist - -PACKAGE_NAME=regexchar - -all: install - -install: build haddock - @[ -z "$$CABAL_INSTALL_OPTIONS" ] || echo "INFO: CABAL_INSTALL_OPTIONS='$$CABAL_INSTALL_OPTIONS'" - runhaskell Setup $@ $$CABAL_INSTALL_OPTIONS - -prof: - CABAL_CONFIGURE_OPTIONS="--enable-library-profiling --enable-executable-profiling $$CABAL_CONFIGURE_OPTIONS" make build - -copy: build - @[ -z "$$CABAL_COPY_OPTIONS" ] || echo "INFO: CABAL_COPY_OPTIONS='$$CABAL_COPY_OPTIONS'" - runhaskell Setup $@ $$CABAL_COPY_OPTIONS - -build: configure - @[ -z "$$CABAL_BUILD_OPTIONS" ] || echo "INFO: CABAL_BUILD_OPTIONS='$$CABAL_BUILD_OPTIONS'" - runhaskell Setup $@ $$CABAL_BUILD_OPTIONS - -configure: $(PACKAGE_NAME).cabal Setup.hs - @[ -z "$$CABAL_CONFIGURE_OPTIONS" ] || echo "INFO: CABAL_CONFIGURE_OPTIONS='$$CABAL_CONFIGURE_OPTIONS'" - runhaskell Setup $@ $$CABAL_CONFIGURE_OPTIONS #--user - -haddock: configure - PATH=~/.cabal/bin:$$PATH runhaskell Setup $@ --hyperlink-source --executables #Amend path to find 'HsColour', as required for 'hyperlink-source'. - -hlint: - @$@ -i 'Use ||' src/ +RTS -N - -sdist: - TAR_OPTIONS='--format=ustar' runhaskell Setup $@ - -check: - cabal upload --check --verbose=3 dist/*.tar.gz; - -rpm: $(PACKAGE_NAME).spec - rpmbuild -bb --nodeps -- $^ - mv -- `find ~/rpmbuild -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./ - -rpmlint: $(PACKAGE_NAME).spec - @$@ $^ - -deb: build - mkdir -p debian/usr/bin/ && strip --strip-all dist/build/grecce/grecce && mv dist/build/grecce/grecce debian/usr/bin/ - mkdir -p 'debian/usr/share/doc/$(PACKAGE_NAME)/' && cp changelog changelog.Debian copyright LICENSE 'debian/usr/share/doc/$(PACKAGE_NAME)/' && cd 'debian/usr/share/doc/$(PACKAGE_NAME)/' && gzip --best -f changelog changelog.Debian LICENSE - cp 'copyright' 'debian/usr/share/doc/$(PACKAGE_NAME)/' - mkdir -p 'debian/usr/share/$(PACKAGE_NAME)/' && cp -R data/ 'debian/usr/share/$(PACKAGE_NAME)/' - mkdir -p debian/usr/share/ && cp -R man/ debian/usr/share/ && gzip --best -f debian/usr/share/man/man1/*.1 - cd 'debian' && md5sum `find usr -type f -print` >'DEBIAN/md5sums' - fakeroot dpkg-deb --build debian . - -lintian: - lintian -v *.deb - -clean: - runhaskell Setup $@ - rm -rf 'debian/usr/' 'debian/DEBIAN/md5sums' - find src -type f \( -name '*.hc' -o -name '*.hcr' -o -name '*.hi' -o -name '*.o' \) -delete - -clobber: clean - rm -f -- *.rpm *.deb - -help: - @grep '^[a-zA-Z].*:' makefile | sed -e 's/:.*//' diff --git a/man/man1/grecce.1 b/man/man1/grecce.1 --- a/man/man1/grecce.1 +++ b/man/man1/grecce.1 @@ -131,9 +131,6 @@ Display the currently defined options & then exit. .SS Test .TP -\fB--runQuickChecks\fR -Uses \fBQuickCheck\fR to validate invariant properties, using arbitrary data; then exits. -.TP \fB--assert=\fR\fIfile\fR Confirms the assertions in the specified file from the \fBdata\fR-directory of the distribution; then exits. .SH EXIT-STATUS @@ -181,7 +178,7 @@ Written by Dr. Alistair Ward. .SH BUGS .SS "REPORTING BUGS" -Report bugs to \fBgrecce\fR \fIat\fR \fBfunctionalley\fR \fIdot\fR \fBeu\fR +Report bugs to <\fBgrecce\fR \fIat\fR \fBfunctionalley\fR \fIdot\fR \fBeu\fR>. .SS Known Bugs There is no support for either \fIBack-references\fR or \fICase-insensitivity\fR. .PP @@ -189,7 +186,7 @@ .PP File-reading is rather slow, due to the inability to optimise the underlying polymorphic regex-engine for Characters. .SH COPYRIGHT -Copyright \(co 2010 Dr. Alistair Ward +Copyright \(co 2010-2015 Dr. Alistair Ward .PP 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. .PP @@ -198,7 +195,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see \fB\fR. .SH "SEE ALSO" .IP \(bu -Home-page: \fBhttp://functionalley.eu\fR +Home-page: \fBhttp://functionalley.eu/RegExChar/regExChar\fR .IP \(bu Source-documentation is generated by "\fBHaddock\fR", & is available in the distribution. .IP \(bu diff --git a/regexchar.cabal b/regexchar.cabal --- a/regexchar.cabal +++ b/regexchar.cabal @@ -1,35 +1,65 @@ --- Package-properties -Name: regexchar -Version: 0.9.0.12 -Cabal-Version: >= 1.6 -Copyright: (C) 2010-2015 Dr. Alistair Ward -License: GPL -License-file: LICENSE -Author: Dr. Alistair Ward -Stability: Stable interface, incomplete features. -Synopsis: A POSIX, extended regex-engine. -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, 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 changelog.Debian debian/DEBIAN/control makefile man/man1/grecce.1 regexchar.spec +-- This file is part of RegExChar. +-- +-- RegExChar 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. +-- +-- RegExChar 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 RegExChar. If not, see . -flag threaded - Description: Link with the threaded runtime. - default: True +Name: regexchar +Version: 0.9.0.13 +Cabal-version: >= 1.10 +Copyright: (C) 2010-2015 Dr. Alistair Ward +License: GPL +License-file: LICENSE +Author: Dr. Alistair Ward +Stability: stable +Synopsis: A POSIX, extended regex-engine. +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, GHC == 7.6, GHC == 7.8, GHC == 7.10 +Homepage: http://functionalley.eu/RegExChar/regExChar.html +Maintainer: mailto regexchar functionalley eu +Bug-reports: mailto regexchar functionalley eu --- Turn on using: 'runhaskell ./Setup.hs configure -f llvm'. +-- These files can be read by the application from 'Paths_weekdaze.datadir'. +Data-files: + data/*.txt + +-- None of these files are needed at run-time. +Extra-source-files: + changelog.Debian + changelog.markdown + copyright + debian/DEBIAN/control + man/man1/grecce.1 + README.markdown + regexchar.spec + +-- Enable using: 'cabal configure -f llvm'. flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. - manual: True - default: False + Manual: True + Default: False +flag threaded + Description: Link with the threaded runtime. + Manual: True + Default: True + Library - hs-source-dirs: src + Default-language: Haskell2010 + GHC-options: -Wall -O2 -fno-warn-tabs + GHC-prof-options: -prof -auto-all -caf-all + Hs-source-dirs: src-lib Exposed-modules: RegExChar.ExtendedRegExChar @@ -37,13 +67,13 @@ RegExChar.RegExOptsChar Build-depends: + array, base == 4.*, containers, parsec == 3.*, + regex-base, regexdot >= 0.11.1.0, - toolshed >= 0.14 - - GHC-options: -Wall -fno-warn-tabs + toolshed >= 0.16 if impl(ghc >= 7.4.1) GHC-prof-options: -prof -fprof-auto -fprof-cafs @@ -54,8 +84,13 @@ GHC-options: -fllvm Executable grecce - hs-source-dirs: src - Main-Is: Main.hs + Default-language: Haskell2010 + GHC-options: -Wall -O2 -fno-warn-tabs + GHC-prof-options: -prof -auto-all -caf-all + Hs-source-dirs: src-exe + Main-is: Main.hs + +-- Required for 'cabal sdist'. Other-modules: Grecce.CommandOptions Grecce.Grep @@ -64,21 +99,16 @@ Grecce.Test.Performance.ExtendedRegExTest Grecce.Test.Performance.ExtendedRegExTestsNegative Grecce.Test.Performance.ExtendedRegExTestsPositive - Grecce.Test.QC.ExtendedRegExChar - Grecce.Test.QC.MetaChar - Grecce.Test.QC.QuickChecks - Grecce.Test.QC.RepeatableMetaChar Build-depends: - array, - Cabal >= 1.6 && < 2, + base == 4.*, + Cabal >= 1.10, parallel >= 3.0, - QuickCheck >= 2.4, + regexchar, regex-base, - regex-posix - - GHC-options: -Wall -O2 -fno-warn-tabs - GHC-prof-options: -prof -auto-all -caf-all + regex-posix, + regexdot >= 0.11.1.0, + toolshed >= 0.16 if flag(threaded) GHC-options: -threaded @@ -88,4 +118,24 @@ if flag(llvm) GHC-options: -fllvm + +Test-Suite quickCheck + Default-language: Haskell2010 + GHC-options: -Wall -fno-warn-tabs + Hs-source-dirs: src-test + Main-is: Main.hs + Type: exitcode-stdio-1.0 + +-- Required for 'cabal sdist'. + Other-modules: + Grecce.Test.QC.ExtendedRegExChar + Grecce.Test.QC.MetaChar + Grecce.Test.QC.RepeatableMetaChar + + Build-depends: + base == 4.*, + QuickCheck >= 2.4, + regexchar, + regexdot >= 0.11.1.0, + toolshed >= 0.16 diff --git a/regexchar.spec b/regexchar.spec --- a/regexchar.spec +++ b/regexchar.spec @@ -1,4 +1,4 @@ -# Copyright (C) 2012-2014 Dr. Alistair Ward +# Copyright (C) 2012-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 @@ -15,57 +15,55 @@ %define package %name-%version %define tarBall %package.tar.gz -%define _bindir %prefix/bin -%define _libdir %prefix/lib/%package %define _sharedir %prefix/share -%define _datadir %_sharedir/%package -%define _docdir %_sharedir/doc/%package +%define _datadir %_sharedir/%name +%define _docdir %_sharedir/doc/%name %define _mandir %_sharedir/man Summary: A re-implementation of egrep, using a specialisation of a polymorphic regex-engine Name: regexchar -Version: 0.9.0.12 +Version: 0.9.0.13 Release: 1 License: GPLv3 -#From '/usr/share/doc/packages/rpm/GROUPS'. +# From '/usr/share/doc/packages/rpm/GROUPS'. Group: Applications/Text Source0: http://functionalley.eu/Downloads/sdist/%tarBall -URL: http://functionalley.eu +URL: http://functionalley.eu/RegExChar/regExChar.html Prefix: /usr -BuildRequires: ghc +BuildRequires: haskell-platform %description -Provides a POSIX extended regex-engine, specialised from an underlying polymorphic engine, to process merely character-lists, as is typically required. +Provides a POSIX extended regex-engine, specialised from an underlying polymorphic engine "regexdot", to process merely character-lists, as is typically required. %prep -#NB: we've changed directory to %_builddir -(cd $OLDPWD && runhaskell Setup sdist) && tar -zxf $OLDPWD/dist/%tarBall #Make a source-distribution & unpack it into the build-directory. -cd '%package/' && runhaskell Setup configure --user --prefix=%prefix #Configure to use the user's personal package-database & to generate an appropriate Paths module. +# NB: CWD has changed to %_builddir +echo 'package="%package", prefix="%prefix", _builddir="%_builddir", buildroot="%buildroot"' +(cd $OLDPWD && cabal sdist) && tar -zxf $OLDPWD/dist/%tarBall # Make a source-distribution & unpack it into the build-directory. +cd '%package/' && cabal configure --user --prefix='%prefix' --datadir='%_datadir' --datasubdir='' --docdir='%_docdir' # Tell cabal to use the user's personal package-database, to generate an appropriate "Paths" module, & where to place the documentation. %build -cd '%package/' && runhaskell Setup build #Descend into the source-distribution and build according to the previously established configuration. +cd '%package/' && cabal build # Descend into the source-distribution and build according to the previously established configuration. %install -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/' +cd '%package/' # Descend into the build-directory. +cabal copy --destdir='%buildroot' # Install the built package in the target-directory. +mkdir -p -- '%buildroot%_docdir' && mv 'changelog.markdown' 'copyright' 'README.markdown' '%buildroot%_docdir/' # 'LICENSE' has already been copied by cabal. mkdir -p -- '%buildroot%_mandir' && mv 'man/man1' '%buildroot%_mandir/' +rm -rf -- '%buildroot%prefix/lib/' # The library isn't a deliverable. %clean -make --directory='%package' clobber -rm -rf -- '%_builddir/%package/' '%buildroot' +rm -rf -- '%_builddir/%package/' '%buildroot/' # Only the '.rpm' is required. %files -%attr(0755, root, root) %_bindir/grecce +%attr(0755, root, root) %prefix/bin/grecce %attr(0644, root, root) %_datadir/data/*.txt -%attr(0644, root, root) %doc %_docdir/changelog +%attr(0644, root, root) %doc %_docdir/changelog.markdown %attr(0644, root, root) %doc %_docdir/copyright %attr(0644, root, root) %doc %_docdir/LICENSE +%attr(0644, root, root) %doc %_docdir/README.markdown %attr(0644, root, root) %doc %_mandir/man1/grecce.1.gz %changelog * Wed May 09 2012 Alistair Ward 0.9.0.10-1 -Removed "rm -rf -- '%buildroot'" from build, for security. -Corrected "Paths" module, even though it's unused. +First cut. diff --git a/src-exe/Grecce/CommandOptions.hs b/src-exe/Grecce/CommandOptions.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/CommandOptions.hs @@ -0,0 +1,172 @@ +{- + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Defines the options, read from the command-line, + & as such assumes that the type-parameter of the underlying polymorphic /regex/-engine is 'Char'. + + * Supplies mutators, which ensure the consistency of the chosen set. +-} + +module Grecce.CommandOptions( +-- * Types +-- ** Type-synonyms + CompilationOptionsMutator, + ExecutionOptionsMutator, +-- Transformer, +-- ** Data-types + CommandOptions(..), +-- * Functions +-- ** Mutators + setCompilationOption, + setCountMatches, + setExecutionOption, + setInvertMatch, + setPrependLineNumbers, + setListFilesWithMatches, + setListFilesWithoutMatch, + setVerbose +) where + +import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar +import qualified RegExDot.CompilationOptions +import qualified RegExDot.ExecutionOptions +import qualified ToolShed.Defaultable +import qualified ToolShed.Options + +-- | The set of command-line options; based on those provided by /egrep/. +data CommandOptions = MkCommandOptions { + countMatches :: Bool, -- ^ Print only a count of matching lines per file. + extendedRegExChar :: Maybe ExtendedRegExChar.ExtendedRegExChar, -- ^ The /regex/. + invertMatch :: Bool, -- ^ Select non-matching lines. + prependLineNumbers :: Bool, -- ^ Prepend the line-number of the matched input-data, to the output. + listFilesWithMatches :: Bool, -- ^ List the names of any files containing at least one match. + listFilesWithoutMatch :: Bool, -- ^ List the names of any files containing zero matches. + verbose :: Bool, -- ^ Show the captured data. + compilationOptions :: RegExDot.CompilationOptions.CompilationOptions, -- ^ Used to define the regex-request. + executionOptions :: RegExDot.ExecutionOptions.ExecutionOptions -- ^ Used to control the regex-runtime. +} deriving Show + +-- | An arbitrary function which transforms the supplied 'RegExDot.ExecutionOptions.ExecutionOptions'. +type Transformer = CommandOptions -> CommandOptions + +instance ToolShed.Defaultable.Defaultable CommandOptions where + defaultValue = ToolShed.Options.blankValue { + countMatches = False, + extendedRegExChar = Nothing, + invertMatch = False, + prependLineNumbers = False, + listFilesWithMatches = False, + listFilesWithoutMatch = False, + verbose = False, + compilationOptions = ToolShed.Defaultable.defaultValue, + executionOptions = ToolShed.Defaultable.defaultValue + } + +instance ToolShed.Options.Options CommandOptions where + blankValue = MkCommandOptions { + countMatches = undefined, + extendedRegExChar = undefined, + invertMatch = undefined, + prependLineNumbers = undefined, + listFilesWithMatches = undefined, + listFilesWithoutMatch = undefined, + verbose = undefined, + compilationOptions = undefined, + executionOptions = undefined + } + +-- | Mutator. +setCountMatches :: Transformer +setCountMatches commandOptions + | ($ commandOptions) `any` [ + prependLineNumbers, + listFilesWithoutMatch, + listFilesWithMatches, + verbose + ] = error "Grecce.CommandOptions.setCountMatches:\t'countMatches' is incompatible with; 'prependLineNumbers', 'listFilesWithoutMatch', 'listFilesWithMatches' & 'verbose'." + | otherwise = commandOptions { countMatches = True } + +-- | Mutator. +setInvertMatch :: Transformer +setInvertMatch commandOptions + | verbose commandOptions = error "Grecce.CommandOptions.setInvertMatch:\t'invertMatch' is incompatible with 'verbose'." + | otherwise = commandOptions { invertMatch = True } + +-- | Mutator. +setPrependLineNumbers :: Transformer +setPrependLineNumbers commandOptions + | ($ commandOptions) `any` [ + countMatches, + listFilesWithoutMatch, + listFilesWithMatches + ] = error "Grecce.CommandOptions.setPrependLineNumbers:\t'prependLineNumbers' is incompatible with 'countMatches', 'listFilesWithoutMatch' & 'listFilesWithMatches'." + | otherwise = commandOptions { prependLineNumbers = True } + +-- | Mutator. +setListFilesWithMatches :: Transformer +setListFilesWithMatches commandOptions + | ($ commandOptions) `any` [ + countMatches, + prependLineNumbers, + listFilesWithoutMatch, + verbose + ] = error "Grecce.CommandOptions.setListFilesWithMatches:\t'listFilesWithMatches' is incompatible with; 'countMatches', 'prependLineNumbers', 'listFilesWithoutMatch' & 'verbose'." + | otherwise = commandOptions { listFilesWithMatches = True } + +-- | Mutator. +setListFilesWithoutMatch :: Transformer +setListFilesWithoutMatch commandOptions + | ($ commandOptions) `any` [ + countMatches, + prependLineNumbers, + listFilesWithMatches, + verbose + ] = error "Grecce.CommandOptions.setListFilesWithoutMatch:\t'listFilesWithoutMatch' is incompatible with; 'countMatches', 'prependLineNumbers', 'listFilesWithMatches' & 'verbose'." + | otherwise = commandOptions { listFilesWithoutMatch = True } + +-- | Mutator, which additionally sets the corresponding 'RegExDot.ExecutionOptions.ExecutionOptions'. +setVerbose :: Transformer +setVerbose commandOptions + | ($ commandOptions) `any` [ + countMatches, + invertMatch, + listFilesWithoutMatch, + listFilesWithMatches + ] = error "Grecce.CommandOptions.setVerbose:\t'verbose' is incompatible with; 'countMatches', 'invertMatch', 'listFilesWithoutMatch' & 'listFilesWithMatches'." + | otherwise = commandOptions { + verbose = True, + executionOptions = RegExDot.ExecutionOptions.setVerbose True $ executionOptions commandOptions + } + +-- | A function which accepts a 'String' & the 'RegExDot.CompilationOptions.CompilationOptions' to transform, using its value. +type CompilationOptionsMutator = String -> RegExDot.CompilationOptions.CompilationOptions -> RegExDot.CompilationOptions.CompilationOptions + +-- | Generic mutator, which accepts a function & the parameter-string it requires, to amend an unspecified field of 'RegExDot.CompilationOptions.CompilationOptions'. +setCompilationOption :: CompilationOptionsMutator -> String -> Transformer +setCompilationOption compilationOptionsMutator s commandOptions = commandOptions { compilationOptions = compilationOptionsMutator s $ compilationOptions commandOptions } + +-- | A function which accepts a 'String' & the 'RegExDot.ExecutionOptions.ExecutionOptions' to transform, using its value. +type ExecutionOptionsMutator = String -> RegExDot.ExecutionOptions.ExecutionOptions -> RegExDot.ExecutionOptions.ExecutionOptions + +-- | Generic mutator, which accepts a function & the parameter-string it requires, to amend an unspecified field of 'RegExDot.ExecutionOptions.ExecutionOptions'. +setExecutionOption :: ExecutionOptionsMutator -> String -> Transformer +setExecutionOption executionOptionsMutator s commandOptions = commandOptions { executionOptions = executionOptionsMutator s $ executionOptions commandOptions } + diff --git a/src-exe/Grecce/Grep.hs b/src-exe/Grecce/Grep.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Grep.hs @@ -0,0 +1,206 @@ +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Performs the match-operation on the specified file-list, using the user's command-line options. +-} + +module Grecce.Grep( +-- * Types +-- LineNumber, +-- Matches, +-- ** Type-synonyms +-- * Functions + grep +) where + +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 +import RegExChar.ExtendedRegExChar((+~), (=~)) +import qualified RegExDot.RegEx +import qualified RegExDot.RegExOpts +import qualified RegExDot.Result +import qualified System.Exit +import qualified System.IO + +type LineNumber = Int +type Matches = Int + +-- | Creates a 'RegExDot.RegExOpts.RegExOpts' record from 'CommandOptions.CommandOptions', and uses it to filter the lines read from the list of input-data files, the result of which is then printed. +grep + :: CommandOptions.CommandOptions -- ^ The match-criteria, which may include the name of the file on which to operate. + -> [String] -- ^ A supplementary list of files on which to operate + -> IO () -- ^ Nothing is returned, since the result is printed. +grep commandOptions nonOptions +{- + The algorithm depends fundamentally on whether the data comes from 'stdin' or from file. + This is because of the requirement, in the former case, to deliver instantaneous feedback. + This forces us to print matches as they're found, rather than batching them for return to the caller to print. + If we COULD return 'IO [String]', then 'matchFilterStdIn' could be called instead of 'grep' when (fileName == "-"); annoyingly, it just doesn't work. +-} + | any ($ fileNames) [null, all (== "-")] = let + matchFilterStdIn :: LineNumber -> Matches -> IO System.Exit.ExitCode + matchFilterStdIn lineNumber matches = {-#SCC "matchFilterStdIn" #-} do + isEOF <- System.IO.isEOF + + 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. + else if listFilesWithoutMatch + then putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess + else do + Control.Monad.when countMatches $ print matches + + return {-to IO-monad-} $ if matches == 0 + then System.Exit.ExitFailure 1 + else System.Exit.ExitSuccess + else {-not EOF-} do + line <- getLine -- Process line-at-a-time, to provide instant feedback. + + let + lineNumber' :: LineNumber + lineNumber' = succ lineNumber + + onSuccess :: String -> IO System.Exit.ExitCode + onSuccess line' + | listFilesWithMatches = putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess + | listFilesWithoutMatch = return {-to IO-monad-} $ System.Exit.ExitFailure 1 + | otherwise = do + Control.Monad.unless countMatches . putStrLn $ ( + if prependLineNumbers + then showLineNumber lineNumber' + else id + ) line' + + matchFilterStdIn lineNumber' $ succ matches -- Recurse. + + onFailure, onMismatch :: IO System.Exit.ExitCode + onFailure = matchFilterStdIn lineNumber' matches -- Recurse + onMismatch + | invertMatch = onSuccess line + | otherwise = onFailure + + if verbose + then let + result :: RegExDot.RegEx.Result Char + result = line +~ regExOpts + in if RegExDot.Result.isMatch result + then if invertMatch + then onFailure + else onSuccess $ show result + else onMismatch + else {-terse-} if line =~ regExOpts + then if invertMatch + then onFailure + else onSuccess line + else onMismatch + where + dummyFileName :: String + dummyFileName = "" + in matchFilterStdIn 0 0 >>= System.Exit.exitWith + | otherwise {-file-names provided-} = let + findMatch :: String -> RegExDot.RegEx.Result Char + findMatch = (+~ regExOpts) + + matchFilter :: [String] -> [String] + matchFilter = {-#SCC "matchFilter" #-} ( + if countMatches + then return {-to List-monad-} . show . length -- Substitute the list of matches, with its length. + else id + ) . ( + let + isMatch :: String -> Bool + isMatch = {-#SCC "isMatch" #-} (if invertMatch then not else id) . (=~ regExOpts) + in if prependLineNumbers + then map (uncurry showLineNumber) . ( + if verbose + then map ( + Control.Arrow.second show + ) . filter ( + RegExDot.Result.isMatch . snd + ) . map ( + Control.Arrow.second findMatch + ) + else {-terse-} filter (isMatch . snd) + ) . zip [1 :: LineNumber ..] + else {-unnumbered-} if verbose + then map show . filter RegExDot.Result.isMatch . map findMatch + else {-terse-} filter isMatch + ) + + identifySource :: String -> [String] -> [String] + identifySource fileName results + | listFilesWithMatches = [fileName | not isEmpty] {-list-comprehension-} + | listFilesWithoutMatch = [fileName | isEmpty] {-list-comprehension-} + | length (Data.List.nub fileNames) > 1 = (showString fileName . separate) `map` results + | otherwise = results + where + isEmpty :: Bool + isEmpty = null results + in do + results <- ( + concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq ( + uncurry identifySource . Control.Arrow.second (matchFilter . {-#SCC "lines" #-} lines {-chops '\n'-}) + ) . zip fileNames + ) `fmap` mapM readFile fileNames + + mapM_ putStrLn results + + System.Exit.exitWith $ if null results + then System.Exit.ExitFailure 1 + else System.Exit.ExitSuccess + where + countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose :: Bool + [countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose] = ($ commandOptions) `map` [ + CommandOptions.countMatches, + CommandOptions.invertMatch, + CommandOptions.prependLineNumbers, + CommandOptions.listFilesWithMatches, + CommandOptions.listFilesWithoutMatch, + CommandOptions.verbose + ] -- Divvy-up. + +-- 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 + Just c -> (c, nonOptions) + _ + | null nonOptions -> error "Undefined regex." + | otherwise -> read . head &&& tail $ nonOptions + +-- 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, + RegExDot.RegExOpts.executionOptions = CommandOptions.executionOptions commandOptions, + RegExDot.RegExOpts.regEx = extendedRegExChar + } + +-- Define functions used to format the output. + separate :: ShowS + separate = showChar ':' + + showLineNumber :: LineNumber -> ShowS + showLineNumber n = shows n . separate + diff --git a/src-exe/Grecce/Test/Assert/RegExOptsChar.hs b/src-exe/Grecce/Test/Assert/RegExOptsChar.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Test/Assert/RegExOptsChar.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE FlexibleContexts #-} +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Reads lines from the specified file. + + * Each line describes a 'Test'. + + * Each input-data string should match the /regex/ in the specified way. + + * Permits comparison with "Text.Regex.Posix.String". +-} + +module Grecce.Test.Assert.RegExOptsChar( +-- * Types +-- ** Type-synonyms +-- Test, +-- TestDataAndResult, +-- TestFilter, +-- * Functions + findFailures, + findFailuresPosix, + readTests +-- ** Predicates +-- isMatch +) where + +import qualified Control.Arrow +import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar +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 +import qualified Text.Regex.Posix.Wrap +import Text.Regex.Posix() + +-- | Composed input data & list of captured 'RegExOptsChar.MatchSpan'. +type TestDataAndResult = (ExtendedRegExChar.InputData, [RegExOptsChar.MatchSpan]) + +-- | Composed of the 'String' from which an unspecified type of regex is read, & a list of input data & results, to which it should respectively be applied & compared. +type Test = (String {-regex-source-}, [TestDataAndResult]) + +-- | Filters a list of 'Test's, & returns a sub-set. +type TestFilter = [Test] -> [Test] + +-- | True if the specified 'ExtendedRegExChar.InputData', is a member of the set defined by the polymorphic 'Text.Regex.Base.RegexLike.RegexLike' parameter. +isMatch :: RegexLike.RegexLike r ExtendedRegExChar.InputData => r -> TestDataAndResult -> Bool +isMatch regex (inputData, matchSpanList) = RegexLike.matchOnce regex inputData == Just (RegExOptsChar.toZeroIndexedArray matchSpanList) + +-- | Returns those 'Test's, which 'RegExOptsChar.RegExOptsChar' fails. +findFailures :: RegExDot.CompilationOptions.CompilationOptions -> RegExDot.ExecutionOptions.ExecutionOptions -> TestFilter +findFailures compilationOptions executionOptions = filter (not . uncurry all . Control.Arrow.first (isMatch . RegexLike.makeRegexOpts compilationOptions executionOptions)) + +-- | Returns those 'Test's, which 'Text.Regex.Posix.Wrap.Regex' fails. +findFailuresPosix :: TestFilter +findFailuresPosix = filter (not . uncurry all . Control.Arrow.first ((isMatch :: Text.Regex.Posix.Wrap.Regex -> TestDataAndResult -> Bool) . RegexLike.makeRegex)) + +{- | + * Read 'Test's from file, ignoring blank lines & comments. + + * 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 + ) `fmap` readFile fileName + diff --git a/src-exe/Grecce/Test/Performance/ExtendedRegEx.hs b/src-exe/Grecce/Test/Performance/ExtendedRegEx.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Test/Performance/ExtendedRegEx.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE CPP #-} +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * CPU-times the specified stress-test(s), over a hard-coded list of /regex/-engines, + providing each combination with a varied list of 'Performance.ExtendedRegExTest.TestGenerator's, + & a level of 'Performance.ExtendedRegExTest.TestComplexity' which increases linearly to the specified cap. + + * Either a simple 'Bool' result, or the full data-capture, can be requested. + + [@CAVEATS@] + + * For compatibility with the other regex-engines, uses the specialised instance 'ExtendedRegExChar.ExtendedRegExChar', + rather than the underlying polymorphic 'RegExDot.RegEx.ExtendedRegEx'. + + * "Text.Regex.Posix" stalls forever on 'Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES', + with 'Performance.ExtendedRegExTest.TestComplexity'=3 & data-capture requested. + + [@TODO@] + + * Utilise the standard interface in "RegExOptsChar", to permit identical treatment of different regex-engines. +-} + +module Grecce.Test.Performance.ExtendedRegEx( +-- * Types +-- ** Type-synonyms +-- GenerateAndRunTest, +-- GetAndRunTestRange, +-- * Constants +-- solitary, +-- * Functions + run +-- tailorTest +) where + +import qualified Control.Arrow +import Control.Arrow((&&&)) +import qualified Data.Maybe +import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest +import qualified Grecce.Test.Performance.ExtendedRegExTestsNegative as Test.Performance.ExtendedRegExTestsNegative +import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive +import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar +import qualified RegExDot.ExecutionOptions +import qualified RegExDot.RegEx +import qualified RegExDot.RegExOpts +import qualified Text.Regex.Posix +import qualified ToolShed.Defaultable +import qualified ToolShed.System.TimePure + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative((<$>), (<*>)) +#endif + +solitary :: Bool +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)]) + +{- | + * Print the CPU-seconds, required to run the range of 'Test.Performance.ExtendedRegExTest.TestGenerator's corresponding to the specified test-names & a linearly increasing 'Test.Performance.ExtendedRegExTest.TestComplexity'. + + * 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 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 testRange = sequence_ $ ( + \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print + ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where + cpuSecondsFor :: GenerateAndRunTest + cpuSecondsFor testGenerator = ( + \(inputData, (isMismatch, extendedRegExCharString)) -> (,) extendedRegExCharString <$> mapM ( + ToolShed.System.TimePure.getCPUSeconds . ($ inputData) . (show .) + ) [ + isMismatch, + if solitary + 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.RegExOpts.compilationOptions = ToolShed.Defaultable.defaultValue, + RegExDot.RegExOpts.executionOptions = executionOptions, + RegExDot.RegExOpts.regEx = extendedRegEx + } + ) + ) &&& show . ExtendedRegExChar.MkExtendedRegExChar False {-hasNonCapturingTopLevelAlternatives-} + ) . testGenerator + +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 testRange = sequence_ $ ( + \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print + ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where + cpuSecondsFor :: GenerateAndRunTest + cpuSecondsFor testGenerator = ( + \(inputData, (showMatch, extendedRegExCharString)) -> (,) extendedRegExCharString <$> ( + (ToolShed.System.TimePure.getCPUSeconds . ($ inputData)) `mapM` [ + showMatch, + 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 show . if solitary + then const True -- CAVEAT: should be 'undefined'. + else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool -- CAVEAT: . + ] + ) + ) . Control.Arrow.second ( + ( + \extendedRegEx -> let + regExOpts :: RegExDot.RegExOpts.RegExOpts (RegExDot.RegEx.ExtendedRegEx Char) + regExOpts = RegExDot.RegExOpts.MkRegExOpts { + 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. + in if RegExDot.ExecutionOptions.requireMatchList executionOptions + then show . (RegExDot.RegEx.+~ regExOpts) -- CAVEAT: . + else show . (RegExDot.RegEx.=~ regExOpts) -- CAVEAT: . + ) &&& show . ExtendedRegExChar.MkExtendedRegExChar False {-hasNonCapturingTopLevelAlternatives-} + ) . testGenerator + diff --git a/src-exe/Grecce/Test/Performance/ExtendedRegExTest.hs b/src-exe/Grecce/Test/Performance/ExtendedRegExTest.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Test/Performance/ExtendedRegExTest.hs @@ -0,0 +1,51 @@ +{- + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Defines the types used for performance-testing. + + * Defines an interface to permit queries on repositories of 'TestGenerator's. +-} + +module Grecce.Test.Performance.ExtendedRegExTest( +-- * Type-classes + TestGeneratorRepository(..), +-- * Types +-- ** Type-synonyms + TestComplexity, + Test, + TestGenerator +) where + +import qualified RegExDot.RegEx + +-- | Used to specify the level of complexity of /regex/ to generate. +type TestComplexity = Int + +-- | A pair defining the data & the /regex/ to which it should be fed. +type Test a = (RegExDot.RegEx.InputData a, RegExDot.RegEx.ExtendedRegEx a) + +-- | The type of a function, which accepts a 'TestComplexity', & returns a 'Test'. +type TestGenerator a = TestComplexity -> Test a + +-- | 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. + diff --git a/src-exe/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs b/src-exe/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs @@ -0,0 +1,85 @@ +{- + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Defines 'Performance.ExtendedRegExTest.TestGenerator's, for 'Performance.ExtendedRegExTest.Test's, which should fail. + + * Implements 'Performance.ExtendedRegExTest.TestGeneratorRepository'. +-} + +module Grecce.Test.Performance.ExtendedRegExTestsNegative( +-- * Types +-- ** Data-types + TestName +) where + +import qualified Control.Arrow +import qualified Data.Maybe +import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest +import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive + +-- | Defines an enumeration of keys, by which to reference 'Test.Performance.ExtendedRegExTest.TestGenerator's. +data TestName = + INTERLEAVED_GREEDY_STAR_VS_MANDATORY + | LINEAR_FRACTAL_NONGREEDY_STAR + | OVERLAPPING_ALTERNATIVES + deriving ( + Bounded, + Enum, + Eq, + Read, + Show + ) + +instance Test.Performance.ExtendedRegExTest.TestGeneratorRepository TestName where + query = ( + `lookup` [ +{- + Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.INTERLEAVED_GREEDY_STAR_VS_MANDATORY', but with twice the input data following by a mismatch. + Performance: vastly better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkExistenceOfInelasticTail'. +-} + ( + INTERLEAVED_GREEDY_STAR_VS_MANDATORY, + Control.Arrow.first ((++ "!") . concat . replicate 2) . Data.Maybe.fromJust ( + Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.INTERLEAVED_GREEDY_STAR_VS_MANDATORY + ) + ), +{- + Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.LINEAR_FRACTAL_NONGREEDY_STAR', but with mismatching input data, which causes the time-complexity explodes to O(n!). + Performance: vastly better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkForUnconsumableData'. +-} + ( + LINEAR_FRACTAL_NONGREEDY_STAR, + Control.Arrow.first (++ "!") . Data.Maybe.fromJust ( + Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.LINEAR_FRACTAL_NONGREEDY_STAR + ) + ), +{- + Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES', but with mismatching input data. + Performance: marginally better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkForUnconsumableData' & 'ExecutionOptions.permitReorderingOfAlternatives'. +-} + ( + OVERLAPPING_ALTERNATIVES, + Control.Arrow.first (++ "!") . Data.Maybe.fromJust ( + Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES + ) + ) + ] + ) diff --git a/src-exe/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs b/src-exe/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs new file mode 100644 --- /dev/null +++ b/src-exe/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs @@ -0,0 +1,329 @@ +{- + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Defines 'Performance.ExtendedRegExTest.TestGenerator's, for 'Performance.ExtendedRegExTest.Test's, which should pass. + + * Implements 'Performance.ExtendedRegExTest.TestGeneratorRepository'. +-} + +module Grecce.Test.Performance.ExtendedRegExTestsPositive( +-- * Types +-- ** Data-types + TestName(..) +-- * Functions +-- triangularSeries +) where + +import Control.Arrow((&&&)) +import qualified Data.Char +import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest +import qualified RegExDot.Anchor +import qualified RegExDot.BracketExpressionMember +import RegExDot.DSL((-:), (?:), (*:), (<~>)) +import qualified RegExDot.Meta +import qualified RegExDot.RegEx +import RegExDot.RegEx((.*), (.*?)) +import qualified RegExDot.Repeatable +import RegExDot.Repeatable((^#->#), (^#->), (^#)) + +-- | Defines an enumeration of keys, by which to reference 'Test.Performance.ExtendedRegExTest.TestGenerator's. +data TestName = + BIPOLAR_GREEDY_OPTIONAL_VS_MANDATORY + | INTERLEAVED_GREEDY_STAR_VS_MANDATORY + | TRIANGULAR_CONSUMPTION + | BINARY_TREE + | REPEATABLE_ALTERNATIVES + | REPEATED_ALTERNATIVES + | LINEAR_FRACTAL_RANGES + | LINEAR_FRACTAL_NONGREEDY_STAR + | BINARY_TREE_FRACTAL + | FUTILE_REPEATABLE_ALTERNATIVES + | OVERLAPPING_ALTERNATIVES + | UNBRIDLED_GREED + | MULTIPLE_CHOICE + deriving ( + Bounded, + Enum, + Eq, + Read, + Show + ) + +instance Test.Performance.ExtendedRegExTest.TestGeneratorRepository TestName where + query = ( + `lookup` [ +{- + "^(?){}(){}$". + Explanation: each of the optional meta-data in the first half of the expression can capture data, but in doing so starves a mandatory meta-datum in the second half of the expression, + presenting the opportunity for O(2^n) time-complexity backtracking. + Performance: vastly better Boolean-result performance than "Text.Regex.Posix". Looks like O(n^2) time-complexity. +-} + ( + BIPOLAR_GREEDY_OPTIONAL_VS_MANDATORY, + (`replicate` testChar) &&& let + exactly :: Test.Performance.ExtendedRegExTest.TestComplexity -> (RegExDot.RegEx.Pattern Char -> RegExDot.RegEx.RepeatablePattern Char) -> RegExDot.RegEx.RepeatablePattern Char + exactly n f = (RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . return {-to List-monad-} $ f testRequirement) ^# n + in ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (`map` [RegExDot.Repeatable.zeroOrOne, RegExDot.Repeatable.one]) . exactly + ), +{- + "^(.*z){}$". + Explanation: each '.*' can consume all the remaining data, starving the interspersed mandatory meta data, presenting the opportunity for O(2^n) time-complexity backtracking. + Performance: marginally better Boolean-result & data-capture performance than "Text.Regex.Posix" with 'ExecutionOptions.moderateGreed'. Empirically O(n^3) time-complexity. +-} + ( + INTERLEAVED_GREEDY_STAR_VS_MANDATORY, + concat . (`replicate` (testChar : "z")) &&& RegExDot.RegEx.dock . ( + `mkExtendedRegExFromRepeatableSingletonAlternative` (RegExDot.Anchor.unanchored <~>) [ + (.*), + RegExDot.RegEx.simply $ RegExDot.Meta.Literal 'z' + ] + ) . flip (^#) + ), +{- + "^*+{2,}{3,} ... a{,}$". + Explanation: each term greedily consumes all the data, starving all the remaining terms, until after much back-tracking, it consumes the just the minimum permissible. + The correct consumption-pattern is triangular, starting at the apex & spreading into a delta. + Performance: vastly better Boolean-result & data-capture performance than "Text.Regex.Posix". +-} + + ( + TRIANGULAR_CONSUMPTION, + (`replicate` testChar) . triangularSeries &&& ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (`take` map (testRequirement ^#->) [0 ..]) . succ + ), +{- + "(|{2})*c". + Explanation: from + Performance: disastrous performance. +-} + ( + BINARY_TREE, + (++ "bc") . (`replicate` testChar) . (2 ^) &&& const ( + RegExDot.Anchor.unanchored <~> RegExDot.RegEx.captureGroup ( + map ( + (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . (testRequirement ^#) . (2 ^) + ) [0 :: Int .. 1] + ) *: RegExDot.RegEx.Require (RegExDot.Meta.Literal 'c') -: [] + ) + ), +{- + "^(?|{2}|{4}|{8}| ... |{2^})*$". + Explanation: all but one of the 'Alternatives' must be used, one on each successive repetition, in order to consume all the 'InputData'. + A correct implementation will match against the longest possible Alternative on each successive repetition, just as if the repetition were unrolled; see 'REPEATED_ALTERNATIVES'. + Performance: vastly worse Boolean-result performance (even with 'ExecutionOptions.permitReorderingOfAlternatives'), + & worse data-capture performance (even with 'ExecutionOptions.useFirstMatchAmongAlternatives'), than "Text.Regex.Posix". +-} + ( + REPEATABLE_ALTERNATIVES, + (`replicate` testChar) . pred {-requires several different Alternatives-} . (2 ^) &&& ( + \i -> ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ [RegExDot.Repeatable.zeroOrOne testRequirement] : map ( + return {-to List-monad-} . (testRequirement ^#) . (2 ^) + ) [1 .. i] + ) + ), +{- + "^(?|{2}|{4}| ... |{2^})(?|{2}|{4}| ... |{2^})(?|{2}|{4}| ... |{2^})$". + Explanation: 'REPEATABLE_ALTERNATIVES' with the repetition unrolled, to permit inspection of individual capture-groups, + revealing the use by "Text.Regex.Posix", of Perl-style "1st-past-the-post" selection between Alternatives. + Performance: much faster than 'REPEATABLE_ALTERNATIVES'. Vastly better Boolean-result & data-capture performance than both 'REPEATABLE_ALTERNATIVES' & "Text.Regex.Posix". +-} + ( + REPEATED_ALTERNATIVES, + (`replicate` testChar) . pred {-requires several different Alternatives-} . (2 ^) &&& ( + \i -> ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . replicate i . RegExDot.Repeatable.one . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ [RegExDot.Repeatable.zeroOrOne testRequirement] : map ( + return {-to List-monad-} . (testRequirement ^#) . (2 ^) + ) [1 .. i] + ) + ), +{- + "^(((({0,2}){0,2}){0,2}){0,2}){0,2} ... $". + Explanation: + Performance: vastly better Boolean-result performance than "Text.Regex.Posix", which exhausts memory at n==10. Better data-capture performance too. + Stack-overflow at 'Test.Performance.ExtendedRegExTest.TestComplexity'=14. +-} + ( + LINEAR_FRACTAL_RANGES, + let + base :: RegExDot.Repeatable.Repetitions + base = 2 -- Arbitrarily. + + bounds :: RegExDot.Repeatable.RepetitionBounds + bounds = (0, Just base) + in (`replicate` testChar) . (base ^) &&& RegExDot.RegEx.dock . ( + ( + mkExtendedRegExFromRepeatableSingletonAlternative (^#-># bounds) `iterate` (RegExDot.Anchor.unanchored <~>) [testRequirement ^#-># bounds] {-initial value-} + ) !! + ) . pred + ), +{- + "^((((((((((((((*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*? ... $". + Explanation: interesting because all 'RegExDot.RegEx.Alternatives' are expanded before the first comparison against input data, & the number possible repetitions of each expansion is very vague. + Performance: vastly better Boolean-result performance than "Text.Regex.Posix", but inferior data-capture performance. +-} + ( + LINEAR_FRACTAL_NONGREEDY_STAR, + const (replicate 8 {-arbitrary-} testChar) &&& RegExDot.RegEx.dock . ( + ( + mkExtendedRegExFromRepeatableSingletonAlternative RegExDot.Repeatable.zeroOrMore' `iterate` (RegExDot.Anchor.unanchored <~>) [RegExDot.Repeatable.zeroOrMore' testRequirement] {-initial value-} + ) !! + ) + ), +{- + "^((([^]|)|(|[^]))|((|[^])|([^]|)))$". + Explanation: exhibits symmetry in the left & right branches of the binary tree of RegExDot.RegEx.Alternatives, & so the exponentially expanding set of leaves are equivalent & all match the data. + Performance: vastly better Boolean-result & comparable data.capture performance to "Text.Regex.Posix", which exhausts memory at complexity 5 to 6, & to egrep which lasts until complexity==6. +-} + ( + BINARY_TREE_FRACTAL, + let + base :: RegExDot.Repeatable.Repetitions + base = 2 -- Arbitrarily. + in (`replicate` testChar) . (base ^) &&& RegExDot.RegEx.dock . head . ( + ( + iterate ( + \extendedRegExList -> ( + (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . (^# base) . RegExDot.RegEx.captureGroup + ) `map` [extendedRegExList, reverse extendedRegExList] + ) $ map ( + (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . ($ RegExDot.RegEx.Require $ RegExDot.Meta.Literal testChar) + ) [RegExDot.Repeatable.one, RegExDot.Repeatable.zeroOrOne] + ) !! + ) + ), +{- + "^(1|{2}2|{3}3| ... |{})**$". + Explanation: none of the Alternatives can match, & consequently the group must match zero times, presenting the opportunity for many wasted trial repetitions. + Performance: comparable Boolean-result performance to "Text.Regex.Posix", & marginally superior data-capture performance. +-} + ( + FUTILE_REPEATABLE_ALTERNATIVES, + \alternatives -> ( + replicate 1024 {-arbitrarily-} testChar, + ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) $ map RegExDot.Repeatable.zeroOrMore [ + RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ ( + \i -> ($ i) `map` [ + (testRequirement ^#), + RegExDot.RegEx.simply . RegExDot.Meta.Literal . Data.Char.chr . (Data.Char.ord '0' +) . (`mod` 10) + ] + ) `map` [1 .. alternatives], + testRequirement + ] + ) + ), +{- + "^a?((ab?)*|(bc?)*|(cd?)*| ...)*$". + Explanation: the zeroeth term matches greedily, consuming the datum mandated by the 1st Alternative, so the 2nd Alternative greedily consumes two data, including the datum mandated by the 3rd, ... + If there're an even number of Alternatives, then n/2 repetitions (one for each), will consume all the input data, but otherwise the final input datum isn't consumed. + The consumption back-tracks rapidly until the zeroeth term yields-up the initial datum, after which the odd Alternatives match consuming all the input data, in (n/2 + 1) repetitions. + This suggests a very tractable O(n) time-complexity, but Posix requires that we select the combination of Alternatives which consume most data, + & since there are two terms in the regex that can consume each input datum, it looks like there should be 2^n candidate solutions; in fact there's just one. + So, all O(Alternatives ^ repetitions) permutations may be searched in vain for a superior solution. + Performance: vastly worse Boolean-result performance than "Text.Regex.Posix", but the latter then stalls indefinitely (CPU-bound) at complexity=[13 (not verbose), 4 (verbose)]. +-} + ( + OVERLAPPING_ALTERNATIVES, + let + bracket :: a -> [a] -> [a] + bracket terminal = (terminal :) . (++ [terminal]) + + zeroOrMoreAlternatives :: [RegExDot.RegEx.Concatenation Char] -> RegExDot.RegEx.Concatenation Char + zeroOrMoreAlternatives = return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) + in ( + id &&& ( + ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (RegExDot.RegEx.Require (RegExDot.Meta.Literal testChar) ?:) . zeroOrMoreAlternatives . map ( + \(a, b) -> zeroOrMoreAlternatives $ return {-to List-monad-} [a, b] + ) . init . tail . uncurry zip . ( + map RegExDot.Repeatable.one . init &&& map RegExDot.Repeatable.zeroOrOne . tail + ) . bracket undefined . map ( + RegExDot.RegEx.Require . RegExDot.Meta.Literal + ) + ) + ) . (`take` (filter Data.Char.isAlphaNum $ filter Data.Char.isAscii [minBound .. maxBound])) . succ + ), +{- + "^(a|b|c)*(a.*?c){3}$". + Explanation: zero repetitions of the set of Alternatives on the LHS is the only solution, but because the greedy star, within which they're grouped, permits many more, + & because the RHS's requirement for all the input-data, isn't explicit, there's a temptation to over-consume. + Performance: empirically O(2^n) time-complexity, but linearised by 'ExecutionOptions.moderateGreed'. + Better Boolean-result & data-capture performance than "Text.Regex.Posix". +-} + ( + UNBRIDLED_GREED, + \complexity -> let + complexity' :: Test.Performance.ExtendedRegExTest.TestComplexity + complexity' = succ complexity + + testSet :: String + testSet = take complexity' . filter Data.Char.isAlphaNum $ filter Data.Char.isAscii [minBound .. maxBound] + in ( + concat $ replicate complexity' testSet, + ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) $ ( + RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ map ( + return {-to List-monad-} . RegExDot.RegEx.simply . RegExDot.Meta.Literal + ) testSet + ) *: [ + ( + RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} $ RegExDot.RegEx.Require (RegExDot.Meta.Literal $ head testSet) -: (.*?) : RegExDot.RegEx.Require (RegExDot.Meta.Literal $ last testSet) -: [] + ) ^# complexity' + ] + ) + ), +{- + "^(a*[^a]|[^b]|[^c]| ... |[^z])*$" + Explanation: The first alternative greedily consumes all the input data until finding a mismatch on the last, whilst all the remaining alternatives successfully consume a single input datum. + The same occurs on each successive repetition of the alternatives, of which there are as many as input data, + leading to a lot of wasted time with O( ^ ) time-complexity. + Performance: poor Boolean-result & worse data-capture performance (benefiting from 'ExecutionOptions.useFirstMatchAmongAlternatives'), compared to "Text.Regex.Posix". +-} + ( + MULTIPLE_CHOICE, + const (replicate 8 {-arbitrary-} testChar) &&& ( + ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . ( + [ + RegExDot.Repeatable.zeroOrMore testRequirement, + RegExDot.RegEx.simply . RegExDot.Meta.NoneOf $ map RegExDot.BracketExpressionMember.Literal [testChar] + ] : + ) . map ( + return {-to List-monad-} . RegExDot.RegEx.simply . RegExDot.Meta.NoneOf . return {-to List-monad-} . RegExDot.BracketExpressionMember.Literal + ) . ( + `take` tail [testChar ..] + ) + ) + ) + ] + ) where + testChar :: Char + testChar = 'a' + + testRequirement :: RegExDot.RegEx.Pattern Char + testRequirement = RegExDot.RegEx.Require $ RegExDot.Meta.Literal testChar + + mkExtendedRegExFromRepeatableSingletonAlternative :: (RegExDot.RegEx.Pattern Char -> RegExDot.RegEx.RepeatablePattern Char) -> RegExDot.RegEx.ExtendedRegEx Char -> RegExDot.RegEx.ExtendedRegEx Char + mkExtendedRegExFromRepeatableSingletonAlternative makeRepetitions = (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . makeRepetitions . RegExDot.RegEx.captureGroup . return {-to List-monad-} + +{- | + * The sum of the sequence descending from the specified integer; @n + (n - 1) + (n - 2) + ... + 2 + 1 + 0@. + + * . + + * . +-} +triangularSeries :: Integral i => i -> i +triangularSeries i = i * succ i `div` 2 diff --git a/src-exe/Main.hs b/src-exe/Main.hs new file mode 100644 --- /dev/null +++ b/src-exe/Main.hs @@ -0,0 +1,208 @@ +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Contains the entry-point to the program. + + * Provides command-line access to "ExtendedRegExChar". + + * Defines the permissible command-line arguments; aping /egrep/, but with the addition of /--verbose/, which enables one to see the details of the data-capture. + + [@TODO@] Coordinate the output of 'printVersion' with the definition in '.cabal'; this may not be feasible. +-} + +module Main(main) where + +import qualified Data.List +import qualified Data.Version +import qualified Distribution.Package +import qualified Distribution.Text +import qualified Distribution.Version +import qualified Grecce.CommandOptions as CommandOptions +import qualified Grecce.Grep as Grep +import qualified Grecce.Test.Assert.RegExOptsChar as Test.Assert.RegExOptsChar +import qualified Grecce.Test.Performance.ExtendedRegEx as Test.Performance.ExtendedRegEx +import qualified Grecce.Test.Performance.ExtendedRegExTestsNegative as Test.Performance.ExtendedRegExTestsNegative +import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive +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 +import qualified System.Environment +import qualified System.Exit +import qualified System.Info +import qualified System.IO +import qualified System.IO.Error +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'. + +-- | 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 + _ -> 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 " + +{- | + * Parses the command-line arguments, to determine 'CommandOptions.CommandOptions'. + + * Arguments following 'CommandOptions.CommandOptions', are interpreted as a /regex/, followed by the names of the files to which it is applied. +-} +main :: IO () +main = do + progName <- System.Environment.getProgName + + let + usageMessage :: String + usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList ++ " [, ...]" + +-- Define the command-line options, & the 'CommandLineAction's used to handle them. + optDescrList :: [G.OptDescr CommandLineAction] + optDescrList = [ +-- String [String] (G.ArgDescr CommandLineAction) String + G.Option "?" ["help"] (G.NoArg $ const printUsage) "Output:\tdisplay this help-text & then exit.", + G.Option "" ["verbose"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setVerbose) ("Output:\tsee how the input data was captured by the RegEx; default '" ++ show (CommandOptions.verbose ToolShed.Defaultable.defaultValue) ++ "'. CAVEAT: to be effective, it should precede other options."), + G.Option "" ["version"] (G.NoArg $ const printVersion) "Output:\tprint version-information & then exit.", + G.Option "c" ["count"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setCountMatches) ("Output:\tprint only a count of matching lines per file; default '" ++ show (CommandOptions.countMatches ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "l" ["files-with-matches"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setListFilesWithMatches) ("Output:\tlist names of files containing at least one match; default '" ++ show (CommandOptions.listFilesWithMatches ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "L" ["files-without-match"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setListFilesWithoutMatch) ("Output:\tlist names of files not containing any matches; default '" ++ show (CommandOptions.listFilesWithoutMatch ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "n" ["number"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setPrependLineNumbers) ("Output:\tprepend the line-number of the input, to the output; default '" ++ show (CommandOptions.prependLineNumbers ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "v" ["invert-match"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setInvertMatch) ("Output:\tselect non-matching lines; default '" ++ show (CommandOptions.invertMatch ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["printCurrentSettings"] (G.NoArg printCurrentSettings) "Output:\tdisplay the currently defined options & then exit.", + G.Option "e" ["regex"] (setExtendedRegExChar `G.ReqArg` "") "Input:\tdefine the regex.", + G.Option "f" ["file"] (readExtendedRegExCharFromFile `G.ReqArg` "") "Input:\tread the regex from file.", + G.Option "" ["performance"] ( + extendedRegExCharPerformance `G.ReqArg` "(Int,Either [TestName])" + ) ( + "Test:\tcompare performance with other RegEx-engines, using the specified pair (, Left " ++ show [ + minBound :: Test.Performance.ExtendedRegExTestsNegative.TestName .. maxBound + ] ++ " or Right " ++ show [ + minBound :: Test.Performance.ExtendedRegExTestsPositive.TestName .. maxBound + ] ++ "). NB: specify this option last." + ), + G.Option "" ["assert"] (assertFromFile `G.ReqArg` "") "Test:\trun the assertions, defined in the specified file, & then exit. NB: specify this option last.", + G.Option "" ["assertPosix"] (assertPosixFromFile `G.ReqArg` "") "Test:\trun the assertions, defined in the specified file, against Text.Regex.Posix, & then exit. NB: specify this option last.", + G.Option "" ["abortTrialRepetitionsOnInherentFailure"] (setExecutionOption abortTrialRepetitionsOnInherentFailure `G.ReqArg` "Bool") ("Performance:\tif an alternative can't match, irrespective of the subsequent concatenation, then terminate futile trial repetitions; default '" ++ show (RegExDot.ExecutionOptions.abortTrialRepetitionsOnInherentFailure ToolShed.Defaultable.defaultValue) ++ "'."), +-- G.Option "" ["abortTrialRepetitionsOnZeroConsumption"] (setExecutionOption abortTrialRepetitionsOnZeroConsumption `G.ReqArg` "Bool") ("Performance:\tcheck for zero data-consumption by the n-th repetition of an alternative, before considering (n + 1); default '" ++ show (RegExDot.ExecutionOptions.abortTrialRepetitionsOnZeroConsumption ToolShed.Defaultable.defaultValue) ++ "'."), +-- G.Option "" ["bypassInputDataForLiberalConsumer"] (setExecutionOption bypassInputDataForLiberalConsumer `G.ReqArg` "Bool") ("Performance:\tbypass reading of the unconsumed input data, if the remaining RegEx can consume a sufficient quantity of anything; default '" ++ show (RegExDot.ExecutionOptions.bypassInputDataForLiberalConsumer ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["catchIncompatibleAnchors"] (setExecutionOption catchIncompatibleAnchors `G.ReqArg` "Bool") ("Performance:\tavoid futile trial solutions, involving repetitions of anchored alternatives, which must consume data; default '" ++ show (RegExDot.ExecutionOptions.catchIncompatibleAnchors ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["checkExistenceOfInelasticTail"] (setExecutionOption checkExistenceOfInelasticTail `G.ReqArg` "Bool") ("Performance:\tif the regex ends in one or more Meta-data, whose repetition-range is precisely defined, check that this sequence exists at the end of the input data; default '" ++ show (RegExDot.ExecutionOptions.checkExistenceOfInelasticTail ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["checkForUnconsumableData"] (setExecutionOption checkForUnconsumableData `G.ReqArg` "Bool") ("Performance:\tcheck whether there's no possibility of consuming some of the input data; default '" ++ show (RegExDot.ExecutionOptions.checkForUnconsumableData ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["moderateGreed"] (setExecutionOption moderateGreed `G.ReqArg` "Bool") ("Performance:\tgreedily consume data, only up to the limit beyond which, future requirements would be compromised; default '" ++ show (RegExDot.ExecutionOptions.moderateGreed ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["permitReorderingOfAlternatives"] (setExecutionOption permitReorderingOfAlternatives `G.ReqArg` "Bool") ("Performance:\tpermit alternatives to be re-ordered, in an attempt to process the cheapest first; default '" ++ show (RegExDot.ExecutionOptions.permitReorderingOfAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["preferAlternativesWhichFeedTheGreedy"] (setExecutionOption preferAlternativesWhichFeedTheGreedy `G.ReqArg` "Bool") ("Preference:\tprefer solutions in which the choice of alternatives directs data from non-greedy to greedy consumers; default '" ++ show (RegExDot.ExecutionOptions.preferAlternativesWhichFeedTheGreedy ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["preferAlternativesWhichMimickUnrolling"] (setExecutionOption preferAlternativesWhichMimickUnrolling `G.ReqArg` "Bool") ("Preference:\tprefer solutions in which the choice of alternatives consumes data like the unrolled repeatable group; default '" ++ show (RegExDot.ExecutionOptions.preferAlternativesWhichMimickUnrolling ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["preferFewerRepeatedAlternatives"] (setExecutionOption preferFewerRepeatedAlternatives `G.ReqArg` "Bool") ("Preference:\tprefer solutions employing fewer repetitions of alternatives, to discourage the capture of null lists; default '" ++ show (RegExDot.ExecutionOptions.preferFewerRepeatedAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["unrollRepeatedSingletonAlternative"] (setExecutionOption unrollRepeatedSingletonAlternative `G.ReqArg` "Bool") ("Performance:\tunroll repetitions of singleton alternatives; this doesn't affect the result; default '" ++ show (RegExDot.ExecutionOptions.unrollRepeatedSingletonAlternative ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["useFirstMatchAmongAlternatives"] (setExecutionOption useFirstMatchAmongAlternatives `G.ReqArg` "Bool") ("Performance:\trather than performing an exhaustive search for the optimal choice amongst alternatives, merely select the first that matches; conform to Perl rather than Posix; default '" ++ show (RegExDot.ExecutionOptions.useFirstMatchAmongAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["validateMinConsumptionOfAlternatives"] (setExecutionOption validateMinConsumptionOfAlternatives `G.ReqArg` "Bool") ("Performance:\twhen the number of repetitions of a group of alternatives is precisely specified, check the availability of the resulting minimum data-requirement; default '" ++ show (RegExDot.ExecutionOptions.validateMinConsumptionOfAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["complyStrictlyWithPosix"] (setCompilationOption complyStrictlyWithPosix `G.ReqArg` "Bool") ("Output:\tdefine the offset of captured data, corresponding to a sub-expression which matched zero times, as the artificial value -1 specified by Posix; currently only affects results of 'assert'; default '" ++ show (RegExDot.CompilationOptions.complyStrictlyWithPosix ToolShed.Defaultable.defaultValue) ++ "'.") + ] where + printVersion, printUsage :: IO CommandOptions.CommandOptions + + printVersion = System.IO.hPutStrLn System.IO.stderr ( + Distribution.Text.display packageIdentifier ++ "\n\nCompiled by " ++ show compiler ++ ".\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.exitSuccess where + packageIdentifier :: Distribution.Package.PackageIdentifier + packageIdentifier = Distribution.Package.PackageIdentifier { + Distribution.Package.pkgName = Distribution.Package.PackageName "grecce", + Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] + } + + author, compiler :: String + author = "Dr. Alistair Ward" + compiler = System.Info.compilerName ++ "-" ++ Data.List.intercalate "." (map show $ Data.Version.versionBranch System.Info.compilerVersion) + + printUsage = System.IO.hPutStrLn System.IO.stderr usageMessage >> System.Exit.exitSuccess + + printCurrentSettings :: CommandLineAction + printCurrentSettings commandOptions = print commandOptions >> System.Exit.exitSuccess + + extendedRegExCharPerformance, readExtendedRegExCharFromFile, assertFromFile, assertPosixFromFile, setExtendedRegExChar :: String -> CommandLineAction + extendedRegExCharPerformance s commandOptions = ( + uncurry $ Test.Performance.ExtendedRegEx.run (CommandOptions.executionOptions commandOptions) + ) (readCommandArg s) >> System.Exit.exitSuccess + + 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) `fmap` Test.Assert.RegExOptsChar.readTests fileName + + if null failedTests + then System.Exit.exitSuccess + else do + mapM_ print failedTests + + System.Exit.exitWith $ System.Exit.ExitFailure 2 + + assertPosixFromFile fileName _ = do + failedTests <- Test.Assert.RegExOptsChar.findFailuresPosix `fmap` Test.Assert.RegExOptsChar.readTests fileName + + if null failedTests + then System.Exit.exitSuccess + else do + mapM_ print failedTests + + System.Exit.exitWith $ System.Exit.ExitFailure 2 + + setExtendedRegExChar s commandOptions = case CommandOptions.extendedRegExChar commandOptions of + 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 + abortTrialRepetitionsOnInherentFailure s e = e { RegExDot.ExecutionOptions.abortTrialRepetitionsOnInherentFailure = readCommandArg s } +-- abortTrialRepetitionsOnZeroConsumption s e = e { RegExDot.ExecutionOptions.abortTrialRepetitionsOnZeroConsumption = readCommandArg s } +-- bypassInputDataForLiberalConsumer s e = e { RegExDot.ExecutionOptions.bypassInputDataForLiberalConsumer = readCommandArg s } + catchIncompatibleAnchors s e = e { RegExDot.ExecutionOptions.catchIncompatibleAnchors = readCommandArg s } + checkExistenceOfInelasticTail s e = e { RegExDot.ExecutionOptions.checkExistenceOfInelasticTail = readCommandArg s } + checkForUnconsumableData s e = e { RegExDot.ExecutionOptions.checkForUnconsumableData = readCommandArg s } + moderateGreed s e = e { RegExDot.ExecutionOptions.moderateGreed = readCommandArg s } + permitReorderingOfAlternatives s e = e { RegExDot.ExecutionOptions.permitReorderingOfAlternatives = readCommandArg s } + preferAlternativesWhichFeedTheGreedy s e = e { RegExDot.ExecutionOptions.preferAlternativesWhichFeedTheGreedy = readCommandArg s } + preferAlternativesWhichMimickUnrolling s e = e { RegExDot.ExecutionOptions.preferAlternativesWhichMimickUnrolling = readCommandArg s } + preferFewerRepeatedAlternatives s e = e { RegExDot.ExecutionOptions.preferFewerRepeatedAlternatives = readCommandArg s } + unrollRepeatedSingletonAlternative s e = e { RegExDot.ExecutionOptions.unrollRepeatedSingletonAlternative = readCommandArg s } + useFirstMatchAmongAlternatives s e = e { RegExDot.ExecutionOptions.useFirstMatchAmongAlternatives = readCommandArg s } + validateMinConsumptionOfAlternatives s e = e { RegExDot.ExecutionOptions.validateMinConsumptionOfAlternatives = readCommandArg s } + + complyStrictlyWithPosix :: CommandOptions.CompilationOptionsMutator + complyStrictlyWithPosix s e = e { RegExDot.CompilationOptions.complyStrictlyWithPosix = readCommandArg s } + + setCompilationOption :: CommandOptions.CompilationOptionsMutator -> String -> CommandLineAction + setCompilationOption compilationOptionsMutator s = return {-to IO-monad-} . CommandOptions.setCompilationOption compilationOptionsMutator s + + setExecutionOption :: CommandOptions.ExecutionOptionsMutator -> String -> CommandLineAction + setExecutionOption executionOptionsMutator s = return {-to IO-monad-} . CommandOptions.setExecutionOption executionOptionsMutator s + + args <- System.Environment.getArgs + +-- 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. + + 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-lib/RegExChar/ExtendedRegExChar.hs b/src-lib/RegExChar/ExtendedRegExChar.hs new file mode 100644 --- /dev/null +++ b/src-lib/RegExChar/ExtendedRegExChar.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] An 'RegExDot.RegEx.ExtendedRegEx', which has been specialised for 'Char', to create a tradition non-polymorphic /regex/. +-} + +module RegExChar.ExtendedRegExChar( +-- * Types +-- ** Type-synonyms + ExtendedRegExChar(..), + InputData, +-- * Functions +-- ** Operators + (+~), + (=~), + (/~) +) where + +import qualified Data.List +import qualified RegExChar.MetaChar as MetaChar +import qualified RegExDot.Anchor +import qualified RegExDot.Consumer +import RegExDot.DSL((<~>), (-:)) +import qualified RegExDot.RegEx +import qualified RegExDot.RegExOpts +import qualified RegExDot.Repeatable +import qualified Text.ParserCombinators.Parsec as Parsec +import Text.ParserCombinators.Parsec((), (<|>)) +import qualified ToolShed.Data.Pair +import qualified ToolShed.SelfValidate + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative((<$>), (<*>)) +#endif + +infix 4 +~, =~, /~ -- Same as (==) & (/=). + +-- | Specialise a 'RegExDot.RegEx.ExtendedRegEx' for 'Char', & encapsulate it to permit tailored instance-declarations. +data ExtendedRegExChar = MkExtendedRegExChar { + hasNonCapturingTopLevelAlternatives :: Bool, -- ^ The string from which a 'RegExDot.RegEx.ExtendedRegEx' is read, may, if data-capture isn't required, omit explicit delimiters around top-level 'RegExDot.RegEx.Alternatives'. + extendedRegEx :: RegExDot.RegEx.ExtendedRegEx Char +} deriving Eq + +-- | Abbreviation. +type InputData = RegExDot.RegEx.InputData Char + +instance ToolShed.SelfValidate.SelfValidator ExtendedRegExChar where + getErrors MkExtendedRegExChar { + hasNonCapturingTopLevelAlternatives = hasNonCapturingTopLevelAlternatives', + extendedRegEx = extendedRegEx' + } + | not $ ToolShed.SelfValidate.isValid extendedRegEx' = ToolShed.SelfValidate.getErrors extendedRegEx' + | otherwise = ToolShed.SelfValidate.extractErrors [ + (hasNonCapturingTopLevelAlternatives' && any (not . RegExDot.RegEx.isCaptureGroup . RegExDot.Repeatable.base) (RegExDot.RegEx.concatenation extendedRegEx'), "Invalid NonCapturingTopLevelAlternatives.") + ] + +instance RegExDot.Consumer.Consumer ExtendedRegExChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . extendedRegEx + starHeight = RegExDot.Consumer.starHeight . extendedRegEx + +instance RegExDot.RegEx.ShortcutExpander Char where + expand c = error $ "RegExDot.RegEx.ShortcutExpander.expand RegExChar.ExtendedRegExChar:\tunrecognised shortcut '" ++ show c ++ "'." + +instance Read ExtendedRegExChar where + readsPrec _ s + | s == reverse RegExDot.Anchor.tokens = [ + ( + MkExtendedRegExChar { + hasNonCapturingTopLevelAlternatives = False, + extendedRegEx = (Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~> [] + }, + "" + ) + ] -- 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. + + 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 + extendedRegExParser :: Parsec.Parser (RegExDot.RegEx.ExtendedRegEx Char) + extendedRegExParser = do + maybeBowAnchor <- Parsec.option Nothing {-default-} $ (Parsec.char RegExDot.Anchor.bowToken "RegExDot.Anchor.bowToken " ++ show RegExDot.Anchor.bowToken) >> return {-to ParsecT-monad-} (Just RegExDot.Anchor.Bow) + repeatableRequirementList <- repeatableRequirementListParser + + ( + do + repeatableCaptureGroup <- RegExDot.Repeatable.repeatableParser . RegExDot.RegEx.CaptureGroup =<< uncurry Parsec.between ( + ToolShed.Data.Pair.mirror Parsec.char RegExDot.RegEx.captureGroupDelimiters + ) alternativesParser {-recurse-} "RegExDot.RegEx.captureGroupDelimiters " ++ show RegExDot.RegEx.captureGroupDelimiters + + extendedRegEx' <- extendedRegExParser -- Recurse. + + return {-to ParsecT-monad-} $ RegExDot.RegEx.transformExtendedRegEx ((repeatableRequirementList ++) . (repeatableCaptureGroup :)) extendedRegEx' { RegExDot.RegEx.bowAnchor = maybeBowAnchor } + ) <|> ( + do + maybeSternAnchor <- Parsec.option Nothing {-default-} $ (Parsec.char RegExDot.Anchor.sternToken "RegExDot.Anchor.sternToken " ++ show RegExDot.Anchor.sternToken) >> return {-to ParsecT-monad-} (Just RegExDot.Anchor.Stern) + + return {-to ParsecT-monad-} RegExDot.RegEx.MkExtendedRegEx { + RegExDot.RegEx.bowAnchor = maybeBowAnchor, + RegExDot.RegEx.concatenation = repeatableRequirementList, + RegExDot.RegEx.sternAnchor = maybeSternAnchor + } + ) + where + repeatableRequirementListParser :: Parsec.Parser (RegExDot.RegEx.Concatenation Char) + repeatableRequirementListParser = Parsec.choice [ + Parsec.try . Parsec.lookAhead $ ( + Parsec.char RegExDot.Anchor.sternToken "RegExDot.Anchor.sternToken " ++ show RegExDot.Anchor.sternToken + ) >> ( + ( + Parsec.eof >> return {-to ParsecT-monad-} [] + ) <|> ( + Parsec.oneOf [RegExDot.RegEx.alternativeExtendedRegExSeparatorToken, snd RegExDot.RegEx.captureGroupDelimiters] >> return {-to ParsecT-monad-} [] + ) + ), + (:) <$> ( + MetaChar.metaCharParser >>= RegExDot.Repeatable.repeatableParser . RegExDot.RegEx.Require . MetaChar.deconstruct + ) <*> repeatableRequirementListParser, {-recurse-} + return {-to ParsecT-monad-} [] + ] + + in ( + 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. + ) $ Parsec.parse ( + (,) <$> extendedRegExCharParser <*> Parsec.getInput + ) "ExtendedRegExChar" s + +instance Show ExtendedRegExChar where + showsPrec _ MkExtendedRegExChar { + hasNonCapturingTopLevelAlternatives = hasNonCapturingTopLevelAlternatives', + extendedRegEx = RegExDot.RegEx.MkExtendedRegEx { + RegExDot.RegEx.bowAnchor = maybeBowAnchor, + RegExDot.RegEx.concatenation = concatenation', + RegExDot.RegEx.sternAnchor = maybeSternAnchor + } + } = RegExDot.RegEx.showsMaybeAnchor maybeBowAnchor . foldl (.) (showString "") ( + ( + let + showAlternatives :: RegExDot.RegEx.Alternatives Char -> [ShowS] + showAlternatives = Data.List.intersperse (showChar RegExDot.RegEx.alternativeExtendedRegExSeparatorToken) . map (shows . MkExtendedRegExChar False) . RegExDot.RegEx.deconstructAlternatives + in if hasNonCapturingTopLevelAlternatives' + then map ( + \repeatablePattern -> case RegExDot.Repeatable.base repeatablePattern of + RegExDot.RegEx.CaptureGroup alternatives -> foldr (.) (showString "") $ showAlternatives alternatives + _ -> error $ "Show RegExChar.ExtendedRegExChar: unexpected " ++ show repeatablePattern + ) + else map ( + \repeatablePattern -> ( + case RegExDot.Repeatable.base repeatablePattern of + RegExDot.RegEx.Require meta -> shows $ MetaChar.MkMetaChar meta + RegExDot.RegEx.CaptureGroup alternatives -> showChar ( + fst RegExDot.RegEx.captureGroupDelimiters + ) . foldr (.) ( + showChar $ snd RegExDot.RegEx.captureGroupDelimiters -- Initial value. + ) ( + showAlternatives alternatives + ) + ) . RegExDot.Repeatable.showSuffix repeatablePattern + ) + ) concatenation' + ) . RegExDot.RegEx.showsMaybeAnchor maybeSternAnchor + +-- | 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. + -> RegExDot.RegEx.Result Char +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: . + +-- | Pattern-mismatch operator. +(/~) + :: InputData -- ^ The input-data string. + -> RegExDot.RegExOpts.RegExOpts ExtendedRegExChar -- ^ The match-options, parameterised by the regex-specification. + -> Bool +(/~) inputData = not . (inputData =~) + diff --git a/src-lib/RegExChar/MetaChar.hs b/src-lib/RegExChar/MetaChar.hs new file mode 100644 --- /dev/null +++ b/src-lib/RegExChar/MetaChar.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Implements 'RegExDot.Meta.ShortcutExpander' 'Char', to implement some of the traditional /Perl-style shortcuts/: + + [@\\d@] => Any 'Data.Char.isDigit'-character. + + [@\\D@] => Any non-'Data.Char.isDigit' character. + + [@\\s@] => Any 'Data.Char.isSpace'-character. + + [@\\S@] => Any non-'Data.Char.isSpace' character. + + [@\\w@] => Any 'Data.Char.isWord' letter. + + [@\\W@] => Any non-'Data.Char.isWord' letter. + + * Enables one to compose concise regexen, containing any 'Char' that's a member of one of these predefined sets. + + * Though 'RegExDot.Meta.Meta' is polymorphic, & the type-parameter can't be assumed to implement either 'Enum' or 'Ord', + 'Char' actually does, so this module is able to implement ranges within a /Bracket-expression/. + + * Defines specialised instances of 'Read' & 'Show', to cope with /Perl-style shortcuts/, /Posix Character-classes/ & /Bracket-expression/ range-specifications. + + [@TODO@] Use @Environment.getLocale@. Regrettably, this returns in the "IO"-monad, & even it didn't, how does one pass that information to 'Read' ?! +-} + +module RegExChar.MetaChar( +-- * Types +-- AssociationList, +-- Dictionary, +-- ** Type-synonyms + MetaChar(..), +-- * Constants +-- bracketExpressionRangeToken, +-- posixCharacterClassDelimiters, +-- * Functions +-- implementPerlShortcut, + metaCharParser, +-- ** Accessors (Deconstructors) + deconstruct +) where + +import Control.Arrow((***)) +import qualified Data.Char +import qualified Data.Map +import qualified RegExDot.BracketExpression +import qualified RegExDot.BracketExpressionMember +import qualified RegExDot.Consumer +import qualified RegExDot.Meta +import qualified RegExDot.RegEx +import qualified RegExDot.Repeatable +import qualified RegExDot.ShowablePredicate +import qualified Text.ParserCombinators.Parsec as Parsec +import Text.ParserCombinators.Parsec(()) +import qualified ToolShed.Data.Pair +import qualified ToolShed.SelfValidate + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative((<$>), (<*>)) +#endif + +-- | Holds a mapping from an escape-sequence & the predicate via which it is implemented. +type AssociationList key = [(key, RegExDot.ShowablePredicate.Predicate Char)] + +-- | Holds a mapping from an escape-sequence & the predicate via which it is implemented. +type Dictionary key = Data.Map.Map key (RegExDot.ShowablePredicate.Predicate Char) + +instance RegExDot.BracketExpressionMember.ShortcutExpander Char where + findPredicate shortcut = RegExDot.ShowablePredicate.MkShowablePredicate [RegExDot.Meta.shortcutToken, shortcut] <$> shortcut `Data.Map.lookup` dictionary where + dictionary :: Dictionary Char + dictionary = Data.Map.fromList $ perlShortcuts ++ invert perlShortcuts where + perlShortcuts :: AssociationList Char + perlShortcuts = [ + ('d', Data.Char.isDigit), + ('s', Data.Char.isSpace), + ('w', \c -> ($ c) `any` [Data.Char.isAlphaNum, (== '_')]) + ] + + invert :: AssociationList Char -> AssociationList Char + invert = map (Data.Char.toUpper *** (not .)) + +instance RegExDot.Meta.ShortcutExpander Char where + expand c = case RegExDot.BracketExpressionMember.findPredicate c of + Just showablePredicate -> RegExDot.Meta.Predicate showablePredicate + _ -> RegExDot.Meta.Literal c + +-- | A specialised instance, encapsulated to permit tailored instance-declarations. +newtype MetaChar = MkMetaChar (RegExDot.Meta.Meta Char) deriving Eq + +-- | Accessor. +deconstruct :: MetaChar -> RegExDot.Meta.Meta Char +deconstruct (MkMetaChar metaChar) = metaChar + +instance ToolShed.SelfValidate.SelfValidator MetaChar where + getErrors = ToolShed.SelfValidate.getErrors . deconstruct + +instance RegExDot.Consumer.Consumer MetaChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstruct + starHeight = RegExDot.Consumer.starHeight . deconstruct + +-- | Builds a parser of traditional regex-syntax, which understands 'Char'-specific concepts like /Perl-style shortcuts/ & /Posix Character-classes/. +metaCharParser :: Parsec.Parser MetaChar +metaCharParser = MkMetaChar <$> Parsec.choice [ + (Parsec.char RegExDot.Meta.anyToken "RegExDot.Meta.anyToken " ++ show RegExDot.Meta.anyToken) >> return {-to ParsecT-monad-} RegExDot.Meta.Any, + (Parsec.char RegExDot.Meta.shortcutToken "RegExDot.Meta.shortcutToken " ++ show RegExDot.Meta.shortcutToken) >> RegExDot.Meta.expand <$> Parsec.anyChar, + uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.char RegExDot.BracketExpression.delimiterTokens) ( + do + let + implementPosixCharacterClass :: String -> Maybe (RegExDot.ShowablePredicate.ShowablePredicate Char) + implementPosixCharacterClass identifier = RegExDot.ShowablePredicate.MkShowablePredicate ( + fst posixCharacterClassDelimiters ++ identifier ++ snd posixCharacterClassDelimiters + ) <$> identifier `Data.Map.lookup` dictionary where + dictionary :: Dictionary String + dictionary = Data.Map.fromList $ posixCharacterClasses ++ invert posixCharacterClasses where + posixCharacterClasses :: AssociationList String + posixCharacterClasses = [ + ("alnum", Data.Char.isAlphaNum), + ("alpha", Data.Char.isAlpha), + ("ascii", Data.Char.isAscii), + ("blank", (`elem` " \t")), + ("cntrl", Data.Char.isControl), + ("digit", Data.Char.isDigit), + ("graph", \c -> not $ ($ c) `any` [Data.Char.isSpace, Data.Char.isControl]), + ("lower", Data.Char.isLower), + ("print", Data.Char.isPrint), + ("punct", Data.Char.isPunctuation), + ("space", Data.Char.isSpace), + ("upper", Data.Char.isUpper), + ("word", \c -> ($ c) `any` [Data.Char.isAlphaNum, (== '_')]), + ("xdigit", Data.Char.isHexDigit) + ] + + invert :: AssociationList String -> AssociationList String + invert = map $ (RegExDot.BracketExpression.negationToken :) *** (not .) + + cTor <- Parsec.option RegExDot.Meta.AnyOf {-default-} $ (Parsec.char RegExDot.BracketExpression.negationToken "RegExDot.BracketExpression.negationToken " ++ show RegExDot.BracketExpression.negationToken) >> return {-to ParsecT-monad-} RegExDot.Meta.NoneOf + + 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'. + + cTor . (literalBracketExpressionTerminator ++) <$> Parsec.many {-potentially zero-} ( + Parsec.choice [ + ( + do + _ <- Parsec.char RegExDot.Meta.shortcutToken "RegExDot.Meta.shortcutToken " ++ show RegExDot.Meta.shortcutToken + c <- Parsec.anyChar + + return {-to ParsecT-monad-} $ case RegExDot.BracketExpressionMember.findPredicate c of + Just showablePredicate -> RegExDot.BracketExpressionMember.Predicate showablePredicate + _ -> RegExDot.BracketExpressionMember.Literal c -- Escaped literal. + ) "Perl-style shortcut", + Parsec.try ( + uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.string posixCharacterClassDelimiters) ( + do + identifier <- Parsec.many1 $ Parsec.noneOf [head $ snd posixCharacterClassDelimiters] + + case implementPosixCharacterClass identifier of + 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. + Parsec.try ( + ( + do + rangeStart <- Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] + _ <- Parsec.char bracketExpressionRangeToken "bracketExpressionRangeToken " ++ show bracketExpressionRangeToken + rangeEnd <- Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] + + return {-to ParsecT-monad-} . RegExDot.BracketExpressionMember.Predicate . RegExDot.ShowablePredicate.MkShowablePredicate [ + rangeStart, + bracketExpressionRangeToken, + rangeEnd + ] $ \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 ']'. + ] "Bracket-expression member" + ) "Bracket-expression member-list" + ) "RegExDot.BracketExpression.delimiterTokens " ++ show RegExDot.BracketExpression.delimiterTokens, + RegExDot.Meta.Literal <$> Parsec.noneOf RegExDot.RegEx.tokens + ] + +instance Read MetaChar where + readsPrec _ = ( + (fail . ("readsPrec RegExChar.MetaChar:\tparse-error; " ++) . show) `either` return + ) . Parsec.parse ( + (,) <$> metaCharParser <*> Parsec.getInput + ) "MetaChar" + +-- | The token used to signify an ordered range of members in a /Bracket-expression/. +bracketExpressionRangeToken :: Char +bracketExpressionRangeToken = '-' + +-- | The delimiters of a /Posix Character-class/. +posixCharacterClassDelimiters :: (String, String) +posixCharacterClassDelimiters = ("[:", ":]") + +instance Show MetaChar where + showsPrec _ (MkMetaChar RegExDot.Meta.Any) = showChar RegExDot.Meta.anyToken + showsPrec _ (MkMetaChar (RegExDot.Meta.Literal c)) = ( + if c `elem` [ + fst RegExDot.BracketExpression.delimiterTokens, + fst RegExDot.Repeatable.rangeDelimiters, + RegExDot.Repeatable.oneOrMoreToken, + RegExDot.Repeatable.zeroOrMoreToken, + RegExDot.Repeatable.zeroOrOneToken, + RegExDot.Meta.anyToken, + RegExDot.Meta.shortcutToken + ] ++ RegExDot.RegEx.tokens + then showChar RegExDot.Meta.shortcutToken + else id + ) . showChar c + showsPrec _ (MkMetaChar (RegExDot.Meta.AnyOf bracketExpression)) = showChar ( + fst RegExDot.BracketExpression.delimiterTokens + ) . showString ( + foldr ( + \e -> case e of + 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". + RegExDot.Meta.shortcutToken, + 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. + ) bracketExpression + ) + showsPrec _ (MkMetaChar (RegExDot.Meta.NoneOf bracketExpression)) = showChar x . showChar RegExDot.BracketExpression.negationToken . showString xs where (x : xs) = show . MkMetaChar $ RegExDot.Meta.AnyOf bracketExpression + showsPrec _ (MkMetaChar m) = shows m + diff --git a/src-lib/RegExChar/RegExOptsChar.hs b/src-lib/RegExChar/RegExOptsChar.hs new file mode 100644 --- /dev/null +++ b/src-lib/RegExChar/RegExOptsChar.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Creates a /back-end/ implementation, conforming to . + + [@CAVEATS@] + + * The underlying polymorphic (in terms of the base-type of the list of input data) 'RegExDot.RegEx.ExtendedRegEx'-engine is never going to be a drop-in replacement for other /regex/-engines, + so this standard interface has only been implemented for traditional input data-type ['Char']. + + * The standard interface requires many Haskell-extensions, but since this implementation is just a thin layer over the underlying portable polymorphic 'RegExDot.RegEx.ExtendedRegEx'-engine, + the latter can still be used directly, where any of these extensions are unavailable. +-} + +module RegExChar.RegExOptsChar( +-- * Types +-- ** Type-synonyms + MatchSpan, +-- MatchDataSpan, + RegExOptsChar, +-- * Functions +-- exciseNonCapturingTopLevelAlternatives, +-- matchUntilFailure, +-- toMatchDataSpanList, + toZeroIndexedArray, +-- ** Operators + (=~) +-- ** Predicates +-- complyStrictlyWithPosix, +-- hasNonCapturingTopLevelAlternatives +) where + +import qualified Data.Array.IArray +import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar +import qualified RegExDot.CompilationOptions +import qualified RegExDot.ConsumptionBounds +import qualified RegExDot.DataSpan +import qualified RegExDot.DataSpanTree +import qualified RegExDot.ExecutionOptions +import qualified RegExDot.RegEx +import qualified RegExDot.RegExOpts +import qualified RegExDot.Result +import qualified RegExDot.Tree +import qualified Text.Regex.Base.RegexLike as RegexLike +import Text.Regex.Base.Context() -- Instance-declarations. +import qualified ToolShed.Data.List +import qualified ToolShed.Defaultable +import qualified ToolShed.Options + +infix 4 =~ -- Same as (==). + +-- | Defines a specific instance of the polymorphic base-type. +type RegExOptsChar = RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar + +-- | Convenience accessor-function. +hasNonCapturingTopLevelAlternatives :: RegExOptsChar -> Bool +hasNonCapturingTopLevelAlternatives = ExtendedRegExChar.hasNonCapturingTopLevelAlternatives . RegExDot.RegExOpts.regEx + +-- | Convenience accessor-function. +complyStrictlyWithPosix :: RegExOptsChar -> Bool +complyStrictlyWithPosix = RegExDot.CompilationOptions.complyStrictlyWithPosix . RegExDot.RegExOpts.compilationOptions + +instance RegexLike.RegexOptions RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions where + blankCompOpt = ToolShed.Options.blankValue + blankExecOpt = ToolShed.Options.blankValue + defaultCompOpt = ToolShed.Defaultable.defaultValue + defaultExecOpt = ToolShed.Defaultable.defaultValue + 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. +instance RegexLike.RegexMaker RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions String where + makeRegexOpts c e source = RegExDot.RegExOpts.MkRegExOpts { + RegExDot.RegExOpts.compilationOptions = c, + RegExDot.RegExOpts.executionOptions = e, + RegExDot.RegExOpts.regEx = read source + } + +-- | The offset and length of the 'RegExDot.RegEx.InputData' consumed in one 'RegExDot.RegEx.Match'. +type MatchSpan = (RegexLike.MatchOffset, RegexLike.MatchLength) + +{- | + * The 'MatchSpan' augmented by the consumed 'ExtendedRegExChar.InputData' to which it refers. + + * Similar to 'RegExDot.DataSpan.DataSpan'. +-} +type MatchDataSpan = (ExtendedRegExChar.InputData, MatchSpan) + +{- | + * Convert the 'RegExDot.RegEx.MatchList', into the 'MatchDataSpan's required by "Text.Regex.Base.RegexLike". + + * Treat the whole 'ExtendedRegExChar.ExtendedRegExChar' as an additional implicit capture-group. + + * CAVEAT: @RegExDot.DataSpanTree.extractCaptureGroups True@ may return some 'RegExDot.DataSpan.DataSpan's containing the artificial offset @-1@ specified by Posix => don't use this as the basis for any arithmetic. +-} +toMatchDataSpanList + :: Bool + -> 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 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. + | otherwise = id + +-- | Convert the specified list, into a zero-indexed array. +toZeroIndexedArray :: [e] -> Data.Array.IArray.Array Int e +toZeroIndexedArray l = Data.Array.IArray.listArray (0, pred $ length l) l + +{- | + * Repeatedly apply the 'RegExOptsChar' to the 'ExtendedRegExChar.InputData', forwarding unmatched input data to the next match-attempt, until it's all been consumed. + + * The offsets, from the start of the input data, of all matches after the first, are shifted to account for input data already consumed by previous matches. +-} +matchUntilFailure + :: RegExOptsChar -- ^ The match-criteria. + -> ExtendedRegExChar.InputData -- ^ The input-data, to be consumed by repeated matching. + -> [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: . + (_, Just matchList, maybeSternAnchorResult) -> matchList : if null (RegExDot.RegEx.extractDataFromMatchList matchList) then [] else matchUntilFailure' (RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult) + _ -> [] + + shiftOffsets :: RegExDot.ConsumptionBounds.DataLength -> [RegExDot.RegEx.MatchList Char] -> [RegExDot.RegEx.MatchList Char] + shiftOffsets offset (matchList : matchLists) = let + shiftedMatchList :: RegExDot.RegEx.MatchList Char + shiftedMatchList = RegExDot.RegEx.shiftMatchList offset matchList + in shiftedMatchList : shiftOffsets (RegExDot.DataSpan.after . last . RegExDot.DataSpanTree.flattenTreeList 0 $ RegExDot.DataSpanTree.toTreeList shiftedMatchList) matchLists {-recurse-} + shiftOffsets _ _ = [] + +instance RegexLike.RegexLike RegExOptsChar ExtendedRegExChar.InputData where +{- E.g.: + ("xabcdxabdxxadx" RegExOptsChar.=~ "a(b(c?))*d") :: [Text.Regex.Base.RegexLike.MatchArray] + [array (0,2) [(0,(1,4)),(1,(2,2)),(2,(3,1))],array (0,2) [(0,(6,3)),(1,(7,1)),(2,(8,0))],array (0,1) [(0,(11,2)),(1,(-1,0))]] +-} +-- matchAll :: RegExOptsChar -> ExtendedRegExChar.InputData -> [RegexLike.MatchArray] + matchAll regExOptsChar = map (toZeroIndexedArray . map snd {-span-} . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar + +{- E.g.: + ("xabcdxabdxxadx" RegExOptsChar.=~ "a(b(c?))*d") :: [Text.Regex.Base.RegexLike.MatchText String] + [array (0,2) [(0,("abcd",(1,4))),(1,("bc",(2,2))),(2,("c",(3,1)))],array (0,2) [(0,("abd",(6,3))),(1,("b",(7,1))),(2,("",(8,0)))],array (0,1) [(0,("ad",(11,2))),(1,("",(-1,0)))]] +-} +-- matchAllText :: RegExOptsChar -> ExtendedRegExChar.InputData -> [RegexLike.MatchText ExtendedRegExChar.InputData] + matchAllText regExOptsChar = map (toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar + +{- E.g.: + ("xabcdx" RegExOptsChar.=~ "a(b(c?))*d") :: Text.Regex.Base.RegexLike.MatchArray + 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 + ) + ) `fmap` RegExDot.Result.getMatchList extendedRegExResult where + extendedRegExResult :: RegExDot.RegEx.Result Char + 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: . + (maybeBowAnchorResult, Just matchList, maybeSternAnchorResult) -> Just ( + RegExDot.RegEx.extractDataFromMatch' maybeBowAnchorResult, + toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar $ toMatchDataSpanList ( + complyStrictlyWithPosix regExOptsChar + ) ( + RegExDot.RegEx.externalMatchLength maybeBowAnchorResult + ) matchList, + RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult + ) + _ -> Nothing + +{- E.g.: + ("xabcdx" RegExOptsChar.=~ "a(b(c?))*d") :: Bool + True +-} +-- matchTest :: RegExOptsChar -> ExtendedRegExChar.InputData -> Bool + matchTest = flip (ExtendedRegExChar.=~) -- CAVEAT: . + +{- | + * Match-operator. + + * The polymorphic return-type is resolved by the caller's "RegexLike.RegexContext". +-} +(=~) :: RegexLike.RegexContext RegExOptsChar ExtendedRegExChar.InputData target + => ExtendedRegExChar.InputData -- ^ The input data. + -> String -- ^ The string from which to read the regex-specification. + -> target -- ^ The polymorphic return-type. +inputData =~ s = (RegexLike.makeRegex s :: RegExOptsChar) `RegexLike.match` inputData + diff --git a/src-test/Grecce/Test/QC/ExtendedRegExChar.hs b/src-test/Grecce/Test/QC/ExtendedRegExChar.hs new file mode 100644 --- /dev/null +++ b/src-test/Grecce/Test/QC/ExtendedRegExChar.hs @@ -0,0 +1,192 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' & defines tests based on it. +-} + +module Grecce.Test.QC.ExtendedRegExChar( +-- * Constants + results, +-- * Types +-- ** Data-types +-- AlternativesChar(..), +-- PatternChar(..), +-- RepeatablePatternChar(..), +-- * Functions +-- ** Accessors +-- deconstructAlternativesChar, +-- deconstructPatternChar, +-- deconstructRepeatablePatternChar +) where + +import qualified Data.Maybe +import Grecce.Test.QC.MetaChar() +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 +import qualified RegExDot.Consumer +import qualified RegExDot.ConsumptionBounds +import qualified RegExDot.ConsumptionProfile +import RegExDot.DSL((-:), (?:), (+:), (<~>)) +import qualified RegExDot.Meta +import qualified RegExDot.RegEx +import RegExDot.RegEx((+~)) +import qualified RegExDot.RegExOpts +import qualified RegExDot.Repeatable +import qualified RegExDot.Result +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) +import qualified ToolShed.SelfValidate +import qualified ToolShed.Test.ReversibleIO + +-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. +newtype AlternativesChar = MkAlternativesChar (RegExDot.RegEx.Alternatives Char) deriving (Eq, Read, Show) + +-- | Accessor. +deconstructAlternativesChar :: AlternativesChar -> RegExDot.RegEx.Alternatives Char +deconstructAlternativesChar (MkAlternativesChar a) = a + +instance ToolShed.SelfValidate.SelfValidator AlternativesChar where + getErrors = ToolShed.SelfValidate.getErrors . deconstructAlternativesChar + +instance RegExDot.Consumer.Consumer AlternativesChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructAlternativesChar + starHeight = RegExDot.Consumer.starHeight . deconstructAlternativesChar + +instance Test.QuickCheck.Arbitrary AlternativesChar where + arbitrary = (MkAlternativesChar . RegExDot.RegEx.MkAlternatives . map ExtendedRegExChar.extendedRegEx) `fmap` ( + Test.QuickCheck.elements [1, 2] >>= Test.QuickCheck.vector {-[ExtendedRegExChar]-} + ) -- TODO: permit zero alternatives. + +-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. +newtype PatternChar = MkPatternChar (RegExDot.RegEx.Pattern Char) deriving (Eq, Read, Show) + +-- | Accessor. +deconstructPatternChar :: PatternChar -> RegExDot.RegEx.Pattern Char +deconstructPatternChar (MkPatternChar pattern) = pattern + +instance ToolShed.SelfValidate.SelfValidator PatternChar where + getErrors = ToolShed.SelfValidate.getErrors . deconstructPatternChar + +instance RegExDot.Consumer.Consumer PatternChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructPatternChar + starHeight = RegExDot.Consumer.starHeight . deconstructPatternChar + +instance Test.QuickCheck.Arbitrary PatternChar where + 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) + +-- | Accessor. +deconstructRepeatablePatternChar :: RepeatablePatternChar -> RegExDot.Repeatable.Repeatable PatternChar +deconstructRepeatablePatternChar (MkRepeatablePatternChar repeatable) = repeatable + +instance ToolShed.SelfValidate.SelfValidator RepeatablePatternChar where + getErrors = ToolShed.SelfValidate.getErrors . deconstructRepeatablePatternChar + +instance RegExDot.Consumer.Consumer RepeatablePatternChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructRepeatablePatternChar + starHeight = RegExDot.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 `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] + isGreedy <- Test.QuickCheck.arbitrary {-Bool-} + + let + repetitionBounds :: RegExDot.Repeatable.RepetitionBounds + repetitionBounds = (fewest, most) + + 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. + } + +instance Test.QuickCheck.Arbitrary ExtendedRegExChar.ExtendedRegExChar where + arbitrary = do + hasBowAnchor <- Test.QuickCheck.arbitrary {-Bool-} + 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 { + RegExDot.RegEx.bowAnchor = if hasBowAnchor then Just RegExDot.Anchor.Bow else Nothing, + RegExDot.RegEx.concatenation = concatenation, + RegExDot.RegEx.sternAnchor = if hasSternAnchor then Just RegExDot.Anchor.Stern else Nothing + } + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_consumptionProfile, + Test.QuickCheck.quickCheckResult prop_consumptionProfile2, + Test.QuickCheck.quickCheckResult prop_io, + Test.QuickCheck.quickCheckResult prop_io', + Test.QuickCheck.quickCheckResult prop_isValid, + Test.QuickCheck.quickCheckResult prop_starHeight, + Test.QuickCheck.quickCheckResult prop_double + ] where + prop_consumptionProfile, prop_consumptionProfile2, prop_io, prop_io', prop_isValid, prop_starHeight :: ExtendedRegExChar.ExtendedRegExChar -> Test.QuickCheck.Property + prop_consumptionProfile r = Test.QuickCheck.label "prop_consumptionProfile" $ Data.Maybe.maybe True (>= minData) maybeMaxData && ( + not b == all (not . RegExDot.Consumer.getHasSpecificRequirement) (RegExDot.RegEx.concatenation $ ExtendedRegExChar.extendedRegEx r) + ) + where + RegExDot.ConsumptionProfile.MkConsumptionProfile { + RegExDot.ConsumptionProfile.consumptionBounds = (minData, maybeMaxData), + RegExDot.ConsumptionProfile.hasSpecificRequirement = b + } = RegExDot.Consumer.consumptionProfile r + + prop_consumptionProfile2 r = RegExDot.RegEx.isDefined (ExtendedRegExChar.extendedRegEx r) ==> Test.QuickCheck.label "prop_consumptionProfile2" $ 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, + RegExDot.ConsumptionProfile.canConsumeAnything = canConsumeAnything + } = 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_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) + + 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. + + result :: RegExDot.RegEx.Result Char + result = s +~ RegExDot.RegExOpts.mkRegEx ( + (Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~> sign ?: digits +: map ( + RegExDot.Repeatable.zeroOrOne . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} + ) [ + RegExDot.RegEx.Require (RegExDot.Meta.Literal '.') -: digits +: [], + RegExDot.RegEx.Require (RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal "eE") -: sign ?: digits +: [] + ] + ) where + sign, digits :: RegExDot.RegEx.Pattern Char + sign = RegExDot.RegEx.Require . RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal "+-" + digits = RegExDot.RegEx.Require . RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal ['0' .. '9'] + diff --git a/src-test/Grecce/Test/QC/MetaChar.hs b/src-test/Grecce/Test/QC/MetaChar.hs new file mode 100644 --- /dev/null +++ b/src-test/Grecce/Test/QC/MetaChar.hs @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + 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 + 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 . +-} +{- | + [@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( +-- * Constants + results, +-- testCharacters, +-- * Types +-- ** Type-synonyms +-- Testable +) where + +import qualified Data.List +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 + +testCharacters :: String +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 (fmap MetaChar.MkMetaChar) [ + return {-to Gen-monad-} RegExDot.Meta.Any, + 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)) `fmap` Test.QuickCheck.vector maxBound {-Char-} + +type Testable = MetaChar.MetaChar -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_io] where + prop_io :: Testable + prop_io = Test.QuickCheck.label "prop_io" . ToolShed.Test.ReversibleIO.isReversible + diff --git a/src-test/Grecce/Test/QC/RepeatableMetaChar.hs b/src-test/Grecce/Test/QC/RepeatableMetaChar.hs new file mode 100644 --- /dev/null +++ b/src-test/Grecce/Test/QC/RepeatableMetaChar.hs @@ -0,0 +1,92 @@ +{- + 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' & defines tests based on it. +-} + +module Grecce.Test.QC.RepeatableMetaChar( +-- * Constants + results, +-- * Types +-- ** Data-types +-- RepeatableMetaChar, +-- ** Type-synonyms +-- Testable, +-- * Functions +-- deconstruct +) where + +import qualified Data.Maybe +import Grecce.Test.QC.MetaChar() +import qualified RegExChar.MetaChar as MetaChar +import qualified RegExDot.Consumer +import qualified RegExDot.ConsumptionBounds +import qualified RegExDot.ConsumptionProfile +import qualified RegExDot.Repeatable +import qualified Test.QuickCheck +import qualified ToolShed.SelfValidate +import qualified ToolShed.Test.ReversibleIO + +-- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. +newtype RepeatableMetaChar = MkRepeatableMetaChar (RegExDot.Repeatable.Repeatable MetaChar.MetaChar) deriving (Eq, Read, Show) + +-- | Accessor. +deconstruct :: RepeatableMetaChar -> RegExDot.Repeatable.Repeatable MetaChar.MetaChar +deconstruct (MkRepeatableMetaChar repeatableMetaChar) = repeatableMetaChar + +instance ToolShed.SelfValidate.SelfValidator RepeatableMetaChar where + getErrors = ToolShed.SelfValidate.getErrors . deconstruct + +instance RegExDot.Consumer.Consumer RepeatableMetaChar where + consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstruct + starHeight = RegExDot.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 `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] + isGreedy <- Test.QuickCheck.arbitrary + + let + repetitionBounds :: RegExDot.Repeatable.RepetitionBounds + repetitionBounds = (fewest, most) + + 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. + } + +type Testable = RepeatableMetaChar -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [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" $ Data.Maybe.maybe True (>= minData) maybeMaxData && b == RegExDot.Consumer.getHasSpecificRequirement (RegExDot.Repeatable.base $ deconstruct r) where + RegExDot.ConsumptionProfile.MkConsumptionProfile { + RegExDot.ConsumptionProfile.consumptionBounds = (minData, maybeMaxData), + RegExDot.ConsumptionProfile.hasSpecificRequirement = b + } = RegExDot.Consumer.consumptionProfile r + + prop_io (MkRepeatableMetaChar r) = Test.QuickCheck.label "prop_io" $ ToolShed.Test.ReversibleIO.isReversible r + prop_isValid r = Test.QuickCheck.label "prop_isValid" $ ToolShed.SelfValidate.isValid r + prop_starHeight (MkRepeatableMetaChar r) = Test.QuickCheck.label "prop_starHeight" $ RegExDot.Consumer.starHeight r == if RegExDot.ConsumptionBounds.isPrecise (RegExDot.Consumer.getConsumptionBounds r) then 0 else 1 + diff --git a/src-test/Main.hs b/src-test/Main.hs new file mode 100644 --- /dev/null +++ b/src-test/Main.hs @@ -0,0 +1,46 @@ +{- + Copyright (C) 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 + 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 . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Calls the /quickChecks/-functions for modules supporting this feature. +-} + +module Main(main) where + +import Control.Arrow((***)) +import qualified Control.Monad +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 +import qualified System.Exit +import qualified ToolShed.Test.QuickCheck.Result + +-- | Entry-point. +main :: IO () +main = mapM_ ( + snd {-exit-status-} . ( + putStrLn . (++ ":") *** ( + >>= (`Control.Monad.unless` System.Exit.exitFailure) . all ToolShed.Test.QuickCheck.Result.isSuccessful + ) + ) + ) [ + ("MetaChar", Test.QC.MetaChar.results), + ("RepeatableMetaChar", Test.QC.RepeatableMetaChar.results), + ("ExtendedRegExChar", Test.QC.ExtendedRegExChar.results) + ] + diff --git a/src/Grecce/CommandOptions.hs b/src/Grecce/CommandOptions.hs deleted file mode 100644 --- a/src/Grecce/CommandOptions.hs +++ /dev/null @@ -1,172 +0,0 @@ -{- - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Defines the options, read from the command-line, - & as such assumes that the type-parameter of the underlying polymorphic /regex/-engine is 'Char'. - - * Supplies mutators, which ensure the consistency of the chosen set. --} - -module Grecce.CommandOptions( --- * Types --- ** Type-synonyms - CompilationOptionsMutator, - ExecutionOptionsMutator, --- Transformer, --- ** Data-types - CommandOptions(..), --- * Functions --- ** Mutators - setCompilationOption, - setCountMatches, - setExecutionOption, - setInvertMatch, - setPrependLineNumbers, - setListFilesWithMatches, - setListFilesWithoutMatch, - setVerbose -) where - -import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -import qualified RegExDot.CompilationOptions -import qualified RegExDot.ExecutionOptions -import qualified ToolShed.Defaultable -import qualified ToolShed.Options - --- | The set of command-line options; based on those provided by /egrep/. -data CommandOptions = MkCommandOptions { - countMatches :: Bool, -- ^ Print only a count of matching lines per file. - extendedRegExChar :: Maybe ExtendedRegExChar.ExtendedRegExChar, -- ^ The /regex/. - invertMatch :: Bool, -- ^ Select non-matching lines. - prependLineNumbers :: Bool, -- ^ Prepend the line-number of the matched input-data, to the output. - listFilesWithMatches :: Bool, -- ^ List the names of any files containing at least one match. - listFilesWithoutMatch :: Bool, -- ^ List the names of any files containing zero matches. - verbose :: Bool, -- ^ Show the captured data. - compilationOptions :: RegExDot.CompilationOptions.CompilationOptions, -- ^ Used to define the regex-request. - executionOptions :: RegExDot.ExecutionOptions.ExecutionOptions -- ^ Used to control the regex-runtime. -} deriving Show - --- | An arbitrary function which transforms the supplied 'RegExDot.ExecutionOptions.ExecutionOptions'. -type Transformer = CommandOptions -> CommandOptions - -instance ToolShed.Defaultable.Defaultable CommandOptions where - defaultValue = ToolShed.Options.blankValue { - countMatches = False, - extendedRegExChar = Nothing, - invertMatch = False, - prependLineNumbers = False, - listFilesWithMatches = False, - listFilesWithoutMatch = False, - verbose = False, - compilationOptions = ToolShed.Defaultable.defaultValue, - executionOptions = ToolShed.Defaultable.defaultValue - } - -instance ToolShed.Options.Options CommandOptions where - blankValue = MkCommandOptions { - countMatches = undefined, - extendedRegExChar = undefined, - invertMatch = undefined, - prependLineNumbers = undefined, - listFilesWithMatches = undefined, - listFilesWithoutMatch = undefined, - verbose = undefined, - compilationOptions = undefined, - executionOptions = undefined - } - --- | Mutator. -setCountMatches :: Transformer -setCountMatches commandOptions - | ($ commandOptions) `any` [ - prependLineNumbers, - listFilesWithoutMatch, - listFilesWithMatches, - verbose - ] = error "Grecce.CommandOptions.setCountMatches:\t'countMatches' is incompatible with; 'prependLineNumbers', 'listFilesWithoutMatch', 'listFilesWithMatches' & 'verbose'." - | otherwise = commandOptions { countMatches = True } - --- | Mutator. -setInvertMatch :: Transformer -setInvertMatch commandOptions - | verbose commandOptions = error "Grecce.CommandOptions.setInvertMatch:\t'invertMatch' is incompatible with 'verbose'." - | otherwise = commandOptions { invertMatch = True } - --- | Mutator. -setPrependLineNumbers :: Transformer -setPrependLineNumbers commandOptions - | ($ commandOptions) `any` [ - countMatches, - listFilesWithoutMatch, - listFilesWithMatches - ] = error "Grecce.CommandOptions.setPrependLineNumbers:\t'prependLineNumbers' is incompatible with 'countMatches', 'listFilesWithoutMatch' & 'listFilesWithMatches'." - | otherwise = commandOptions { prependLineNumbers = True } - --- | Mutator. -setListFilesWithMatches :: Transformer -setListFilesWithMatches commandOptions - | ($ commandOptions) `any` [ - countMatches, - prependLineNumbers, - listFilesWithoutMatch, - verbose - ] = error "Grecce.CommandOptions.setListFilesWithMatches:\t'listFilesWithMatches' is incompatible with; 'countMatches', 'prependLineNumbers', 'listFilesWithoutMatch' & 'verbose'." - | otherwise = commandOptions { listFilesWithMatches = True } - --- | Mutator. -setListFilesWithoutMatch :: Transformer -setListFilesWithoutMatch commandOptions - | ($ commandOptions) `any` [ - countMatches, - prependLineNumbers, - listFilesWithMatches, - verbose - ] = error "Grecce.CommandOptions.setListFilesWithoutMatch:\t'listFilesWithoutMatch' is incompatible with; 'countMatches', 'prependLineNumbers', 'listFilesWithMatches' & 'verbose'." - | otherwise = commandOptions { listFilesWithoutMatch = True } - --- | Mutator, which additionally sets the corresponding 'RegExDot.ExecutionOptions.ExecutionOptions'. -setVerbose :: Transformer -setVerbose commandOptions - | ($ commandOptions) `any` [ - countMatches, - invertMatch, - listFilesWithoutMatch, - listFilesWithMatches - ] = error "Grecce.CommandOptions.setVerbose:\t'verbose' is incompatible with; 'countMatches', 'invertMatch', 'listFilesWithoutMatch' & 'listFilesWithMatches'." - | otherwise = commandOptions { - verbose = True, - executionOptions = RegExDot.ExecutionOptions.setVerbose True $ executionOptions commandOptions - } - --- | A function which accepts a 'String' & the 'RegExDot.CompilationOptions.CompilationOptions' to transform, using its value. -type CompilationOptionsMutator = String -> RegExDot.CompilationOptions.CompilationOptions -> RegExDot.CompilationOptions.CompilationOptions - --- | Generic mutator, which accepts a function & the parameter-string it requires, to amend an unspecified field of 'RegExDot.CompilationOptions.CompilationOptions'. -setCompilationOption :: CompilationOptionsMutator -> String -> Transformer -setCompilationOption compilationOptionsMutator s commandOptions = commandOptions { compilationOptions = compilationOptionsMutator s $ compilationOptions commandOptions } - --- | A function which accepts a 'String' & the 'RegExDot.ExecutionOptions.ExecutionOptions' to transform, using its value. -type ExecutionOptionsMutator = String -> RegExDot.ExecutionOptions.ExecutionOptions -> RegExDot.ExecutionOptions.ExecutionOptions - --- | Generic mutator, which accepts a function & the parameter-string it requires, to amend an unspecified field of 'RegExDot.ExecutionOptions.ExecutionOptions'. -setExecutionOption :: ExecutionOptionsMutator -> String -> Transformer -setExecutionOption executionOptionsMutator s commandOptions = commandOptions { executionOptions = executionOptionsMutator s $ executionOptions commandOptions } - diff --git a/src/Grecce/Grep.hs b/src/Grecce/Grep.hs deleted file mode 100644 --- a/src/Grecce/Grep.hs +++ /dev/null @@ -1,206 +0,0 @@ -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Performs the match-operation on the specified file-list, using the user's command-line options. --} - -module Grecce.Grep( --- * Types --- LineNumber, --- Matches, --- ** Type-synonyms --- * Functions - grep -) where - -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 -import RegExChar.ExtendedRegExChar((+~), (=~)) -import qualified RegExDot.RegEx -import qualified RegExDot.RegExOpts -import qualified RegExDot.Result -import qualified System.Exit -import qualified System.IO - -type LineNumber = Int -type Matches = Int - --- | Creates a 'RegExDot.RegExOpts.RegExOpts' record from 'CommandOptions.CommandOptions', and uses it to filter the lines read from the list of input-data files, the result of which is then printed. -grep - :: CommandOptions.CommandOptions -- ^ The match-criteria, which may include the name of the file on which to operate. - -> [String] -- ^ A supplementary list of files on which to operate - -> IO () -- ^ Nothing is returned, since the result is printed. -grep commandOptions nonOptions -{- - The algorithm depends fundamentally on whether the data comes from 'stdin' or from file. - This is because of the requirement, in the former case, to deliver instantaneous feedback. - This forces us to print matches as they're found, rather than batching them for return to the caller to print. - If we COULD return 'IO [String]', then 'matchFilterStdIn' could be called instead of 'grep' when (fileName == "-"); annoyingly, it just doesn't work. --} - | any ($ fileNames) [null, all (== "-")] = let - matchFilterStdIn :: LineNumber -> Matches -> IO System.Exit.ExitCode - matchFilterStdIn lineNumber matches = {-#SCC "matchFilterStdIn" #-} do - isEOF <- System.IO.isEOF - - 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. - else if listFilesWithoutMatch - then putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess - else do - Control.Monad.when countMatches $ print matches - - return {-to IO-monad-} $ if matches == 0 - then System.Exit.ExitFailure 1 - else System.Exit.ExitSuccess - else {-not EOF-} do - line <- getLine -- Process line-at-a-time, to provide instant feedback. - - let - lineNumber' :: LineNumber - lineNumber' = succ lineNumber - - onSuccess :: String -> IO System.Exit.ExitCode - onSuccess line' - | listFilesWithMatches = putStrLn dummyFileName >> return {-to IO-monad-} System.Exit.ExitSuccess - | listFilesWithoutMatch = return {-to IO-monad-} $ System.Exit.ExitFailure 1 - | otherwise = do - Control.Monad.unless countMatches . putStrLn $ ( - if prependLineNumbers - then showLineNumber lineNumber' - else id - ) line' - - matchFilterStdIn lineNumber' $ succ matches -- Recurse. - - onFailure, onMismatch :: IO System.Exit.ExitCode - onFailure = matchFilterStdIn lineNumber' matches -- Recurse - onMismatch - | invertMatch = onSuccess line - | otherwise = onFailure - - if verbose - then let - result :: RegExDot.RegEx.Result Char - result = line +~ regExOpts - in if RegExDot.Result.isMatch result - then if invertMatch - then onFailure - else onSuccess $ show result - else onMismatch - else {-terse-} if line =~ regExOpts - then if invertMatch - then onFailure - else onSuccess line - else onMismatch - where - dummyFileName :: String - dummyFileName = "" - in matchFilterStdIn 0 0 >>= System.Exit.exitWith - | otherwise {-file-names provided-} = let - findMatch :: String -> RegExDot.RegEx.Result Char - findMatch = (+~ regExOpts) - - matchFilter :: [String] -> [String] - matchFilter = {-#SCC "matchFilter" #-} ( - if countMatches - then return {-to List-monad-} . show . length -- Substitute the list of matches, with its length. - else id - ) . ( - let - isMatch :: String -> Bool - isMatch = {-#SCC "isMatch" #-} (if invertMatch then not else id) . (=~ regExOpts) - in if prependLineNumbers - then map (uncurry showLineNumber) . ( - if verbose - then map ( - Control.Arrow.second show - ) . filter ( - RegExDot.Result.isMatch . snd - ) . map ( - Control.Arrow.second findMatch - ) - else {-terse-} filter (isMatch . snd) - ) . zip [1 :: LineNumber ..] - else {-unnumbered-} if verbose - then map show . filter RegExDot.Result.isMatch . map findMatch - else {-terse-} filter isMatch - ) - - identifySource :: String -> [String] -> [String] - identifySource fileName results - | listFilesWithMatches = [fileName | not isEmpty] {-list-comprehension-} - | listFilesWithoutMatch = [fileName | isEmpty] {-list-comprehension-} - | length (Data.List.nub fileNames) > 1 = (showString fileName . separate) `map` results - | otherwise = results - where - isEmpty :: Bool - isEmpty = null results - in do - results <- ( - concat . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq ( - uncurry identifySource . Control.Arrow.second (matchFilter . {-#SCC "lines" #-} lines {-chops '\n'-}) - ) . zip fileNames - ) `fmap` mapM readFile fileNames - - mapM_ putStrLn results - - System.Exit.exitWith $ if null results - then System.Exit.ExitFailure 1 - else System.Exit.ExitSuccess - where - countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose :: Bool - [countMatches, invertMatch, prependLineNumbers, listFilesWithMatches, listFilesWithoutMatch, verbose] = ($ commandOptions) `map` [ - CommandOptions.countMatches, - CommandOptions.invertMatch, - CommandOptions.prependLineNumbers, - CommandOptions.listFilesWithMatches, - CommandOptions.listFilesWithoutMatch, - CommandOptions.verbose - ] -- Divvy-up. - --- 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 - Just c -> (c, nonOptions) - _ - | null nonOptions -> error "Undefined regex." - | otherwise -> read . head &&& tail $ nonOptions - --- 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, - RegExDot.RegExOpts.executionOptions = CommandOptions.executionOptions commandOptions, - RegExDot.RegExOpts.regEx = extendedRegExChar - } - --- Define functions used to format the output. - separate :: ShowS - separate = showChar ':' - - showLineNumber :: LineNumber -> ShowS - showLineNumber n = shows n . separate - diff --git a/src/Grecce/Test/Assert/RegExOptsChar.hs b/src/Grecce/Test/Assert/RegExOptsChar.hs deleted file mode 100644 --- a/src/Grecce/Test/Assert/RegExOptsChar.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Reads lines from the specified file. - - * Each line describes a 'Test'. - - * Each input-data string should match the /regex/ in the specified way. - - * Permits comparison with "Text.Regex.Posix.String". --} - -module Grecce.Test.Assert.RegExOptsChar( --- * Types --- ** Type-synonyms --- Test, --- TestDataAndResult, --- TestFilter, --- * Functions - findFailures, - findFailuresPosix, - readTests --- ** Predicates --- isMatch -) where - -import qualified Control.Arrow -import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -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 -import qualified Text.Regex.Posix.Wrap -import Text.Regex.Posix() - --- | Composed input data & list of captured 'RegExOptsChar.MatchSpan'. -type TestDataAndResult = (ExtendedRegExChar.InputData, [RegExOptsChar.MatchSpan]) - --- | Composed of the 'String' from which an unspecified type of regex is read, & a list of input data & results, to which it should respectively be applied & compared. -type Test = (String {-regex-source-}, [TestDataAndResult]) - --- | Filters a list of 'Test's, & returns a sub-set. -type TestFilter = [Test] -> [Test] - --- | True if the specified 'ExtendedRegExChar.InputData', is a member of the set defined by the polymorphic 'Text.Regex.Base.RegexLike.RegexLike' parameter. -isMatch :: RegexLike.RegexLike r ExtendedRegExChar.InputData => r -> TestDataAndResult -> Bool -isMatch regex (inputData, matchSpanList) = RegexLike.matchOnce regex inputData == Just (RegExOptsChar.toZeroIndexedArray matchSpanList) - --- | Returns those 'Test's, which 'RegExOptsChar.RegExOptsChar' fails. -findFailures :: RegExDot.CompilationOptions.CompilationOptions -> RegExDot.ExecutionOptions.ExecutionOptions -> TestFilter -findFailures compilationOptions executionOptions = filter (not . uncurry all . Control.Arrow.first (isMatch . RegexLike.makeRegexOpts compilationOptions executionOptions)) - --- | Returns those 'Test's, which 'Text.Regex.Posix.Wrap.Regex' fails. -findFailuresPosix :: TestFilter -findFailuresPosix = filter (not . uncurry all . Control.Arrow.first ((isMatch :: Text.Regex.Posix.Wrap.Regex -> TestDataAndResult -> Bool) . RegexLike.makeRegex)) - -{- | - * Read 'Test's from file, ignoring blank lines & comments. - - * 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 - ) `fmap` readFile fileName - diff --git a/src/Grecce/Test/Performance/ExtendedRegEx.hs b/src/Grecce/Test/Performance/ExtendedRegEx.hs deleted file mode 100644 --- a/src/Grecce/Test/Performance/ExtendedRegEx.hs +++ /dev/null @@ -1,145 +0,0 @@ -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * CPU-times the specified stress-test(s), over a hard-coded list of /regex/-engines, - providing each combination with a varied list of 'Performance.ExtendedRegExTest.TestGenerator's, - & a level of 'Performance.ExtendedRegExTest.TestComplexity' which increases linearly to the specified cap. - - * Either a simple 'Bool' result, or the full data-capture, can be requested. - - [@CAVEATS@] - - * For compatibility with the other regex-engines, uses the specialised instance 'ExtendedRegExChar.ExtendedRegExChar', - rather than the underlying polymorphic 'RegExDot.RegEx.ExtendedRegEx'. - - * "Text.Regex.Posix" stalls forever on 'Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES', - with 'Performance.ExtendedRegExTest.TestComplexity'=3 & data-capture requested. - - [@TODO@] - - * Utilise the standard interface in "RegExOptsChar", to permit identical treatment of different regex-engines. --} - -module Grecce.Test.Performance.ExtendedRegEx( --- * Types --- ** Type-synonyms --- GenerateAndRunTest, --- GetAndRunTestRange, --- * Constants --- solitary, --- * Functions - run --- tailorTest -) where - -import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. -import Control.Applicative((<$>), (<*>)) -import qualified Control.Arrow -import Control.Arrow((&&&)) -import qualified Data.Maybe -import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest -import qualified Grecce.Test.Performance.ExtendedRegExTestsNegative as Test.Performance.ExtendedRegExTestsNegative -import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive -import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -import qualified RegExDot.ExecutionOptions -import qualified RegExDot.RegEx -import qualified RegExDot.RegExOpts -import qualified Text.Regex.Posix -import qualified ToolShed.Defaultable -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'. - -type GetAndRunTestRange a = [a] -> IO () -type GenerateAndRunTest = Test.Performance.ExtendedRegExTest.TestGenerator Char -> Test.Performance.ExtendedRegExTest.TestComplexity -> IO (ExtendedRegExChar.InputData, [(Double, String)]) - -{- | - * Print the CPU-seconds, required to run the range of 'Test.Performance.ExtendedRegExTest.TestGenerator's corresponding to the specified test-names & a linearly increasing 'Test.Performance.ExtendedRegExTest.TestComplexity'. - - * 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 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 testRange = sequence_ $ ( - \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print - ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where - cpuSecondsFor :: GenerateAndRunTest - cpuSecondsFor testGenerator = ( - \(inputData, (isMismatch, extendedRegExCharString)) -> (,) extendedRegExCharString <$> mapM ( - ToolShed.System.TimePure.getCPUSeconds . ($ inputData) . (show .) - ) [ - isMismatch, - if solitary - 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.RegExOpts.compilationOptions = ToolShed.Defaultable.defaultValue, - RegExDot.RegExOpts.executionOptions = executionOptions, - RegExDot.RegExOpts.regEx = extendedRegEx - } - ) - ) &&& show . ExtendedRegExChar.MkExtendedRegExChar False {-hasNonCapturingTopLevelAlternatives-} - ) . testGenerator - -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 testRange = sequence_ $ ( - \complexity testGenerator -> cpuSecondsFor testGenerator complexity >>= print - ) <$> [1 .. maxTestComplexity] <*> Data.Maybe.mapMaybe Test.Performance.ExtendedRegExTest.query testRange where - cpuSecondsFor :: GenerateAndRunTest - cpuSecondsFor testGenerator = ( - \(inputData, (showMatch, extendedRegExCharString)) -> (,) extendedRegExCharString <$> ( - (ToolShed.System.TimePure.getCPUSeconds . ($ inputData)) `mapM` [ - showMatch, - 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 show . if solitary - then const True -- CAVEAT: should be 'undefined'. - else (Text.Regex.Posix.=~ extendedRegExCharString) :: String -> Bool -- CAVEAT: . - ] - ) - ) . Control.Arrow.second ( - ( - \extendedRegEx -> let - regExOpts :: RegExDot.RegExOpts.RegExOpts (RegExDot.RegEx.ExtendedRegEx Char) - regExOpts = RegExDot.RegExOpts.MkRegExOpts { - 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. - in if RegExDot.ExecutionOptions.requireMatchList executionOptions - 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 deleted file mode 100644 --- a/src/Grecce/Test/Performance/ExtendedRegExTest.hs +++ /dev/null @@ -1,51 +0,0 @@ -{- - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Defines the types used for performance-testing. - - * Defines an interface to permit queries on repositories of 'TestGenerator's. --} - -module Grecce.Test.Performance.ExtendedRegExTest( --- * Type-classes - TestGeneratorRepository(..), --- * Types --- ** Type-synonyms - TestComplexity, - Test, - TestGenerator -) where - -import qualified RegExDot.RegEx - --- | Used to specify the level of complexity of /regex/ to generate. -type TestComplexity = Int - --- | A pair defining the data & the /regex/ to which it should be fed. -type Test a = (RegExDot.RegEx.InputData a, RegExDot.RegEx.ExtendedRegEx a) - --- | The type of a function, which accepts a 'TestComplexity', & returns a 'Test'. -type TestGenerator a = TestComplexity -> Test a - --- | 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. - diff --git a/src/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs b/src/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs deleted file mode 100644 --- a/src/Grecce/Test/Performance/ExtendedRegExTestsNegative.hs +++ /dev/null @@ -1,85 +0,0 @@ -{- - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Defines 'Performance.ExtendedRegExTest.TestGenerator's, for 'Performance.ExtendedRegExTest.Test's, which should fail. - - * Implements 'Performance.ExtendedRegExTest.TestGeneratorRepository'. --} - -module Grecce.Test.Performance.ExtendedRegExTestsNegative( --- * Types --- ** Data-types - TestName -) where - -import qualified Control.Arrow -import qualified Data.Maybe -import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest -import qualified Grecce.Test.Performance.ExtendedRegExTestsPositive as Test.Performance.ExtendedRegExTestsPositive - --- | Defines an enumeration of keys, by which to reference 'Test.Performance.ExtendedRegExTest.TestGenerator's. -data TestName = - INTERLEAVED_GREEDY_STAR_VS_MANDATORY - | LINEAR_FRACTAL_NONGREEDY_STAR - | OVERLAPPING_ALTERNATIVES - deriving ( - Bounded, - Enum, - Eq, - Read, - Show - ) - -instance Test.Performance.ExtendedRegExTest.TestGeneratorRepository TestName where - query = ( - `lookup` [ -{- - Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.INTERLEAVED_GREEDY_STAR_VS_MANDATORY', but with twice the input data following by a mismatch. - Performance: vastly better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkExistenceOfInelasticTail'. --} - ( - INTERLEAVED_GREEDY_STAR_VS_MANDATORY, - Control.Arrow.first ((++ "!") . concat . replicate 2) . Data.Maybe.fromJust ( - Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.INTERLEAVED_GREEDY_STAR_VS_MANDATORY - ) - ), -{- - Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.LINEAR_FRACTAL_NONGREEDY_STAR', but with mismatching input data, which causes the time-complexity explodes to O(n!). - Performance: vastly better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkForUnconsumableData'. --} - ( - LINEAR_FRACTAL_NONGREEDY_STAR, - Control.Arrow.first (++ "!") . Data.Maybe.fromJust ( - Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.LINEAR_FRACTAL_NONGREEDY_STAR - ) - ), -{- - Explanation: based on 'Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES', but with mismatching input data. - Performance: marginally better performance than "Text.Regex.Posix", benefiting from 'ExecutionOptions.checkForUnconsumableData' & 'ExecutionOptions.permitReorderingOfAlternatives'. --} - ( - OVERLAPPING_ALTERNATIVES, - Control.Arrow.first (++ "!") . Data.Maybe.fromJust ( - Test.Performance.ExtendedRegExTest.query Test.Performance.ExtendedRegExTestsPositive.OVERLAPPING_ALTERNATIVES - ) - ) - ] - ) diff --git a/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs b/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs deleted file mode 100644 --- a/src/Grecce/Test/Performance/ExtendedRegExTestsPositive.hs +++ /dev/null @@ -1,329 +0,0 @@ -{- - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Defines 'Performance.ExtendedRegExTest.TestGenerator's, for 'Performance.ExtendedRegExTest.Test's, which should pass. - - * Implements 'Performance.ExtendedRegExTest.TestGeneratorRepository'. --} - -module Grecce.Test.Performance.ExtendedRegExTestsPositive( --- * Types --- ** Data-types - TestName(..) --- * Functions --- triangularSeries -) where - -import Control.Arrow((&&&)) -import qualified Data.Char -import qualified Grecce.Test.Performance.ExtendedRegExTest as Test.Performance.ExtendedRegExTest -import qualified RegExDot.Anchor -import qualified RegExDot.BracketExpressionMember -import RegExDot.DSL((-:), (?:), (*:), (<~>)) -import qualified RegExDot.Meta -import qualified RegExDot.RegEx -import RegExDot.RegEx((.*), (.*?)) -import qualified RegExDot.Repeatable -import RegExDot.Repeatable((^#->#), (^#->), (^#)) - --- | Defines an enumeration of keys, by which to reference 'Test.Performance.ExtendedRegExTest.TestGenerator's. -data TestName = - BIPOLAR_GREEDY_OPTIONAL_VS_MANDATORY - | INTERLEAVED_GREEDY_STAR_VS_MANDATORY - | TRIANGULAR_CONSUMPTION - | BINARY_TREE - | REPEATABLE_ALTERNATIVES - | REPEATED_ALTERNATIVES - | LINEAR_FRACTAL_RANGES - | LINEAR_FRACTAL_NONGREEDY_STAR - | BINARY_TREE_FRACTAL - | FUTILE_REPEATABLE_ALTERNATIVES - | OVERLAPPING_ALTERNATIVES - | UNBRIDLED_GREED - | MULTIPLE_CHOICE - deriving ( - Bounded, - Enum, - Eq, - Read, - Show - ) - -instance Test.Performance.ExtendedRegExTest.TestGeneratorRepository TestName where - query = ( - `lookup` [ -{- - "^(?){}(){}$". - Explanation: each of the optional meta-data in the first half of the expression can capture data, but in doing so starves a mandatory meta-datum in the second half of the expression, - presenting the opportunity for O(2^n) time-complexity backtracking. - Performance: vastly better Boolean-result performance than "Text.Regex.Posix". Looks like O(n^2) time-complexity. --} - ( - BIPOLAR_GREEDY_OPTIONAL_VS_MANDATORY, - (`replicate` testChar) &&& let - exactly :: Test.Performance.ExtendedRegExTest.TestComplexity -> (RegExDot.RegEx.Pattern Char -> RegExDot.RegEx.RepeatablePattern Char) -> RegExDot.RegEx.RepeatablePattern Char - exactly n f = (RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . return {-to List-monad-} $ f testRequirement) ^# n - in ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (`map` [RegExDot.Repeatable.zeroOrOne, RegExDot.Repeatable.one]) . exactly - ), -{- - "^(.*z){}$". - Explanation: each '.*' can consume all the remaining data, starving the interspersed mandatory meta data, presenting the opportunity for O(2^n) time-complexity backtracking. - Performance: marginally better Boolean-result & data-capture performance than "Text.Regex.Posix" with 'ExecutionOptions.moderateGreed'. Empirically O(n^3) time-complexity. --} - ( - INTERLEAVED_GREEDY_STAR_VS_MANDATORY, - concat . (`replicate` (testChar : "z")) &&& RegExDot.RegEx.dock . ( - `mkExtendedRegExFromRepeatableSingletonAlternative` (RegExDot.Anchor.unanchored <~>) [ - (.*), - RegExDot.RegEx.simply $ RegExDot.Meta.Literal 'z' - ] - ) . flip (^#) - ), -{- - "^*+{2,}{3,} ... a{,}$". - Explanation: each term greedily consumes all the data, starving all the remaining terms, until after much back-tracking, it consumes the just the minimum permissible. - The correct consumption-pattern is triangular, starting at the apex & spreading into a delta. - Performance: vastly better Boolean-result & data-capture performance than "Text.Regex.Posix". --} - - ( - TRIANGULAR_CONSUMPTION, - (`replicate` testChar) . triangularSeries &&& ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (`take` map (testRequirement ^#->) [0 ..]) . succ - ), -{- - "(|{2})*c". - Explanation: from - Performance: disastrous performance. --} - ( - BINARY_TREE, - (++ "bc") . (`replicate` testChar) . (2 ^) &&& const ( - RegExDot.Anchor.unanchored <~> RegExDot.RegEx.captureGroup ( - map ( - (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . (testRequirement ^#) . (2 ^) - ) [0 :: Int .. 1] - ) *: RegExDot.RegEx.Require (RegExDot.Meta.Literal 'c') -: [] - ) - ), -{- - "^(?|{2}|{4}|{8}| ... |{2^})*$". - Explanation: all but one of the 'Alternatives' must be used, one on each successive repetition, in order to consume all the 'InputData'. - A correct implementation will match against the longest possible Alternative on each successive repetition, just as if the repetition were unrolled; see 'REPEATED_ALTERNATIVES'. - Performance: vastly worse Boolean-result performance (even with 'ExecutionOptions.permitReorderingOfAlternatives'), - & worse data-capture performance (even with 'ExecutionOptions.useFirstMatchAmongAlternatives'), than "Text.Regex.Posix". --} - ( - REPEATABLE_ALTERNATIVES, - (`replicate` testChar) . pred {-requires several different Alternatives-} . (2 ^) &&& ( - \i -> ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ [RegExDot.Repeatable.zeroOrOne testRequirement] : map ( - return {-to List-monad-} . (testRequirement ^#) . (2 ^) - ) [1 .. i] - ) - ), -{- - "^(?|{2}|{4}| ... |{2^})(?|{2}|{4}| ... |{2^})(?|{2}|{4}| ... |{2^})$". - Explanation: 'REPEATABLE_ALTERNATIVES' with the repetition unrolled, to permit inspection of individual capture-groups, - revealing the use by "Text.Regex.Posix", of Perl-style "1st-past-the-post" selection between Alternatives. - Performance: much faster than 'REPEATABLE_ALTERNATIVES'. Vastly better Boolean-result & data-capture performance than both 'REPEATABLE_ALTERNATIVES' & "Text.Regex.Posix". --} - ( - REPEATED_ALTERNATIVES, - (`replicate` testChar) . pred {-requires several different Alternatives-} . (2 ^) &&& ( - \i -> ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . replicate i . RegExDot.Repeatable.one . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ [RegExDot.Repeatable.zeroOrOne testRequirement] : map ( - return {-to List-monad-} . (testRequirement ^#) . (2 ^) - ) [1 .. i] - ) - ), -{- - "^(((({0,2}){0,2}){0,2}){0,2}){0,2} ... $". - Explanation: - Performance: vastly better Boolean-result performance than "Text.Regex.Posix", which exhausts memory at n==10. Better data-capture performance too. - Stack-overflow at 'Test.Performance.ExtendedRegExTest.TestComplexity'=14. --} - ( - LINEAR_FRACTAL_RANGES, - let - base :: RegExDot.Repeatable.Repetitions - base = 2 -- Arbitrarily. - - bounds :: RegExDot.Repeatable.RepetitionBounds - bounds = (0, Just base) - in (`replicate` testChar) . (base ^) &&& RegExDot.RegEx.dock . ( - ( - mkExtendedRegExFromRepeatableSingletonAlternative (^#-># bounds) `iterate` (RegExDot.Anchor.unanchored <~>) [testRequirement ^#-># bounds] {-initial value-} - ) !! - ) . pred - ), -{- - "^((((((((((((((*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*?)*? ... $". - Explanation: interesting because all 'RegExDot.RegEx.Alternatives' are expanded before the first comparison against input data, & the number possible repetitions of each expansion is very vague. - Performance: vastly better Boolean-result performance than "Text.Regex.Posix", but inferior data-capture performance. --} - ( - LINEAR_FRACTAL_NONGREEDY_STAR, - const (replicate 8 {-arbitrary-} testChar) &&& RegExDot.RegEx.dock . ( - ( - mkExtendedRegExFromRepeatableSingletonAlternative RegExDot.Repeatable.zeroOrMore' `iterate` (RegExDot.Anchor.unanchored <~>) [RegExDot.Repeatable.zeroOrMore' testRequirement] {-initial value-} - ) !! - ) - ), -{- - "^((([^]|)|(|[^]))|((|[^])|([^]|)))$". - Explanation: exhibits symmetry in the left & right branches of the binary tree of RegExDot.RegEx.Alternatives, & so the exponentially expanding set of leaves are equivalent & all match the data. - Performance: vastly better Boolean-result & comparable data.capture performance to "Text.Regex.Posix", which exhausts memory at complexity 5 to 6, & to egrep which lasts until complexity==6. --} - ( - BINARY_TREE_FRACTAL, - let - base :: RegExDot.Repeatable.Repetitions - base = 2 -- Arbitrarily. - in (`replicate` testChar) . (base ^) &&& RegExDot.RegEx.dock . head . ( - ( - iterate ( - \extendedRegExList -> ( - (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . (^# base) . RegExDot.RegEx.captureGroup - ) `map` [extendedRegExList, reverse extendedRegExList] - ) $ map ( - (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . ($ RegExDot.RegEx.Require $ RegExDot.Meta.Literal testChar) - ) [RegExDot.Repeatable.one, RegExDot.Repeatable.zeroOrOne] - ) !! - ) - ), -{- - "^(1|{2}2|{3}3| ... |{})**$". - Explanation: none of the Alternatives can match, & consequently the group must match zero times, presenting the opportunity for many wasted trial repetitions. - Performance: comparable Boolean-result performance to "Text.Regex.Posix", & marginally superior data-capture performance. --} - ( - FUTILE_REPEATABLE_ALTERNATIVES, - \alternatives -> ( - replicate 1024 {-arbitrarily-} testChar, - ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) $ map RegExDot.Repeatable.zeroOrMore [ - RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ ( - \i -> ($ i) `map` [ - (testRequirement ^#), - RegExDot.RegEx.simply . RegExDot.Meta.Literal . Data.Char.chr . (Data.Char.ord '0' +) . (`mod` 10) - ] - ) `map` [1 .. alternatives], - testRequirement - ] - ) - ), -{- - "^a?((ab?)*|(bc?)*|(cd?)*| ...)*$". - Explanation: the zeroeth term matches greedily, consuming the datum mandated by the 1st Alternative, so the 2nd Alternative greedily consumes two data, including the datum mandated by the 3rd, ... - If there're an even number of Alternatives, then n/2 repetitions (one for each), will consume all the input data, but otherwise the final input datum isn't consumed. - The consumption back-tracks rapidly until the zeroeth term yields-up the initial datum, after which the odd Alternatives match consuming all the input data, in (n/2 + 1) repetitions. - This suggests a very tractable O(n) time-complexity, but Posix requires that we select the combination of Alternatives which consume most data, - & since there are two terms in the regex that can consume each input datum, it looks like there should be 2^n candidate solutions; in fact there's just one. - So, all O(Alternatives ^ repetitions) permutations may be searched in vain for a superior solution. - Performance: vastly worse Boolean-result performance than "Text.Regex.Posix", but the latter then stalls indefinitely (CPU-bound) at complexity=[13 (not verbose), 4 (verbose)]. --} - ( - OVERLAPPING_ALTERNATIVES, - let - bracket :: a -> [a] -> [a] - bracket terminal = (terminal :) . (++ [terminal]) - - zeroOrMoreAlternatives :: [RegExDot.RegEx.Concatenation Char] -> RegExDot.RegEx.Concatenation Char - zeroOrMoreAlternatives = return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) - in ( - id &&& ( - ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . (RegExDot.RegEx.Require (RegExDot.Meta.Literal testChar) ?:) . zeroOrMoreAlternatives . map ( - \(a, b) -> zeroOrMoreAlternatives $ return {-to List-monad-} [a, b] - ) . init . tail . uncurry zip . ( - map RegExDot.Repeatable.one . init &&& map RegExDot.Repeatable.zeroOrOne . tail - ) . bracket undefined . map ( - RegExDot.RegEx.Require . RegExDot.Meta.Literal - ) - ) - ) . (`take` (filter Data.Char.isAlphaNum $ filter Data.Char.isAscii [minBound .. maxBound])) . succ - ), -{- - "^(a|b|c)*(a.*?c){3}$". - Explanation: zero repetitions of the set of Alternatives on the LHS is the only solution, but because the greedy star, within which they're grouped, permits many more, - & because the RHS's requirement for all the input-data, isn't explicit, there's a temptation to over-consume. - Performance: empirically O(2^n) time-complexity, but linearised by 'ExecutionOptions.moderateGreed'. - Better Boolean-result & data-capture performance than "Text.Regex.Posix". --} - ( - UNBRIDLED_GREED, - \complexity -> let - complexity' :: Test.Performance.ExtendedRegExTest.TestComplexity - complexity' = succ complexity - - testSet :: String - testSet = take complexity' . filter Data.Char.isAlphaNum $ filter Data.Char.isAscii [minBound .. maxBound] - in ( - concat $ replicate complexity' testSet, - ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) $ ( - RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) $ map ( - return {-to List-monad-} . RegExDot.RegEx.simply . RegExDot.Meta.Literal - ) testSet - ) *: [ - ( - RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} $ RegExDot.RegEx.Require (RegExDot.Meta.Literal $ head testSet) -: (.*?) : RegExDot.RegEx.Require (RegExDot.Meta.Literal $ last testSet) -: [] - ) ^# complexity' - ] - ) - ), -{- - "^(a*[^a]|[^b]|[^c]| ... |[^z])*$" - Explanation: The first alternative greedily consumes all the input data until finding a mismatch on the last, whilst all the remaining alternatives successfully consume a single input datum. - The same occurs on each successive repetition of the alternatives, of which there are as many as input data, - leading to a lot of wasted time with O( ^ ) time-complexity. - Performance: poor Boolean-result & worse data-capture performance (benefiting from 'ExecutionOptions.useFirstMatchAmongAlternatives'), compared to "Text.Regex.Posix". --} - ( - MULTIPLE_CHOICE, - const (replicate 8 {-arbitrary-} testChar) &&& ( - ((Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~>) . return {-to List-monad-} . RegExDot.Repeatable.zeroOrMore . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . ( - [ - RegExDot.Repeatable.zeroOrMore testRequirement, - RegExDot.RegEx.simply . RegExDot.Meta.NoneOf $ map RegExDot.BracketExpressionMember.Literal [testChar] - ] : - ) . map ( - return {-to List-monad-} . RegExDot.RegEx.simply . RegExDot.Meta.NoneOf . return {-to List-monad-} . RegExDot.BracketExpressionMember.Literal - ) . ( - `take` tail [testChar ..] - ) - ) - ) - ] - ) where - testChar :: Char - testChar = 'a' - - testRequirement :: RegExDot.RegEx.Pattern Char - testRequirement = RegExDot.RegEx.Require $ RegExDot.Meta.Literal testChar - - mkExtendedRegExFromRepeatableSingletonAlternative :: (RegExDot.RegEx.Pattern Char -> RegExDot.RegEx.RepeatablePattern Char) -> RegExDot.RegEx.ExtendedRegEx Char -> RegExDot.RegEx.ExtendedRegEx Char - mkExtendedRegExFromRepeatableSingletonAlternative makeRepetitions = (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} . makeRepetitions . RegExDot.RegEx.captureGroup . return {-to List-monad-} - -{- | - * The sum of the sequence descending from the specified integer; @n + (n - 1) + (n - 2) + ... + 2 + 1 + 0@. - - * . - - * . --} -triangularSeries :: Integral i => i -> i -triangularSeries i = i * succ i `div` 2 diff --git a/src/Grecce/Test/QC/ExtendedRegExChar.hs b/src/Grecce/Test/QC/ExtendedRegExChar.hs deleted file mode 100644 --- a/src/Grecce/Test/QC/ExtendedRegExChar.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' & defines tests based on it. --} - -module Grecce.Test.QC.ExtendedRegExChar( --- * Types --- ** Data-types --- AlternativesChar(..), --- PatternChar(..), --- RepeatablePatternChar(..), --- ** Type-synonyms --- Testable, --- * Functions --- deconstructAlternativesChar, --- deconstructPatternChar, --- deconstructRepeatablePatternChar, - quickChecks -) where - -import qualified Data.Maybe -import Grecce.Test.QC.MetaChar() -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 -import qualified RegExDot.Consumer -import qualified RegExDot.ConsumptionBounds -import qualified RegExDot.ConsumptionProfile -import RegExDot.DSL((-:), (?:), (+:), (<~>)) -import qualified RegExDot.Meta -import qualified RegExDot.RegEx -import RegExDot.RegEx((+~)) -import qualified RegExDot.RegExOpts -import qualified RegExDot.Repeatable -import qualified RegExDot.Result -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) -import qualified ToolShed.SelfValidate -import qualified ToolShed.Test.ReversibleIO - --- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. -newtype AlternativesChar = MkAlternativesChar (RegExDot.RegEx.Alternatives Char) deriving (Eq, Read, Show) - --- | Accessor. -deconstructAlternativesChar :: AlternativesChar -> RegExDot.RegEx.Alternatives Char -deconstructAlternativesChar (MkAlternativesChar a) = a - -instance ToolShed.SelfValidate.SelfValidator AlternativesChar where - getErrors = ToolShed.SelfValidate.getErrors . deconstructAlternativesChar - -instance RegExDot.Consumer.Consumer AlternativesChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructAlternativesChar - starHeight = RegExDot.Consumer.starHeight . deconstructAlternativesChar - -instance Test.QuickCheck.Arbitrary AlternativesChar where - arbitrary = (MkAlternativesChar . RegExDot.RegEx.MkAlternatives . map ExtendedRegExChar.extendedRegEx) `fmap` ( - Test.QuickCheck.elements [1, 2] >>= Test.QuickCheck.vector {-[ExtendedRegExChar]-} - ) -- TODO: permit zero alternatives. - --- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. -newtype PatternChar = MkPatternChar (RegExDot.RegEx.Pattern Char) deriving (Eq, Read, Show) - --- | Accessor. -deconstructPatternChar :: PatternChar -> RegExDot.RegEx.Pattern Char -deconstructPatternChar (MkPatternChar pattern) = pattern - -instance ToolShed.SelfValidate.SelfValidator PatternChar where - getErrors = ToolShed.SelfValidate.getErrors . deconstructPatternChar - -instance RegExDot.Consumer.Consumer PatternChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructPatternChar - starHeight = RegExDot.Consumer.starHeight . deconstructPatternChar - -instance Test.QuickCheck.Arbitrary PatternChar where - 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) - --- | Accessor. -deconstructRepeatablePatternChar :: RepeatablePatternChar -> RegExDot.Repeatable.Repeatable PatternChar -deconstructRepeatablePatternChar (MkRepeatablePatternChar repeatable) = repeatable - -instance ToolShed.SelfValidate.SelfValidator RepeatablePatternChar where - getErrors = ToolShed.SelfValidate.getErrors . deconstructRepeatablePatternChar - -instance RegExDot.Consumer.Consumer RepeatablePatternChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstructRepeatablePatternChar - starHeight = RegExDot.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 `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] - isGreedy <- Test.QuickCheck.arbitrary {-Bool-} - - let - repetitionBounds :: RegExDot.Repeatable.RepetitionBounds - repetitionBounds = (fewest, most) - - 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. - } - -instance Test.QuickCheck.Arbitrary ExtendedRegExChar.ExtendedRegExChar where - arbitrary = do - hasBowAnchor <- Test.QuickCheck.arbitrary {-Bool-} - 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 { - RegExDot.RegEx.bowAnchor = if hasBowAnchor then Just RegExDot.Anchor.Bow else Nothing, - RegExDot.RegEx.concatenation = concatenation, - RegExDot.RegEx.sternAnchor = if hasSternAnchor then Just RegExDot.Anchor.Stern else Nothing - } - -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" $ Data.Maybe.maybe True (>= minData) maybeMaxData && ( - not b == all (not . RegExDot.Consumer.getHasSpecificRequirement) (RegExDot.RegEx.concatenation $ ExtendedRegExChar.extendedRegEx r) - ) - where - RegExDot.ConsumptionProfile.MkConsumptionProfile { - RegExDot.ConsumptionProfile.consumptionBounds = (minData, maybeMaxData), - 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. - where - RegExDot.ConsumptionProfile.MkConsumptionProfile { - RegExDot.ConsumptionProfile.hasSpecificRequirement = hasSpecificRequirement, - RegExDot.ConsumptionProfile.canConsumeAnything = canConsumeAnything - } = 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_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) - - 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" $ 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. - - result :: RegExDot.RegEx.Result Char - result = s +~ RegExDot.RegExOpts.mkRegEx ( - (Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~> sign ?: digits +: map ( - RegExDot.Repeatable.zeroOrOne . RegExDot.RegEx.captureGroup . map (RegExDot.Anchor.unanchored <~>) . return {-to List-monad-} - ) [ - RegExDot.RegEx.Require (RegExDot.Meta.Literal '.') -: digits +: [], - RegExDot.RegEx.Require (RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal "eE") -: sign ?: digits +: [] - ] - ) where - sign, digits :: RegExDot.RegEx.Pattern Char - sign = RegExDot.RegEx.Require . RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal "+-" - digits = RegExDot.RegEx.Require . RegExDot.Meta.AnyOf $ map RegExDot.BracketExpressionMember.Literal ['0' .. '9'] - diff --git a/src/Grecce/Test/QC/MetaChar.hs b/src/Grecce/Test/QC/MetaChar.hs deleted file mode 100644 --- a/src/Grecce/Test/QC/MetaChar.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - 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 - 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 . --} -{- | - [@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 qualified Data.List -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 - -testCharacters :: String -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 (fmap MetaChar.MkMetaChar) [ - return {-to Gen-monad-} RegExDot.Meta.Any, - 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)) `fmap` Test.QuickCheck.vector maxBound {-Char-} - -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 = Test.QuickCheck.label "prop_io" . ToolShed.Test.ReversibleIO.isReversible - diff --git a/src/Grecce/Test/QC/QuickChecks.hs b/src/Grecce/Test/QC/QuickChecks.hs deleted file mode 100644 --- a/src/Grecce/Test/QC/QuickChecks.hs +++ /dev/null @@ -1,49 +0,0 @@ -{- - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Calls the /quickChecks/-functions for modules supporting this feature. --} - -module Grecce.Test.QC.QuickChecks( --- * Functions - 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 -import qualified Test.QuickCheck - -{- | Run the /quickChecks/-functions for modules supporting this feature. - The single Boolean flag enables verbose output. --} -run :: Bool -> IO () -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 deleted file mode 100644 --- a/src/Grecce/Test/QC/RepeatableMetaChar.hs +++ /dev/null @@ -1,92 +0,0 @@ -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' & defines tests based on it. --} - -module Grecce.Test.QC.RepeatableMetaChar( --- * Types --- ** Data-types --- RepeatableMetaChar, --- ** Type-synonyms --- Testable, --- * Functions --- deconstruct, - quickChecks -) where - -import qualified Data.Maybe -import Grecce.Test.QC.MetaChar() -import qualified RegExChar.MetaChar as MetaChar -import qualified RegExDot.Consumer -import qualified RegExDot.ConsumptionBounds -import qualified RegExDot.ConsumptionProfile -import qualified RegExDot.Repeatable -import qualified Test.QuickCheck -import qualified ToolShed.SelfValidate -import qualified ToolShed.Test.ReversibleIO - --- | A specialised instance, required to instantiate 'Test.QuickCheck.Arbitrary'. -newtype RepeatableMetaChar = MkRepeatableMetaChar (RegExDot.Repeatable.Repeatable MetaChar.MetaChar) deriving (Eq, Read, Show) - --- | Accessor. -deconstruct :: RepeatableMetaChar -> RegExDot.Repeatable.Repeatable MetaChar.MetaChar -deconstruct (MkRepeatableMetaChar repeatableMetaChar) = repeatableMetaChar - -instance ToolShed.SelfValidate.SelfValidator RepeatableMetaChar where - getErrors = ToolShed.SelfValidate.getErrors . deconstruct - -instance RegExDot.Consumer.Consumer RepeatableMetaChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstruct - starHeight = RegExDot.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 `fmap` Test.QuickCheck.elements [max fewest 1 .. 9]] - isGreedy <- Test.QuickCheck.arbitrary - - let - repetitionBounds :: RegExDot.Repeatable.RepetitionBounds - repetitionBounds = (fewest, most) - - 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. - } - -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" $ Data.Maybe.maybe True (>= minData) maybeMaxData && b == RegExDot.Consumer.getHasSpecificRequirement (RegExDot.Repeatable.base $ deconstruct r) where RegExDot.ConsumptionProfile.MkConsumptionProfile { - RegExDot.ConsumptionProfile.consumptionBounds = (minData, maybeMaxData), - RegExDot.ConsumptionProfile.hasSpecificRequirement = b - } = RegExDot.Consumer.consumptionProfile r - - prop_io (MkRepeatableMetaChar r) = Test.QuickCheck.label "prop_io" $ ToolShed.Test.ReversibleIO.isReversible r - - prop_isValid r = Test.QuickCheck.label "prop_isValid" $ ToolShed.SelfValidate.isValid r - - prop_starHeight (MkRepeatableMetaChar r) = Test.QuickCheck.label "prop_starHeight" $ RegExDot.Consumer.starHeight r == if RegExDot.ConsumptionBounds.isPrecise (RegExDot.Consumer.getConsumptionBounds r) then 0 else 1 - diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,207 +0,0 @@ -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Contains the entry-point to the program. - - * Provides command-line access to "ExtendedRegExChar". - - * Defines the permissible command-line arguments; aping /egrep/, but with the addition of /--verbose/, which enables one to see the details of the data-capture. - - [@TODO@] Coordinate the output of 'printVersion' with the definition in '.cabal'; this may not be feasible. --} - -module Main(main) where - -import qualified Data.List -import qualified Data.Version -import qualified Distribution.Package -import qualified Distribution.Text -import qualified Distribution.Version -import qualified Grecce.CommandOptions as CommandOptions -import qualified Grecce.Grep as Grep -import qualified Grecce.Test.Assert.RegExOptsChar as Test.Assert.RegExOptsChar -import qualified Grecce.Test.Performance.ExtendedRegEx as Test.Performance.ExtendedRegEx -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 RegExDot.CompilationOptions -import qualified RegExDot.ExecutionOptions -import qualified System.Console.GetOpt as G -import qualified System.Environment -import qualified System.Exit -import qualified System.IO -import qualified System.IO.Error -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'. - --- | 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 - _ -> 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 " - -{- | - * Parses the command-line arguments, to determine 'CommandOptions.CommandOptions'. - - * Arguments following 'CommandOptions.CommandOptions', are interpreted as a /regex/, followed by the names of the files to which it is applied. --} -main :: IO () -main = do - progName <- System.Environment.getProgName - - let - usageMessage :: String - usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList ++ " [, ...]" - --- Define the command-line options, & the 'CommandLineAction's used to handle them. - optDescrList :: [G.OptDescr CommandLineAction] - optDescrList = [ --- String [String] (G.ArgDescr CommandLineAction) String - G.Option "?" ["help"] (G.NoArg $ const printUsage) "Output:\tdisplay this help-text & then exit.", - G.Option "" ["verbose"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setVerbose) ("Output:\tsee how the input data was captured by the RegEx; default '" ++ show (CommandOptions.verbose ToolShed.Defaultable.defaultValue) ++ "'. CAVEAT: to be effective, it should precede other options."), - G.Option "" ["version"] (G.NoArg $ const printVersion) "Output:\tprint version-information & then exit.", - G.Option "c" ["count"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setCountMatches) ("Output:\tprint only a count of matching lines per file; default '" ++ show (CommandOptions.countMatches ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "l" ["files-with-matches"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setListFilesWithMatches) ("Output:\tlist names of files containing at least one match; default '" ++ show (CommandOptions.listFilesWithMatches ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "L" ["files-without-match"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setListFilesWithoutMatch) ("Output:\tlist names of files not containing any matches; default '" ++ show (CommandOptions.listFilesWithoutMatch ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "n" ["number"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setPrependLineNumbers) ("Output:\tprepend the line-number of the input, to the output; default '" ++ show (CommandOptions.prependLineNumbers ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "v" ["invert-match"] (G.NoArg $ return {-to IO-monad-} . CommandOptions.setInvertMatch) ("Output:\tselect non-matching lines; default '" ++ show (CommandOptions.invertMatch ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["printCurrentSettings"] (G.NoArg printCurrentSettings) "Output:\tdisplay the currently defined options & then exit.", - G.Option "e" ["regex"] (setExtendedRegExChar `G.ReqArg` "") "Input:\tdefine the regex.", - G.Option "f" ["file"] (readExtendedRegExCharFromFile `G.ReqArg` "") "Input:\tread the regex from file.", - G.Option "" ["performance"] ( - extendedRegExCharPerformance `G.ReqArg` "(Int,Either [TestName])" - ) ( - "Test:\tcompare performance with other RegEx-engines, using the specified pair (, Left " ++ show [ - minBound :: Test.Performance.ExtendedRegExTestsNegative.TestName .. maxBound - ] ++ " or Right " ++ show [ - minBound :: Test.Performance.ExtendedRegExTestsPositive.TestName .. maxBound - ] ++ "). NB: specify this option last." - ), - G.Option "" ["runQuickChecks"] (G.NoArg runQuickChecks) "Test:\trun Quick-checks using arbitrary data & then exit. Specify 'verbose' before this option, for detailed output.", - G.Option "" ["assert"] (assertFromFile `G.ReqArg` "") "Test:\trun the assertions, defined in the specified file, & then exit. NB: specify this option last.", - G.Option "" ["assertPosix"] (assertPosixFromFile `G.ReqArg` "") "Test:\trun the assertions, defined in the specified file, against Text.Regex.Posix, & then exit. NB: specify this option last.", - G.Option "" ["abortTrialRepetitionsOnInherentFailure"] (setExecutionOption abortTrialRepetitionsOnInherentFailure `G.ReqArg` "Bool") ("Performance:\tif an alternative can't match, irrespective of the subsequent concatenation, then terminate futile trial repetitions; default '" ++ show (RegExDot.ExecutionOptions.abortTrialRepetitionsOnInherentFailure ToolShed.Defaultable.defaultValue) ++ "'."), --- G.Option "" ["abortTrialRepetitionsOnZeroConsumption"] (setExecutionOption abortTrialRepetitionsOnZeroConsumption `G.ReqArg` "Bool") ("Performance:\tcheck for zero data-consumption by the n-th repetition of an alternative, before considering (n + 1); default '" ++ show (RegExDot.ExecutionOptions.abortTrialRepetitionsOnZeroConsumption ToolShed.Defaultable.defaultValue) ++ "'."), --- G.Option "" ["bypassInputDataForLiberalConsumer"] (setExecutionOption bypassInputDataForLiberalConsumer `G.ReqArg` "Bool") ("Performance:\tbypass reading of the unconsumed input data, if the remaining RegEx can consume a sufficient quantity of anything; default '" ++ show (RegExDot.ExecutionOptions.bypassInputDataForLiberalConsumer ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["catchIncompatibleAnchors"] (setExecutionOption catchIncompatibleAnchors `G.ReqArg` "Bool") ("Performance:\tavoid futile trial solutions, involving repetitions of anchored alternatives, which must consume data; default '" ++ show (RegExDot.ExecutionOptions.catchIncompatibleAnchors ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["checkExistenceOfInelasticTail"] (setExecutionOption checkExistenceOfInelasticTail `G.ReqArg` "Bool") ("Performance:\tif the regex ends in one or more Meta-data, whose repetition-range is precisely defined, check that this sequence exists at the end of the input data; default '" ++ show (RegExDot.ExecutionOptions.checkExistenceOfInelasticTail ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["checkForUnconsumableData"] (setExecutionOption checkForUnconsumableData `G.ReqArg` "Bool") ("Performance:\tcheck whether there's no possibility of consuming some of the input data; default '" ++ show (RegExDot.ExecutionOptions.checkForUnconsumableData ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["moderateGreed"] (setExecutionOption moderateGreed `G.ReqArg` "Bool") ("Performance:\tgreedily consume data, only up to the limit beyond which, future requirements would be compromised; default '" ++ show (RegExDot.ExecutionOptions.moderateGreed ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["permitReorderingOfAlternatives"] (setExecutionOption permitReorderingOfAlternatives `G.ReqArg` "Bool") ("Performance:\tpermit alternatives to be re-ordered, in an attempt to process the cheapest first; default '" ++ show (RegExDot.ExecutionOptions.permitReorderingOfAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["preferAlternativesWhichFeedTheGreedy"] (setExecutionOption preferAlternativesWhichFeedTheGreedy `G.ReqArg` "Bool") ("Preference:\tprefer solutions in which the choice of alternatives directs data from non-greedy to greedy consumers; default '" ++ show (RegExDot.ExecutionOptions.preferAlternativesWhichFeedTheGreedy ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["preferAlternativesWhichMimickUnrolling"] (setExecutionOption preferAlternativesWhichMimickUnrolling `G.ReqArg` "Bool") ("Preference:\tprefer solutions in which the choice of alternatives consumes data like the unrolled repeatable group; default '" ++ show (RegExDot.ExecutionOptions.preferAlternativesWhichMimickUnrolling ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["preferFewerRepeatedAlternatives"] (setExecutionOption preferFewerRepeatedAlternatives `G.ReqArg` "Bool") ("Preference:\tprefer solutions employing fewer repetitions of alternatives, to discourage the capture of null lists; default '" ++ show (RegExDot.ExecutionOptions.preferFewerRepeatedAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["unrollRepeatedSingletonAlternative"] (setExecutionOption unrollRepeatedSingletonAlternative `G.ReqArg` "Bool") ("Performance:\tunroll repetitions of singleton alternatives; this doesn't affect the result; default '" ++ show (RegExDot.ExecutionOptions.unrollRepeatedSingletonAlternative ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["useFirstMatchAmongAlternatives"] (setExecutionOption useFirstMatchAmongAlternatives `G.ReqArg` "Bool") ("Performance:\trather than performing an exhaustive search for the optimal choice amongst alternatives, merely select the first that matches; conform to Perl rather than Posix; default '" ++ show (RegExDot.ExecutionOptions.useFirstMatchAmongAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["validateMinConsumptionOfAlternatives"] (setExecutionOption validateMinConsumptionOfAlternatives `G.ReqArg` "Bool") ("Performance:\twhen the number of repetitions of a group of alternatives is precisely specified, check the availability of the resulting minimum data-requirement; default '" ++ show (RegExDot.ExecutionOptions.validateMinConsumptionOfAlternatives ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["complyStrictlyWithPosix"] (setCompilationOption complyStrictlyWithPosix `G.ReqArg` "Bool") ("Output:\tdefine the offset of captured data, corresponding to a sub-expression which matched zero times, as the artificial value -1 specified by Posix; currently only affects results of 'assert'; default '" ++ show (RegExDot.CompilationOptions.complyStrictlyWithPosix ToolShed.Defaultable.defaultValue) ++ "'.") - ] where - printVersion, printUsage :: IO CommandOptions.CommandOptions - - 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", - Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] - } - - author :: String - author = "Dr. Alistair Ward" - - printUsage = System.IO.hPutStrLn System.IO.stderr usageMessage >> System.Exit.exitWith System.Exit.ExitSuccess - - printCurrentSettings, runQuickChecks :: CommandLineAction - printCurrentSettings commandOptions = print commandOptions >> System.Exit.exitWith System.Exit.ExitSuccess - runQuickChecks commandOptions = Test.QC.QuickChecks.run (CommandOptions.verbose commandOptions) >> System.Exit.exitWith System.Exit.ExitSuccess - - extendedRegExCharPerformance, readExtendedRegExCharFromFile, assertFromFile, assertPosixFromFile, setExtendedRegExChar :: String -> CommandLineAction - extendedRegExCharPerformance s commandOptions = ( - uncurry $ Test.Performance.ExtendedRegEx.run (CommandOptions.executionOptions commandOptions) - ) (readCommandArg s) >> System.Exit.exitWith System.Exit.ExitSuccess - - 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) `fmap` Test.Assert.RegExOptsChar.readTests fileName - - if null failedTests - then System.Exit.exitWith System.Exit.ExitSuccess - else do - mapM_ print failedTests - - System.Exit.exitWith $ System.Exit.ExitFailure 2 - - assertPosixFromFile fileName _ = do - failedTests <- Test.Assert.RegExOptsChar.findFailuresPosix `fmap` Test.Assert.RegExOptsChar.readTests fileName - - if null failedTests - then System.Exit.exitWith System.Exit.ExitSuccess - else do - mapM_ print failedTests - - System.Exit.exitWith $ System.Exit.ExitFailure 2 - - setExtendedRegExChar s commandOptions = case CommandOptions.extendedRegExChar commandOptions of - 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 - abortTrialRepetitionsOnInherentFailure s e = e { RegExDot.ExecutionOptions.abortTrialRepetitionsOnInherentFailure = readCommandArg s } --- abortTrialRepetitionsOnZeroConsumption s e = e { RegExDot.ExecutionOptions.abortTrialRepetitionsOnZeroConsumption = readCommandArg s } --- bypassInputDataForLiberalConsumer s e = e { RegExDot.ExecutionOptions.bypassInputDataForLiberalConsumer = readCommandArg s } - catchIncompatibleAnchors s e = e { RegExDot.ExecutionOptions.catchIncompatibleAnchors = readCommandArg s } - checkExistenceOfInelasticTail s e = e { RegExDot.ExecutionOptions.checkExistenceOfInelasticTail = readCommandArg s } - checkForUnconsumableData s e = e { RegExDot.ExecutionOptions.checkForUnconsumableData = readCommandArg s } - moderateGreed s e = e { RegExDot.ExecutionOptions.moderateGreed = readCommandArg s } - permitReorderingOfAlternatives s e = e { RegExDot.ExecutionOptions.permitReorderingOfAlternatives = readCommandArg s } - preferAlternativesWhichFeedTheGreedy s e = e { RegExDot.ExecutionOptions.preferAlternativesWhichFeedTheGreedy = readCommandArg s } - preferAlternativesWhichMimickUnrolling s e = e { RegExDot.ExecutionOptions.preferAlternativesWhichMimickUnrolling = readCommandArg s } - preferFewerRepeatedAlternatives s e = e { RegExDot.ExecutionOptions.preferFewerRepeatedAlternatives = readCommandArg s } - unrollRepeatedSingletonAlternative s e = e { RegExDot.ExecutionOptions.unrollRepeatedSingletonAlternative = readCommandArg s } - useFirstMatchAmongAlternatives s e = e { RegExDot.ExecutionOptions.useFirstMatchAmongAlternatives = readCommandArg s } - validateMinConsumptionOfAlternatives s e = e { RegExDot.ExecutionOptions.validateMinConsumptionOfAlternatives = readCommandArg s } - - complyStrictlyWithPosix :: CommandOptions.CompilationOptionsMutator - complyStrictlyWithPosix s e = e { RegExDot.CompilationOptions.complyStrictlyWithPosix = readCommandArg s } - - setCompilationOption :: CommandOptions.CompilationOptionsMutator -> String -> CommandLineAction - setCompilationOption compilationOptionsMutator s = return {-to IO-monad-} . CommandOptions.setCompilationOption compilationOptionsMutator s - - setExecutionOption :: CommandOptions.ExecutionOptionsMutator -> String -> CommandLineAction - setExecutionOption executionOptionsMutator s = return {-to IO-monad-} . CommandOptions.setExecutionOption executionOptionsMutator s - - args <- System.Environment.getArgs - --- 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. - - 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 deleted file mode 100644 --- a/src/RegExChar/ExtendedRegExChar.hs +++ /dev/null @@ -1,207 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] An 'RegExDot.RegEx.ExtendedRegEx', which has been specialised for 'Char', to create a tradition non-polymorphic /regex/. --} - -module RegExChar.ExtendedRegExChar( --- * Types --- ** Type-synonyms - ExtendedRegExChar(..), - InputData, --- * Functions --- ** Operators - (+~), - (=~), - (/~) -) 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 -import qualified RegExDot.Anchor -import qualified RegExDot.Consumer -import RegExDot.DSL((<~>), (-:)) -import qualified RegExDot.RegEx -import qualified RegExDot.RegExOpts -import qualified RegExDot.Repeatable -import qualified Text.ParserCombinators.Parsec as Parsec -import Text.ParserCombinators.Parsec((), (<|>)) -import qualified ToolShed.Data.Pair -import qualified ToolShed.SelfValidate - -infix 4 +~, =~, /~ -- Same as (==) & (/=). - --- | Specialise a 'RegExDot.RegEx.ExtendedRegEx' for 'Char', & encapsulate it to permit tailored instance-declarations. -data ExtendedRegExChar = MkExtendedRegExChar { - hasNonCapturingTopLevelAlternatives :: Bool, -- ^ The string from which a 'RegExDot.RegEx.ExtendedRegEx' is read, may, if data-capture isn't required, omit explicit delimiters around top-level 'RegExDot.RegEx.Alternatives'. - extendedRegEx :: RegExDot.RegEx.ExtendedRegEx Char -} deriving Eq - --- | Abbreviation. -type InputData = RegExDot.RegEx.InputData Char - -instance ToolShed.SelfValidate.SelfValidator ExtendedRegExChar where - getErrors MkExtendedRegExChar { - hasNonCapturingTopLevelAlternatives = hasNonCapturingTopLevelAlternatives', - extendedRegEx = extendedRegEx' - } - | not $ ToolShed.SelfValidate.isValid extendedRegEx' = ToolShed.SelfValidate.getErrors extendedRegEx' - | otherwise = ToolShed.SelfValidate.extractErrors [ - (hasNonCapturingTopLevelAlternatives' && any (not . RegExDot.RegEx.isCaptureGroup . RegExDot.Repeatable.base) (RegExDot.RegEx.concatenation extendedRegEx'), "Invalid NonCapturingTopLevelAlternatives.") - ] - -instance RegExDot.Consumer.Consumer ExtendedRegExChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . extendedRegEx - starHeight = RegExDot.Consumer.starHeight . extendedRegEx - -instance RegExDot.RegEx.ShortcutExpander Char where - expand c = error $ "RegExDot.RegEx.ShortcutExpander.expand RegExChar.ExtendedRegExChar:\tunrecognised shortcut '" ++ show c ++ "'." - -instance Read ExtendedRegExChar where - readsPrec _ s - | s == reverse RegExDot.Anchor.tokens = [ - ( - MkExtendedRegExChar { - hasNonCapturingTopLevelAlternatives = False, - extendedRegEx = (Just RegExDot.Anchor.Bow, Just RegExDot.Anchor.Stern) <~> [] - }, - "" - ) - ] -- 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. - - 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 - extendedRegExParser :: Parsec.Parser (RegExDot.RegEx.ExtendedRegEx Char) - extendedRegExParser = do - maybeBowAnchor <- Parsec.option Nothing {-default-} $ (Parsec.char RegExDot.Anchor.bowToken "RegExDot.Anchor.bowToken " ++ show RegExDot.Anchor.bowToken) >> return {-to ParsecT-monad-} (Just RegExDot.Anchor.Bow) - repeatableRequirementList <- repeatableRequirementListParser - - ( - do - repeatableCaptureGroup <- RegExDot.Repeatable.repeatableParser . RegExDot.RegEx.CaptureGroup =<< uncurry Parsec.between ( - ToolShed.Data.Pair.mirror Parsec.char RegExDot.RegEx.captureGroupDelimiters - ) alternativesParser {-recurse-} "RegExDot.RegEx.captureGroupDelimiters " ++ show RegExDot.RegEx.captureGroupDelimiters - - extendedRegEx' <- extendedRegExParser -- Recurse. - - return {-to ParsecT-monad-} $ RegExDot.RegEx.transformExtendedRegEx ((repeatableRequirementList ++) . (repeatableCaptureGroup :)) extendedRegEx' { RegExDot.RegEx.bowAnchor = maybeBowAnchor } - ) <|> ( - do - maybeSternAnchor <- Parsec.option Nothing {-default-} $ (Parsec.char RegExDot.Anchor.sternToken "RegExDot.Anchor.sternToken " ++ show RegExDot.Anchor.sternToken) >> return {-to ParsecT-monad-} (Just RegExDot.Anchor.Stern) - - return {-to ParsecT-monad-} RegExDot.RegEx.MkExtendedRegEx { - RegExDot.RegEx.bowAnchor = maybeBowAnchor, - RegExDot.RegEx.concatenation = repeatableRequirementList, - RegExDot.RegEx.sternAnchor = maybeSternAnchor - } - ) - where - repeatableRequirementListParser :: Parsec.Parser (RegExDot.RegEx.Concatenation Char) - repeatableRequirementListParser = Parsec.choice [ - Parsec.try . Parsec.lookAhead $ ( - Parsec.char RegExDot.Anchor.sternToken "RegExDot.Anchor.sternToken " ++ show RegExDot.Anchor.sternToken - ) >> ( - ( - Parsec.eof >> return {-to ParsecT-monad-} [] - ) <|> ( - Parsec.oneOf [RegExDot.RegEx.alternativeExtendedRegExSeparatorToken, snd RegExDot.RegEx.captureGroupDelimiters] >> return {-to ParsecT-monad-} [] - ) - ), - (:) <$> ( - MetaChar.metaCharParser >>= RegExDot.Repeatable.repeatableParser . RegExDot.RegEx.Require . MetaChar.deconstruct - ) <*> repeatableRequirementListParser, {-recurse-} - return {-to ParsecT-monad-} [] - ] - - in ( - 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. - ) $ Parsec.parse ( - (,) <$> extendedRegExCharParser <*> Parsec.getInput - ) "ExtendedRegExChar" s - -instance Show ExtendedRegExChar where - showsPrec _ MkExtendedRegExChar { - hasNonCapturingTopLevelAlternatives = hasNonCapturingTopLevelAlternatives', - extendedRegEx = RegExDot.RegEx.MkExtendedRegEx { - RegExDot.RegEx.bowAnchor = maybeBowAnchor, - RegExDot.RegEx.concatenation = concatenation', - RegExDot.RegEx.sternAnchor = maybeSternAnchor - } - } = RegExDot.RegEx.showsMaybeAnchor maybeBowAnchor . foldl (.) (showString "") ( - ( - let - showAlternatives :: RegExDot.RegEx.Alternatives Char -> [ShowS] - showAlternatives = Data.List.intersperse (showChar RegExDot.RegEx.alternativeExtendedRegExSeparatorToken) . map (shows . MkExtendedRegExChar False) . RegExDot.RegEx.deconstructAlternatives - in if hasNonCapturingTopLevelAlternatives' - then map ( - \repeatablePattern -> case RegExDot.Repeatable.base repeatablePattern of - RegExDot.RegEx.CaptureGroup alternatives -> foldr (.) (showString "") $ showAlternatives alternatives - _ -> error $ "Show RegExChar.ExtendedRegExChar: unexpected " ++ show repeatablePattern - ) - else map ( - \repeatablePattern -> ( - case RegExDot.Repeatable.base repeatablePattern of - RegExDot.RegEx.Require meta -> shows $ MetaChar.MkMetaChar meta - RegExDot.RegEx.CaptureGroup alternatives -> showChar ( - fst RegExDot.RegEx.captureGroupDelimiters - ) . foldr (.) ( - showChar $ snd RegExDot.RegEx.captureGroupDelimiters -- Initial value. - ) ( - showAlternatives alternatives - ) - ) . RegExDot.Repeatable.showSuffix repeatablePattern - ) - ) concatenation' - ) . RegExDot.RegEx.showsMaybeAnchor maybeSternAnchor - --- | 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. - -> RegExDot.RegEx.Result Char -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: . - --- | Pattern-mismatch operator. -(/~) - :: InputData -- ^ The input-data string. - -> RegExDot.RegExOpts.RegExOpts ExtendedRegExChar -- ^ The match-options, parameterised by the regex-specification. - -> Bool -(/~) inputData = not . (inputData =~) - diff --git a/src/RegExChar/MetaChar.hs b/src/RegExChar/MetaChar.hs deleted file mode 100644 --- a/src/RegExChar/MetaChar.hs +++ /dev/null @@ -1,253 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Implements 'RegExDot.Meta.ShortcutExpander' 'Char', to implement some of the traditional /Perl-style shortcuts/: - - [@\\d@] => Any 'Data.Char.isDigit'-character. - - [@\\D@] => Any non-'Data.Char.isDigit' character. - - [@\\s@] => Any 'Data.Char.isSpace'-character. - - [@\\S@] => Any non-'Data.Char.isSpace' character. - - [@\\w@] => Any 'Data.Char.isWord' letter. - - [@\\W@] => Any non-'Data.Char.isWord' letter. - - * Enables one to compose concise regexen, containing any 'Char' that's a member of one of these predefined sets. - - * Though 'RegExDot.Meta.Meta' is polymorphic, & the type-parameter can't be assumed to implement either 'Enum' or 'Ord', - 'Char' actually does, so this module is able to implement ranges within a /Bracket-expression/. - - * Defines specialised instances of 'Read' & 'Show', to cope with /Perl-style shortcuts/, /Posix Character-classes/ & /Bracket-expression/ range-specifications. - - [@TODO@] Use @Environment.getLocale@. Regrettably, this returns in the "IO"-monad, & even it didn't, how does one pass that information to 'Read' ?! --} - -module RegExChar.MetaChar( --- * Types --- AssociationList, --- Dictionary, --- ** Type-synonyms - MetaChar(..), --- * Constants --- bracketExpressionRangeToken, --- posixCharacterClassDelimiters, --- * Functions --- implementPerlShortcut, - metaCharParser, --- ** Accessors (Deconstructors) - deconstruct -) where - -import Prelude hiding ((<$>), (<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. -import Control.Applicative((<$>), (<*>)) -import Control.Arrow((***)) -import qualified Data.Char -import qualified Data.Map -import qualified RegExDot.BracketExpression -import qualified RegExDot.BracketExpressionMember -import qualified RegExDot.Consumer -import qualified RegExDot.Meta -import qualified RegExDot.RegEx -import qualified RegExDot.Repeatable -import qualified RegExDot.ShowablePredicate -import qualified Text.ParserCombinators.Parsec as Parsec -import Text.ParserCombinators.Parsec(()) -import qualified ToolShed.Data.Pair -import qualified ToolShed.SelfValidate - --- | Holds a mapping from an escape-sequence & the predicate via which it is implemented. -type AssociationList key = [(key, RegExDot.ShowablePredicate.Predicate Char)] - --- | Holds a mapping from an escape-sequence & the predicate via which it is implemented. -type Dictionary key = Data.Map.Map key (RegExDot.ShowablePredicate.Predicate Char) - -instance RegExDot.BracketExpressionMember.ShortcutExpander Char where - findPredicate shortcut = RegExDot.ShowablePredicate.MkShowablePredicate [RegExDot.Meta.shortcutToken, shortcut] <$> shortcut `Data.Map.lookup` dictionary where - dictionary :: Dictionary Char - dictionary = Data.Map.fromList $ perlShortcuts ++ invert perlShortcuts where - perlShortcuts :: AssociationList Char - perlShortcuts = [ - ('d', Data.Char.isDigit), - ('s', Data.Char.isSpace), - ('w', \c -> ($ c) `any` [Data.Char.isAlphaNum, (== '_')]) - ] - - invert :: AssociationList Char -> AssociationList Char - invert = map (Data.Char.toUpper *** (not .)) - -instance RegExDot.Meta.ShortcutExpander Char where - expand c = case RegExDot.BracketExpressionMember.findPredicate c of - Just showablePredicate -> RegExDot.Meta.Predicate showablePredicate - _ -> RegExDot.Meta.Literal c - --- | A specialised instance, encapsulated to permit tailored instance-declarations. -newtype MetaChar = MkMetaChar (RegExDot.Meta.Meta Char) deriving Eq - --- | Accessor. -deconstruct :: MetaChar -> RegExDot.Meta.Meta Char -deconstruct (MkMetaChar metaChar) = metaChar - -instance ToolShed.SelfValidate.SelfValidator MetaChar where - getErrors = ToolShed.SelfValidate.getErrors . deconstruct - -instance RegExDot.Consumer.Consumer MetaChar where - consumptionProfile = RegExDot.Consumer.consumptionProfile . deconstruct - starHeight = RegExDot.Consumer.starHeight . deconstruct - --- | Builds a parser of traditional regex-syntax, which understands 'Char'-specific concepts like /Perl-style shortcuts/ & /Posix Character-classes/. -metaCharParser :: Parsec.Parser MetaChar -metaCharParser = MkMetaChar <$> Parsec.choice [ - (Parsec.char RegExDot.Meta.anyToken "RegExDot.Meta.anyToken " ++ show RegExDot.Meta.anyToken) >> return {-to ParsecT-monad-} RegExDot.Meta.Any, - (Parsec.char RegExDot.Meta.shortcutToken "RegExDot.Meta.shortcutToken " ++ show RegExDot.Meta.shortcutToken) >> RegExDot.Meta.expand <$> Parsec.anyChar, - uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.char RegExDot.BracketExpression.delimiterTokens) ( - do - let - implementPosixCharacterClass :: String -> Maybe (RegExDot.ShowablePredicate.ShowablePredicate Char) - implementPosixCharacterClass identifier = RegExDot.ShowablePredicate.MkShowablePredicate ( - fst posixCharacterClassDelimiters ++ identifier ++ snd posixCharacterClassDelimiters - ) <$> identifier `Data.Map.lookup` dictionary where - dictionary :: Dictionary String - dictionary = Data.Map.fromList $ posixCharacterClasses ++ invert posixCharacterClasses where - posixCharacterClasses :: AssociationList String - posixCharacterClasses = [ - ("alnum", Data.Char.isAlphaNum), - ("alpha", Data.Char.isAlpha), - ("ascii", Data.Char.isAscii), - ("blank", (`elem` " \t")), - ("cntrl", Data.Char.isControl), - ("digit", Data.Char.isDigit), - ("graph", \c -> not $ ($ c) `any` [Data.Char.isSpace, Data.Char.isControl]), - ("lower", Data.Char.isLower), - ("print", Data.Char.isPrint), - ("punct", Data.Char.isPunctuation), - ("space", Data.Char.isSpace), - ("upper", Data.Char.isUpper), - ("word", \c -> ($ c) `any` [Data.Char.isAlphaNum, (== '_')]), - ("xdigit", Data.Char.isHexDigit) - ] - - invert :: AssociationList String -> AssociationList String - invert = map $ (RegExDot.BracketExpression.negationToken :) *** (not .) - - cTor <- Parsec.option RegExDot.Meta.AnyOf {-default-} $ (Parsec.char RegExDot.BracketExpression.negationToken "RegExDot.BracketExpression.negationToken " ++ show RegExDot.BracketExpression.negationToken) >> return {-to ParsecT-monad-} RegExDot.Meta.NoneOf - - 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'. - - cTor . (literalBracketExpressionTerminator ++) <$> Parsec.many {-potentially zero-} ( - Parsec.choice [ - ( - do - _ <- Parsec.char RegExDot.Meta.shortcutToken "RegExDot.Meta.shortcutToken " ++ show RegExDot.Meta.shortcutToken - c <- Parsec.anyChar - - return {-to ParsecT-monad-} $ case RegExDot.BracketExpressionMember.findPredicate c of - Just showablePredicate -> RegExDot.BracketExpressionMember.Predicate showablePredicate - _ -> RegExDot.BracketExpressionMember.Literal c -- Escaped literal. - ) "Perl-style shortcut", - Parsec.try ( - uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.string posixCharacterClassDelimiters) ( - do - identifier <- Parsec.many1 $ Parsec.noneOf [head $ snd posixCharacterClassDelimiters] - - case implementPosixCharacterClass identifier of - 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. - Parsec.try ( - ( - do - rangeStart <- Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] - _ <- Parsec.char bracketExpressionRangeToken "bracketExpressionRangeToken " ++ show bracketExpressionRangeToken - rangeEnd <- Parsec.noneOf [snd RegExDot.BracketExpression.delimiterTokens] - - return {-to ParsecT-monad-} . RegExDot.BracketExpressionMember.Predicate . RegExDot.ShowablePredicate.MkShowablePredicate [ - rangeStart, - bracketExpressionRangeToken, - rangeEnd - ] $ \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 ']'. - ] "Bracket-expression member" - ) "Bracket-expression member-list" - ) "RegExDot.BracketExpression.delimiterTokens " ++ show RegExDot.BracketExpression.delimiterTokens, - RegExDot.Meta.Literal <$> Parsec.noneOf RegExDot.RegEx.tokens - ] - -instance Read MetaChar where - readsPrec _ = ( - (fail . ("readsPrec RegExChar.MetaChar:\tparse-error; " ++) . show) `either` return - ) . Parsec.parse ( - (,) <$> metaCharParser <*> Parsec.getInput - ) "MetaChar" - --- | The token used to signify an ordered range of members in a /Bracket-expression/. -bracketExpressionRangeToken :: Char -bracketExpressionRangeToken = '-' - --- | The delimiters of a /Posix Character-class/. -posixCharacterClassDelimiters :: (String, String) -posixCharacterClassDelimiters = ("[:", ":]") - -instance Show MetaChar where - showsPrec _ (MkMetaChar RegExDot.Meta.Any) = showChar RegExDot.Meta.anyToken - showsPrec _ (MkMetaChar (RegExDot.Meta.Literal c)) = ( - if c `elem` [ - fst RegExDot.BracketExpression.delimiterTokens, - fst RegExDot.Repeatable.rangeDelimiters, - RegExDot.Repeatable.oneOrMoreToken, - RegExDot.Repeatable.zeroOrMoreToken, - RegExDot.Repeatable.zeroOrOneToken, - RegExDot.Meta.anyToken, - RegExDot.Meta.shortcutToken - ] ++ RegExDot.RegEx.tokens - then showChar RegExDot.Meta.shortcutToken - else id - ) . showChar c - showsPrec _ (MkMetaChar (RegExDot.Meta.AnyOf bracketExpression)) = showChar ( - fst RegExDot.BracketExpression.delimiterTokens - ) . showString ( - foldr ( - \e -> case e of - 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". - RegExDot.Meta.shortcutToken, - 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. - ) bracketExpression - ) - showsPrec _ (MkMetaChar (RegExDot.Meta.NoneOf bracketExpression)) = showChar x . showChar RegExDot.BracketExpression.negationToken . showString xs where (x : xs) = show . MkMetaChar $ RegExDot.Meta.AnyOf bracketExpression - showsPrec _ (MkMetaChar m) = shows m - diff --git a/src/RegExChar/RegExOptsChar.hs b/src/RegExChar/RegExOptsChar.hs deleted file mode 100644 --- a/src/RegExChar/RegExOptsChar.hs +++ /dev/null @@ -1,219 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{- - 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 - 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 . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Creates a /back-end/ implementation, conforming to . - - [@CAVEATS@] - - * The underlying polymorphic (in terms of the base-type of the list of input data) 'RegExDot.RegEx.ExtendedRegEx'-engine is never going to be a drop-in replacement for other /regex/-engines, - so this standard interface has only been implemented for traditional input data-type ['Char']. - - * The standard interface requires many Haskell-extensions, but since this implementation is just a thin layer over the underlying portable polymorphic 'RegExDot.RegEx.ExtendedRegEx'-engine, - the latter can still be used directly, where any of these extensions are unavailable. --} - -module RegExChar.RegExOptsChar( --- * Types --- ** Type-synonyms - MatchSpan, --- MatchDataSpan, - RegExOptsChar, --- * Functions --- exciseNonCapturingTopLevelAlternatives, --- matchUntilFailure, --- toMatchDataSpanList, - toZeroIndexedArray, --- ** Operators - (=~) --- ** Predicates --- complyStrictlyWithPosix, --- hasNonCapturingTopLevelAlternatives -) where - -import qualified Data.Array.IArray -import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar -import qualified RegExDot.CompilationOptions -import qualified RegExDot.ConsumptionBounds -import qualified RegExDot.DataSpan -import qualified RegExDot.DataSpanTree -import qualified RegExDot.ExecutionOptions -import qualified RegExDot.RegEx -import qualified RegExDot.RegExOpts -import qualified RegExDot.Result -import qualified RegExDot.Tree -import qualified Text.Regex.Base.RegexLike as RegexLike -import Text.Regex.Base.Context() -- Instance-declarations. -import qualified ToolShed.Data.List -import qualified ToolShed.Defaultable -import qualified ToolShed.Options - -infix 4 =~ -- Same as (==). - --- | Defines a specific instance of the polymorphic base-type. -type RegExOptsChar = RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar - --- | Convenience accessor-function. -hasNonCapturingTopLevelAlternatives :: RegExOptsChar -> Bool -hasNonCapturingTopLevelAlternatives = ExtendedRegExChar.hasNonCapturingTopLevelAlternatives . RegExDot.RegExOpts.regEx - --- | Convenience accessor-function. -complyStrictlyWithPosix :: RegExOptsChar -> Bool -complyStrictlyWithPosix = RegExDot.CompilationOptions.complyStrictlyWithPosix . RegExDot.RegExOpts.compilationOptions - -instance RegexLike.RegexOptions RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions where - blankCompOpt = ToolShed.Options.blankValue - blankExecOpt = ToolShed.Options.blankValue - defaultCompOpt = ToolShed.Defaultable.defaultValue - defaultExecOpt = ToolShed.Defaultable.defaultValue - 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. -instance RegexLike.RegexMaker RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions String where - makeRegexOpts c e source = RegExDot.RegExOpts.MkRegExOpts { - RegExDot.RegExOpts.compilationOptions = c, - RegExDot.RegExOpts.executionOptions = e, - RegExDot.RegExOpts.regEx = read source - } - --- | The offset and length of the 'RegExDot.RegEx.InputData' consumed in one 'RegExDot.RegEx.Match'. -type MatchSpan = (RegexLike.MatchOffset, RegexLike.MatchLength) - -{- | - * The 'MatchSpan' augmented by the consumed 'ExtendedRegExChar.InputData' to which it refers. - - * Similar to 'RegExDot.DataSpan.DataSpan'. --} -type MatchDataSpan = (ExtendedRegExChar.InputData, MatchSpan) - -{- | - * Convert the 'RegExDot.RegEx.MatchList', into the 'MatchDataSpan's required by "Text.Regex.Base.RegexLike". - - * Treat the whole 'ExtendedRegExChar.ExtendedRegExChar' as an additional implicit capture-group. - - * CAVEAT: @RegExDot.DataSpanTree.extractCaptureGroups True@ may return some 'RegExDot.DataSpan.DataSpan's containing the artificial offset @-1@ specified by Posix => don't use this as the basis for any arithmetic. --} -toMatchDataSpanList - :: Bool - -> 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 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. - | otherwise = id - --- | Convert the specified list, into a zero-indexed array. -toZeroIndexedArray :: [e] -> Data.Array.IArray.Array Int e -toZeroIndexedArray l = Data.Array.IArray.listArray (0, pred $ length l) l - -{- | - * Repeatedly apply the 'RegExOptsChar' to the 'ExtendedRegExChar.InputData', forwarding unmatched input data to the next match-attempt, until it's all been consumed. - - * The offsets, from the start of the input data, of all matches after the first, are shifted to account for input data already consumed by previous matches. --} -matchUntilFailure - :: RegExOptsChar -- ^ The match-criteria. - -> ExtendedRegExChar.InputData -- ^ The input-data, to be consumed by repeated matching. - -> [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: . - (_, Just matchList, maybeSternAnchorResult) -> matchList : if null (RegExDot.RegEx.extractDataFromMatchList matchList) then [] else matchUntilFailure' (RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult) - _ -> [] - - shiftOffsets :: RegExDot.ConsumptionBounds.DataLength -> [RegExDot.RegEx.MatchList Char] -> [RegExDot.RegEx.MatchList Char] - shiftOffsets offset (matchList : matchLists) = let - shiftedMatchList :: RegExDot.RegEx.MatchList Char - shiftedMatchList = RegExDot.RegEx.shiftMatchList offset matchList - in shiftedMatchList : shiftOffsets (RegExDot.DataSpan.after . last . RegExDot.DataSpanTree.flattenTreeList 0 $ RegExDot.DataSpanTree.toTreeList shiftedMatchList) matchLists {-recurse-} - shiftOffsets _ _ = [] - -instance RegexLike.RegexLike RegExOptsChar ExtendedRegExChar.InputData where -{- E.g.: - ("xabcdxabdxxadx" RegExOptsChar.=~ "a(b(c?))*d") :: [Text.Regex.Base.RegexLike.MatchArray] - [array (0,2) [(0,(1,4)),(1,(2,2)),(2,(3,1))],array (0,2) [(0,(6,3)),(1,(7,1)),(2,(8,0))],array (0,1) [(0,(11,2)),(1,(-1,0))]] --} --- matchAll :: RegExOptsChar -> ExtendedRegExChar.InputData -> [RegexLike.MatchArray] - matchAll regExOptsChar = map (toZeroIndexedArray . map snd {-span-} . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar - -{- E.g.: - ("xabcdxabdxxadx" RegExOptsChar.=~ "a(b(c?))*d") :: [Text.Regex.Base.RegexLike.MatchText String] - [array (0,2) [(0,("abcd",(1,4))),(1,("bc",(2,2))),(2,("c",(3,1)))],array (0,2) [(0,("abd",(6,3))),(1,("b",(7,1))),(2,("",(8,0)))],array (0,1) [(0,("ad",(11,2))),(1,("",(-1,0)))]] --} --- matchAllText :: RegExOptsChar -> ExtendedRegExChar.InputData -> [RegexLike.MatchText ExtendedRegExChar.InputData] - matchAllText regExOptsChar = map (toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar - -{- E.g.: - ("xabcdx" RegExOptsChar.=~ "a(b(c?))*d") :: Text.Regex.Base.RegexLike.MatchArray - 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 - ) - ) `fmap` RegExDot.Result.getMatchList extendedRegExResult where - extendedRegExResult :: RegExDot.RegEx.Result Char - 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: . - (maybeBowAnchorResult, Just matchList, maybeSternAnchorResult) -> Just ( - RegExDot.RegEx.extractDataFromMatch' maybeBowAnchorResult, - toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar $ toMatchDataSpanList ( - complyStrictlyWithPosix regExOptsChar - ) ( - RegExDot.RegEx.externalMatchLength maybeBowAnchorResult - ) matchList, - RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult - ) - _ -> Nothing - -{- E.g.: - ("xabcdx" RegExOptsChar.=~ "a(b(c?))*d") :: Bool - True --} --- matchTest :: RegExOptsChar -> ExtendedRegExChar.InputData -> Bool - matchTest = flip (ExtendedRegExChar.=~) -- CAVEAT: . - -{- | - * Match-operator. - - * The polymorphic return-type is resolved by the caller's "RegexLike.RegexContext". --} -(=~) :: RegexLike.RegexContext RegExOptsChar ExtendedRegExChar.InputData target - => ExtendedRegExChar.InputData -- ^ The input data. - -> String -- ^ The string from which to read the regex-specification. - -> target -- ^ The polymorphic return-type. -inputData =~ s = (RegexLike.makeRegex s :: RegExOptsChar) `RegexLike.match` inputData -