diff --git a/Build.bat b/Build.bat
new file mode 100644
--- /dev/null
+++ b/Build.bat
@@ -0,0 +1,98 @@
+REM -- Build polyparse package using GHC
+REM
+REM Usage: (case-sensitive)
+REM Build compile and install the polyparse library GHC package
+REM Build Remove remove the polyparse GHC library package
+
+rem -- Change the following variables (upto and including SRC)
+rem -- to suit the local system environment --
+
+rem GHC version
+set GHCVER=6.6
+
+rem GHC installation directory:
+set GHCDIR=C:\DEV\ghc\ghc-%GHCVER%
+
+rem Programs needed to build polyparse:
+rem
+rem NOTE: install MinGW linked from
+rem for a copy of 'ar.exe'
+rem
+set GHC=C:\DEV\ghc\ghc-%GHCVER%\bin\ghc.exe
+set GHCPKG=C:\DEV\ghc\ghc-%GHCVER%\bin\ghc-pkg.exe
+set AR=C:\DEV\MinGW\bin\ar.exe
+set LD=C:\DEV\ghc\ghc-%GHCVER%\gcc-lib\ld.exe
+
+rem Source directory for polyparse:
+set SRC=C:\DEV\Haskell\lib\polyparse-1.10\src
+
+rem Two very long lines (500-600 chars) follow here.
+rem They should not need changing.
+set SRCS=Text/ParserCombinators/Poly.hs Text/ParserCombinators/PolyState.hs Text/ParserCombinators/TextParser.hs Text/ParserCombinators/PolyLazy.hs Text/ParserCombinators/PolyStateLazy.hs
+set OBJS=Text/ParserCombinators/Poly.o Text/ParserCombinators/PolyState.o Text/ParserCombinators/TextParser.o Text/ParserCombinators/PolyLazy.o Text/ParserCombinators/PolyStateLazy.o
+
+
+rem -- Get on with the real work --
+
+if "%1"=="Remove" goto Remove
+
+rem -- Compile sources and create library archive
+if "%GHCVER%"=="6.4" COPY polyparse.cabal %SRC%\pkg.conf
+if "%GHCVER%"=="6.4.1" COPY polyparse.cabal %SRC%\pkg.conf
+if "%GHCVER%"=="6.4.2" COPY polyparse.cabal %SRC%\pkg.conf
+if "%GHCVER%"=="6.6" COPY polyparse.cabal %SRC%\pkg.conf
+if "%GHCVER%"=="6.6.1" COPY polyparse.cabal %SRC%\pkg.conf
+if "%GHCVER%"=="6.6.2" COPY polyparse.cabal %SRC%\pkg.conf
+cd %SRC%
+%GHC% --make -cpp -i. -package-name polyparse-1.00 %SRCS%
+%AR% r libHSpolyparse.a %OBJS%
+
+rem -- Create library file for GHCi
+%LD% -r --whole-archive -o HSpolyparse.o libHSpolyparse.a
+
+rem -- Install the library archive(s) where GHC can find them
+COPY libHSpolyparse.a %GHCDIR%
+COPY HSpolyparse.o %GHCDIR%
+
+rem -- Install the interface files where GHC can find them
+rem /L - list only, /Y - overrite without confirmation
+rem /S - copy subdirectories, /T - create directories only
+rem /F - display full filenames while copying
+XCOPY /S /F *.hi %GHCDIR%\imports
+
+rem -- Finally, register the package with GHC
+if "%GHCVER%"=="6.2" goto OldRegister
+if "%GHCVER%"=="6.2.1" goto OldRegister
+if "%GHCVER%"=="6.2.2" goto OldRegister
+if "%GHCVER%"=="6.4" goto NewRegister
+if "%GHCVER%"=="6.4.1" goto NewRegister
+if "%GHCVER%"=="6.4.2" goto NewRegister
+if "%GHCVER%"=="6.6" goto NewRegister
+if "%GHCVER%"=="6.6.1" goto NewRegister
+if "%GHCVER%"=="6.6.2" goto NewRegister
+
+goto Exit
+
+rem -- old-style package registration
+:OldRegister
+%GHCPKG% --add-package -i pkg.conf
+goto Exit
+
+rem -- new-style package registration
+:NewRegister
+ECHO import-dirs: %GHCDIR%\imports >>pkg.conf
+ECHO library-dirs: %GHCDIR% >>pkg.conf
+ECHO depends: base, haskell98 >>pkg.conf
+ECHO hs-libraries: HSpolyparse >>pkg.conf
+%GHCPKG% register pkg.conf
+goto Exit
+
+rem -- Remove GHC package for polyparse --
+:Remove
+%GHCPKG% --remove-package polyparse-1.00
+
+goto Exit
+
+rem -- All done --
+
+:Exit
diff --git a/COPYRIGHT b/COPYRIGHT
new file mode 100644
--- /dev/null
+++ b/COPYRIGHT
@@ -0,0 +1,32 @@
+The module Text.ParserCombinators.HuttonMeijer is
+ (c) copyright 1996 Graham Hutton and Erik Meijer
+The module Text.ParserCombinators.HuttonMeijerWallace is
+ (c) copyright 1996 Graham Hutton and Erik Meijer
+ with modifications
+ (c) copyright 1998-2000 Malcolm Wallace
+The modules Text.ParserCombinators.Poly* and Text.Parse
+are
+ (c) copyright 2006-2007 Malcolm Wallace
+
+These modules are licensed under the terms of the GNU Lesser
+General Public Licence (LGPL), which can be found in the file called
+LICENCE-LGPL, with the following special exception:
+
+----
+As a relaxation of clause 6 of the LGPL, the copyright holders of this
+library give permission to use, copy, link, modify, and distribute,
+binary-only object-code versions of an executable linked with the
+original unmodified Library, without requiring the supply of any
+mechanism to modify or replace the Library and relink (clauses 6a,
+6b, 6c, 6d, 6e), provided that all the other terms of clause 6 are
+complied with.
+----
+
+This library 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
+Licence for more details.
+
+If these licensing terms are not acceptable to you, please contact me for
+negotiation. :-)
+ Malcolm.Wallace@cs.york.ac.uk
diff --git a/LICENCE-LGPL b/LICENCE-LGPL
new file mode 100644
--- /dev/null
+++ b/LICENCE-LGPL
@@ -0,0 +1,507 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations
+below.
+
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it
+becomes a de-facto standard. To achieve this, non-free programs must
+be allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control
+compilation and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ c) Accompany the work with a written offer, valid for at least
+ three years, to give the same user the materials specified in
+ Subsection 6a, above, for a charge no more than the cost of
+ performing this distribution.
+
+ d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+ 11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply, and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License
+may add an explicit geographical distribution limitation excluding those
+countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library 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
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ , 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
+
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,104 @@
+SOFTWARE = polyparse
+VERSION = 1.0
+
+CPP = cpp -traditional
+#CPP = cpphs --text # useful e.g. on MacOS X
+
+DIRS = Text Text/ParserCombinators
+
+SRCS = \
+ src/Text/ParserCombinators/HuttonMeijer.hs \
+ src/Text/ParserCombinators/HuttonMeijerWallace.hs \
+ src/Text/ParserCombinators/Poly.hs \
+ src/Text/ParserCombinators/PolyState.hs \
+ src/Text/ParserCombinators/PolyLazy.hs \
+ src/Text/ParserCombinators/PolyStateLazy.hs \
+ src/Text/Parse.hs
+
+TOOLSRCS = \
+
+AUX = configure Makefile src/Makefile src/pkg.conf docs/* examples \
+ README LICENCE* COPYRIGHT script/echo.c Build.bat \
+ *.cabal Setup.hs
+ALLFILES = $(SRCS) $(TOOLSRCS) $(AUX)
+
+# These files in CVS are NOT included in the src distribution.
+NOT = Makefile.inc Makefile.nhc98 src/Makefile.inc src/Makefile.nhc98
+
+.PHONY: all libs tools haddock install register
+
+COMPILERS = $(shell cat obj/compilers)
+LIBS = $(patsubst %, libs-%, $(COMPILERS))
+TOOLS = $(patsubst %, tools-%, $(COMPILERS))
+INSTALL = $(patsubst %, install-%, $(COMPILERS))
+FILESONLY = $(patsubst %, install-filesonly-%, $(COMPILERS))
+
+all: $(LIBS) $(TOOLS)
+libs: $(LIBS)
+tools: $(TOOLS)
+install: $(INSTALL)
+install-filesonly: $(FILESONLY)
+libs-ghc:
+ cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) libs
+libs-nhc98:
+ cd obj/nhc98; $(MAKE) HC=nhc98 libs
+libs-hugs:
+ @echo "No building required for Hugs version of $(SOFTWARE) libs."
+tools-ghc:
+ cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) toolset
+tools-nhc98:
+ cd obj/nhc98; $(MAKE) HC=nhc98 toolset
+tools-hugs:
+ @echo "No building required for Hugs version of $(SOFTWARE) tools."
+install-ghc:
+ cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) install-ghc
+install-nhc98:
+ cd obj/nhc98; $(MAKE) HC=nhc98 install-nhc98
+install-hugs:
+ hugs-package src
+ cd obj/hugs; $(MAKE) install-tools-hugs
+install-filesonly-ghc:
+ cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) install-filesonly-ghc
+install-filesonly-nhc98:
+ cd obj/nhc98; $(MAKE) HC=nhc98 install-filesonly-nhc98
+install-filesonly-hugs: install-hugs
+haddock:
+ mkdir -p docs/haddock
+ for dir in $(DIRS); \
+ do mkdir -p docs/haddock/src/$$dir; \
+ done
+ for file in $(SRCS); \
+ do $(CPP) -D__NHC__ $$file >$$file.uncpp; \
+ HsColour -anchorHTML $$file >docs/haddock/`dirname $$file`/`basename $$file .hs`.html; \
+ done
+ haddock --html --title=$(SOFTWARE) --odir=docs/haddock \
+ --package=$(SOFTWARE) \
+ --source-module="src/%{MODULE/.//}.html" \
+ --source-entity="src/%{MODULE/.//}.html#%{NAME}" \
+ $(patsubst %, %.uncpp, $(SRCS))
+ rm -f $(patsubst %, %.uncpp, $(SRCS))
+
+# packaging a distribution
+
+srcDist: $(ALLFILES) haddock
+ rm -f $(SOFTWARE)-$(VERSION).tar $(SOFTWARE)-$(VERSION).tar.gz
+ mkdir $(SOFTWARE)-$(VERSION)
+ tar cf - $(ALLFILES) | ( cd $(SOFTWARE)-$(VERSION); tar xf - )
+ tar cf $(SOFTWARE)-$(VERSION).tar $(SOFTWARE)-$(VERSION)
+ rm -rf $(SOFTWARE)-$(VERSION)
+ gzip $(SOFTWARE)-$(VERSION).tar
+
+zipDist: $(ALLFILES) haddock
+ rm -f $(SOFTWARE)-$(VERSION).zip
+ mkdir $(SOFTWARE)-$(VERSION)
+ tar cf - $(ALLFILES) | ( cd $(SOFTWARE)-$(VERSION); tar xf - )
+ zip -r $(SOFTWARE)-$(VERSION).zip $(SOFTWARE)-$(VERSION)
+ rm -rf $(SOFTWARE)-$(VERSION)
+
+
+# clear up rubbish
+clean:
+ rm -rf obj/ghc obj/nhc98 obj/hugs
+ cd examples; rm -f *.hi *.o
+realclean: clean
+ rm -rf obj
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,48 @@
+ polyparse - a collection of alternative parser combinator libraries
+ -------------------------------------------------------------------
+
+Installation instructions:
+We currently support nhc98, ghc, and Hugs. The automatic configuration
+detects which compilers/interpreters you have, and prepares a build
+tree for each. Installation may require write-permission on the system
+directories of the compiler/interpreter. The libraries and interfaces
+can then be used as "-package polyparse" (for ghc/nhc98 - no extra options
+required for Hugs).
+
+ sh configure
+ make
+ make install
+
+Options to configure are:
+ --buildwith=... e.g. ghc-6.6, to build for a specific compiler
+ --prefix=... e.g. /usr/local, to change installation location
+
+Complaints to: :-)
+ Malcolm.Wallace@cs.york.ac.uk
+
+P.S.
+ For those building on Windows /without/ Cygwin, you can avoid the need
+ for configure/make steps by simply running the minimal build script in
+ Build.bat
+ You will need to edit it for the location of your compiler etc.
+
+----
+What this package contains:
+
+ docs/ Some rudimentary HTML documentation about the libraries.
+ docs/haddock/ Haddock-generated API documentation.
+ examples/ Some small examples of how the libraries are used.
+
+ src/Text
+ Parse A replacement for the Prelude Read class.
+ src/Text/ParserCombinators
+ HuttonMeijer Early parser combinators from 1996.
+ HuttonMeijerWallace Extended for arbitrary token type + running
+ state + error msgs.
+ Poly Space-efficient combinators that allow arbitrary
+ token type.
+ PolyState arbitrary token type + running state.
+ PolyLazy arbitrary token type + lazy return of results.
+ PolyStateLazy arbitrary token type + running state + lazy results.
+
+----
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/configure b/configure
new file mode 100644
--- /dev/null
+++ b/configure
@@ -0,0 +1,320 @@
+#!/bin/sh
+# configure -- prepare to compile/install the polyparse package
+# modified from the HaXml configure script: January 2007
+# author: Malcolm.Wallace@cs.york.ac.uk, August 2002
+
+SOFTWARE="polyparse"
+VERSION="1.0"
+
+if [ -f obj/prefix ]
+then INSTALLDIR=`cat obj/prefix`
+else INSTALLDIR=
+fi
+
+# We need a working `echo' command: at least Solaris2.6 may not have it.
+CCC=${CC-gcc}
+case `echo -n hello | wc -c | ( read n ; echo $n )` in
+ 5) ;;
+ *) echo "The builtin 'echo' command doesn't do '-n' - emulating it."
+ $CCC -o script/echo script/echo.c
+ echo () { $PWD/script/echo "$@"; } ;;
+esac
+
+# We need a working `which' command: CYGWIN at least doesn't have it,
+# and some installed 'which's behave badly, e.g. Solaris, OSF/1.
+which () {
+ ( for path in `echo \"$PATH\" | sed -e 's/:/\" \"/g'`
+ do
+ thefile=`echo $path | tr -d "\""`/$1
+ if [ -f "$thefile" -a -x "$thefile" ]
+ then echo $thefile
+ exit 0
+ fi
+ done; exit 1 )
+}
+
+DARWIN=false
+CYGWIN=false
+MINGW=false
+SUNOS=false
+case `uname -s` in
+ CYGWIN*) CYGWIN=true;;
+ MINGW*) MINGW=true ;;
+ Darwin*) DARWIN=true ;;
+ SunOS*) SUNOS=true ;;
+esac
+
+# Process command-line arguments
+while [ "$1" != "" ]
+do
+ case $1 in
+ --buildwith=*) BUILDWITH=`echo "$1" | cut -c13-` ;;
+ --buildopts=*) BUILDOPTS=$BUILDOPTS" "`echo "$1" | cut -c13-` ;;
+ --prefix=*) INSTALLDIR=`echo "$1" | cut -c10-` ;;
+ --help|-h)
+ echo "`basename $0` options: [default in brackets]"
+ echo " --buildwith=(ghc|hugs|nhc98) Build $SOFTWARE for the given compiler [detected]"
+ echo " --buildopts=flags Give extra flags needed by your build compiler [none]"
+ echo " --prefix=dir Installed files go under dir [compiler-specific]"
+ exit 0 ;;
+ --version|-v) echo "$SOFTWARE: $VERSION"
+ exit 0 ;;
+ *) echo "`basename $0`: unrecognised option $1"
+ echo ' (use --help for option information)'
+ exit 1 ;;
+ esac
+ shift
+done
+
+echo "Looking for Haskell compilers:"
+# Assume that we start out with a blank config.
+HMAKEKNOWN=
+GHCKNOWN=
+NHCKNOWN=
+HUGSKNOWN=
+HMAKENUM=0
+GHCNUM=0
+NHCNUM=0
+HUGSNUM=0
+
+echo -n " Looking for hmake... "
+if which hmake >/dev/null 2>&1
+then
+ HMAKEKNOWN=`which hmake`
+ HMAKEVERSION=`${HMAKEKNOWN} --version | head -1 | cut -d' ' -f2`
+ HMAKENUM=`echo $HMAKEVERSION | tr "v." " " | ( read x y z; echo $x$y )`
+fi
+if [ "$HMAKEKNOWN" != "" ]
+then echo "found ${HMAKEVERSION}"
+else echo "(not found)"
+fi
+
+echo -n " Looking for ghc... "
+if which ghc >/dev/null 2>&1
+then
+ GHCKNOWN=`which ghc`
+ GHCVERSION=`${GHCKNOWN} --version 2>&1 | sed 's/^.*version[ ]*\([0-9.]*\).*/\1/'`
+ GHCNUM=`echo $GHCVERSION | tr "v." " " | ( read x y z; echo $x$y; )`
+ if [ "$GHCNUM" -lt "100" ]
+ then GHCNUM=${GHCNUM}0
+ fi
+fi
+if [ "$GHCKNOWN" = "" ]
+then echo "(not found)"
+else echo "found ${GHCVERSION}"
+ if [ "$GHCNUM" -lt "602" ]
+ then echo " Warning: $SOFTWARE needs ghc-6.2 or later. Ignoring ghc."
+ GHCKNOWN=
+ else GHCLIBDIR=`${GHCKNOWN} -v 2>&1 | grep ' package config file: ' | head -1 | sed 's/.* package config file: //'`
+ if $CYGWIN; then GHCLIBDIR=`cygpath -u $GHCLIBDIR`; fi
+ if $MINGW; then GHCLIBDIR=`echo $GHCLIBDIR | tr '\\\\' '/'`; fi
+ GHCLIBDIR=`dirname $GHCLIBDIR`
+ GHCINCDIR=$GHCLIBDIR/imports
+ fi
+fi
+
+# There may be another version of ghc to look for.
+if [ -n "$BUILDWITH" ]
+then
+if [ "`basename $BUILDWITH | cut -c1-3`" = "ghc" ]
+then
+ VER=`basename $BUILDWITH | cut -c5-`
+ if [ -n "$VER" -a "$VER" != "$GHCVERSION" ]
+ then
+ echo -n " Looking for $BUILDWITH... "
+ if which $BUILDWITH >/dev/null 2>&1
+ then
+ GHC2KNOWN=`which $BUILDWITH`
+ GHC2VERSION=`${GHC2KNOWN} --version 2>&1 | sed 's/^.*version[ ]*\([0-9.]*\).*/\1/'`
+ GHC2NUM=`echo $GHC2VERSION | tr "." " " | ( read x y z; echo $x$y; )`
+ if [ "$GHC2NUM" -lt "100" ]
+ then GHC2NUM=${GHC2NUM}0
+ fi
+ fi
+ if [ "$GHC2KNOWN" = "" ]
+ then echo "(not found)"
+ else echo "found ${GHC2VERSION}"
+ if [ "$GHC2NUM" -lt "602" ]
+ then echo " Warning: $SOFTWARE needs ghc-6.2 or later. Ignoring."
+ GHC2KNOWN=
+ else GHCKNOWN="$GHC2KNOWN"
+ GHCVERSION="$GHC2VERSION"
+ GHCNUM="$GHC2NUM"
+ GHCLIBDIR=`${GHCKNOWN} -v 2>&1 | grep ' package config file: ' | head -1 | sed 's/.* package config file: //'`
+ if $CYGWIN; then GHCLIBDIR=`cygpath -u $GHCLIBDIR`; fi
+ if $MINGW; then GHCLIBDIR=`echo $GHCLIBDIR | tr '\\\\' '/'`; fi
+ GHCLIBDIR=`dirname $GHCLIBDIR`
+ GHCINCDIR=$GHCLIBDIR/imports
+ fi
+ fi
+ fi
+fi
+fi
+
+echo -n " Looking for nhc98... "
+if which nhc98 >/dev/null 2>&1
+then
+ NHCKNOWN=`which nhc98`
+ NHCVERSION=`${NHCKNOWN} --version | head -1 | cut -d' ' -f2`
+ NHCNUM=`echo $NHCVERSION | tr "v." " " | ( read x y z; echo $x$y )`
+fi
+if [ "$NHCKNOWN" = "" ]
+then echo "(not found)"
+else echo "found ${NHCVERSION}"
+ if [ "$HMAKENUM" -lt "306" ]
+ then echo " Warning: building with nhc98 needs hmake-3.06 or later."
+ echo " Available from: http://www.haskell.org/hmake/"
+ fi
+ if [ "$NHCNUM" -lt "116" ]
+ then echo " Warning: $SOFTWARE needs nhc98-1.16 or later. Ignoring nhc98."
+ NHCKNOWN=
+ else NHCLIBDIR=`grep '^NHC98LIBDIR' $NHCKNOWN | cut -c27- | cut -d'}' -f1 | head -1`
+ NHCINCDIR=`grep '^NHC98INCDIR' $NHCKNOWN | cut -c27- | cut -d'}' -f1 | head -1`
+ fi
+fi
+
+month() {
+ read mon yr;
+ case $mon in
+ Jan*) echo 01;;
+ Feb*) echo 02;;
+ Mar*) echo 03;;
+ Apr*) echo 04;;
+ May) echo 05;;
+ Jun*) echo 06;;
+ Jul*) echo 07;;
+ Aug*) echo 08;;
+ Sep*) echo 09;;
+ Oct*) echo 10;;
+ Nov*) echo 11;;
+ Dec*) echo 12;;
+ *) echo 00;;
+ esac;
+}
+
+echo -n " Looking for hugs... "
+if which hugs >/dev/null 2>&1
+then
+ HUGSKNOWN=`which hugs`
+ HUGSVERSION=`echo :q | $HUGSKNOWN 2>/dev/null | grep Version | cut -c18-32`
+ HUGSNUM=`echo $HUGSVERSION | cut -d' ' -f2`
+ HUGSNUM=$HUGSNUM`echo $HUGSVERSION | month`
+fi
+if [ "$HUGSKNOWN" = "" ]
+then echo "(not found)"
+else echo "found ${HUGSVERSION}"
+ if [ "$HUGSNUM" -lt "200309" ]
+ then echo " Warning: $SOFTWARE configuration only supports Hugs >= Sept 2003."
+ HUGSKNOWN=
+ fi
+fi
+
+if [ ! -z "$BUILDWITH" ]
+then
+ echo " You want to build for only... $BUILDWITH"
+ if [ "`echo $BUILDWITH | cut -c1-3`" = "ghc" ]
+ then
+ if [ -z "$GHCKNOWN" ]
+ then echo ' *** Did not find ghc - cannot continue.'
+ exit 1
+ else NHCKNOWN=
+ HUGSKNOWN=
+ fi
+ else if [ "$BUILDWITH" = "nhc98" ]
+ then
+ if [ -z "$NHCKNOWN" ]
+ then echo ' *** Did not find nhc98 - cannot continue.'
+ exit 1
+ else GHCKNOWN=
+ HUGSKNOWN=
+ fi
+ else if [ "`echo $BUILDWITH | cut -c1-4`" = "hugs" ]
+ then
+ if [ -z "$HUGSKNOWN" ]
+ then echo ' *** Did not find hugs - cannot continue.'
+ exit 1
+ else GHCKNOWN=
+ NHCKNOWN=
+ fi
+ else echo ' *** I do not recognise this compiler:' $BUILDWITH
+ exit 1
+ fi;fi;fi;
+fi
+
+echo " Files ultimately install in:" # details generated below
+echo " (re-run ./configure --prefix=... if this wasn't your intention)"
+
+if [ "$INSTALLDIR" != "" ]
+then
+ GHCLIBDIR=$INSTALLDIR/$SOFTWARE-$VERSION/ghc-$GHCVERSION/lib
+ GHCINCDIR=$INSTALLDIR/$SOFTWARE-$VERSION/ghc-$GHCVERSION/imports
+fi
+
+# Prepare to build.
+if [ ! -d obj ]
+then mkdir obj
+fi
+if [ -f obj/compilers ]
+then rm obj/compilers
+fi
+if [ "$HUGSKNOWN" != "" ]
+then
+ echo hugs >>obj/compilers
+ if [ ! -d obj/hugs ]
+ then mkdir obj/hugs
+ fi
+ cp -Rp src/Makefile obj/hugs
+fi
+if [ "$GHCKNOWN" != "" ]
+then
+ echo ghc >>obj/compilers
+ if [ ! -d obj/ghc ]
+ then mkdir obj/ghc
+ fi
+ echo $GHCLIBDIR >obj/ghc/ghclibdir
+ echo $GHCINCDIR >obj/ghc/ghcincdir
+ echo " $GHCLIBDIR" # report location to tty
+ echo " $GHCINCDIR" # report location to tty
+ if $CYGWIN || $MINGW
+ then cygpath -w ${GHCLIBDIR} >obj/ghc/ghclibdirraw
+ cygpath -w ${GHCINCDIR}/ >obj/ghc/ghcincdirraw
+ else echo ${GHCLIBDIR} >obj/ghc/ghclibdirraw
+ echo ${GHCINCDIR}/ >obj/ghc/ghcincdirraw
+ fi
+ if ghc-pkg-$GHCVERSION -l >/dev/null
+ then echo ghc-pkg-$GHCVERSION >obj/ghc/ghcpkgcmd
+ else echo ghc-pkg >obj/ghc/ghcpkgcmd
+ fi
+ echo ${BUILDWITH-ghc} >obj/ghccmd
+ cp -Rp src/Text src/Makefile src/pkg.conf obj/ghc
+ if [ "$GHCNUM" -ge "504" ]
+ then echo "-package base" >obj/ghc/ghcpkgs
+ else echo "" >obj/ghc/ghcpkgs
+ fi
+fi
+if [ "$NHCKNOWN" != "" ]
+then
+ echo nhc98 >>obj/compilers
+ if [ ! -d obj/nhc98 ]
+ then mkdir obj/nhc98
+ fi
+ echo $NHCLIBDIR >obj/nhc98/nhc98libdir
+ echo $NHCINCDIR >obj/nhc98/nhc98incdir
+ echo " $NHCLIBDIR" # report location to tty
+ echo " $NHCINCDIR" # report location to tty
+ cp -Rp src/Text src/Makefile obj/nhc98
+ if [ "$NHCNUM" -ge "116" ]
+ then echo "-package base" >obj/nhc98/nhc98pkgs
+ else echo "" >obj/nhc98/nhc98pkgs
+ fi
+fi
+
+echo $INSTALLDIR >obj/prefix
+if $CYGWIN || $MINGW ; then echo .exe >obj/exe; else touch obj/exe; fi
+if $CYGWIN || $MINGW ; then echo main.exe >obj/out; else echo a.out >obj/out; fi
+if $DARWIN ; then echo "-all_load -x"; else echo --whole-archive; fi >obj/ldopt
+if $SUNOS ; then echo "-z allextract" >obj/ldopt; fi
+
+
+echo "Ready to build. Type 'make' then (as root) 'make install'."
+exit 0
diff --git a/docs/changelog.html b/docs/changelog.html
new file mode 100644
--- /dev/null
+++ b/docs/changelog.html
@@ -0,0 +1,56 @@
+
+
+
+
+ polyparse change log
+
+
+
+
+
+
+
polyparse change log
+
+
+
+
Changes in polyparse-1.0
+
+
+
Version number change from 1.00 to 1.0, for silly cabal/hackage.
+
Minor fix to parsing strings in Text.Parse.
+
+
+
Changes in polyparse-1.00
+
+
+
No changes, but released separately from HaXml
+
+
+
Changes in HaXml-1.16
+
+
+
New: lazier parsers
+
+
Text.XML.HaXml.ParseLazy
+
Text.XML.HaXml.Html.ParseLazy
+
Text.ParserCombinators.PolyLazy
+
Text.ParserCombinators.PolyStateLazy
+
+
+
+
Changes in HaXml-1.15
+
+
+
New: DrIFT has now been fully updated to
+ produce instances of Text.ParserCombinators.TextParser.Parse.
+
New: the parser combinator library Poly has been split into two
+ variations, Poly and PolyState. They have almost the same API,
+ only the latter includes a running state where the former does not.
+
The TextParser library (a replacement for the Haskell'98 Read class)
+ has also been improved with more new combinators. Really, these
+ parser combinator experiments do not belong in HaXml, and will
+ eventually be split out into a separate package.
+
The Parse class is a replacement for the standard Read class. It is a
+ specialisation of the (poly) Parser monad for String input.
+ There are instances defined for all Prelude types.
+ For user-defined types, you can write your own instance, or use
+ DrIFT to generate them automatically, e.g. {-! derive : Parse !-}
+
The class Parse is a replacement for Read, operating over String input.
+ Essentially, it permits better error messages for why something failed to
+ parse. It is rather important that parse can read back exactly what
+ is generated by the corresponding instance of show. To apply a parser
+ to some text, use runParser.
+
Parse one of a bunch of alternative constructors. In the list argument,
+ the first element of the pair is the constructor name, and
+ the second is the parser for the rest of the value. The first matching
+ parse is returned.
+
enumeration :: Show a => String -> [a] -> TextParser a
Parse one of the given nullary constructors (an enumeration).
+ The string argument is the name of the type, and the list argument
+ should contain all of the possible enumeration values.
+
All
+
+ A LIBRARY OF MONADIC PARSER COMBINATORS
+
+ 29th July 1996
+
+ Graham Hutton Erik Meijer
+ University of Nottingham University of Utrecht
Stability
Stable
Maintainer
Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
Description
This Haskell script defines a library of parser combinators, and is
+ taken from sections 1-6 of our article Monadic Parser Combinators.
+ Some changes to the library have been made in the move from Gofer
+ to Haskell:
+
Do notation is used in place of monad comprehension notation;
+
The parser datatype is defined using newtype, to avoid the overhead
+ of tagging and untagging parsers with the P constructor.
+
This library of monadic parser combinators is based on the ones
+ defined by Graham Hutton and Erik Meijer. It has been extended by
+ Malcolm Wallace to use an abstract token type (no longer just a
+ string) as input, and to incorporate a State Transformer monad, useful
+ for symbol tables, macros, and so on. Basic facilities for error
+ reporting have also been added, and later extended by Graham Klyne
+ to return the errors through an Either type, rather than just
+ calling error.
+
Synopsis
newtypeParser s t e a = P (s -> [Either e t] -> ParseResult s t e a)
The parser type is parametrised on the types of the state s,
+ the input tokens t, error-type e, and the result value a.
+ The state and remaining input are threaded through the monad.
+
Apply the parser to some real input, given an initial state value.
+ If the parser fails, raise error to halt the program.
+ (This is the original exported behaviour - to allow the caller to
+ deal with the error differently, see papply'.)
+
papply' :: Parser s t e a -> s -> [Either e t] -> Either e [(a, s, [Either e t])]
This is useful for recursively expanding macros. When the
+ user-parser recognises a macro use, it can lookup the macro
+ expansion from the parse state, lex it, and then stuff the
+ lexed expansion back down into the parser.
+
The Parser datatype is a fairly generic parsing monad with error
+ reporting. It can be used for arbitrary token types, not just
+ String input. (If you require a running state, use module PolyState
+ instead)
+
Commit is a way of raising the severity of any errors found within
+ its argument. Used in the middle of a parser definition, it means that
+ any operations prior to commitment fail softly, but after commitment,
+ they fail hard.
+
p onFail q means parse p unless p fails in which case parse q instead.
+ Can be chained together to give multiple attempts to parse something.
+ (Note that q could itself be a failing parser, e.g. to change the error
+ message from that defined in p to something different.)
+ However, a *severe* failure in p cannot be ignored.
+
Parse the first alternative that succeeds, but if none succeed,
+ report only the severe errors, and if none of those, then report
+ all the soft errors.
+
'manyFinally e t' parses a possibly-empty sequence of e's,
+ terminated by a t. Any parse failures could be due either to
+ a badly-formed terminator or a badly-formed element, so raise
+ both possible errors.
+
Push some tokens back onto the front of the input stream and reparse.
+ This is useful e.g. for recursively expanding macros. When the
+ user-parser recognises a macro use, it can lookup the macro
+ expansion from the parse state, lex it, and then stuff the
+ lexed expansion back down into the parser.
+
When applied, these parsers do not return explicit failure.
+ An exception is
+ raised instead. This allows partial results to be returned
+ before a full parse is complete.
+ One of the key ways to ensure that your parser is properly lazy,
+ is to parse the initial portion of text returning a function, then
+ use the apply combinator to build the final value.
+
The Parser datatype is a fairly generic parsing monad with error
+ reporting. It can be used for arbitrary token types, not just
+ String input. (If you require a running state, use module PolyStateLazy
+ instead.)
+
Apply a parser to an input token sequence. The parser cannot return
+ an error value explicitly, so errors raise an exception. Thus, results
+ can be partial (lazily constructed, but containing undefined).
+
Simple failure can be corrected, but when a simple fail is not strong
+ enough, use failBad for emphasis. It guarantees parsing will
+ terminate with an exception.
+
Commit is a way of raising the severity of any errors found within
+ its argument. Used in the middle of a parser definition, it means that
+ any operations prior to commitment fail softly, but after commitment,
+ they fail hard.
+
p onFail q means parse p unless p fails in which case parse q instead.
+ Can be chained together to give multiple attempts to parse something.
+ (Note that q could itself be a failing parser, e.g. to change the error
+ message from that defined in p to something different.)
+ However, a *severe* failure in p cannot be ignored.
+
Parse the first alternative that succeeds, but if none succeed,
+ report only the severe errors, and if none of those, then report
+ all the soft errors.
+
'manyFinally e t' parses a possibly-empty sequence of e's,
+ terminated by a t. Any parse failures could be due either to
+ a badly-formed terminator or a badly-formed element, so raise
+ both possible errors.
+
Push some tokens back onto the front of the input stream and reparse.
+ This is useful e.g. for recursively expanding macros. When the
+ user-parser recognises a macro use, it can lookup the macro
+ expansion from the parse state, lex it, and then stuff the
+ lexed expansion back down into the parser.
+
The Parser datatype is a fairly generic parsing monad with error
+ reporting and a running state. It can be used for arbitrary token
+ types, not just String input.
+
Commit is a way of raising the severity of any errors found within
+ its argument. Used in the middle of a parser definition, it means that
+ any operations prior to commitment fail softly, but after commitment,
+ they fail hard.
+
p onFail q means parse p unless p fails in which case parse q instead.
+ Can be chained together to give multiple attempts to parse something.
+ (Note that q could itself be a failing parser, e.g. to change the error
+ message from that defined in p to something different.)
+ However, a severe failure in p cannot be ignored.
+
Parse the first alternative that succeeds, but if none succeed,
+ report only the severe errors, and if none of those, then report
+ all the soft errors.
+
'manyFinally e t' parses a possibly-empty sequence of e's,
+ terminated by a t. Any parse failures could be due either to
+ a badly-formed terminator or a badly-formed element, so raise
+ both possible errors.
+
Push some tokens back onto the front of the input stream and reparse.
+ This is useful e.g. for recursively expanding macros. When the
+ user-parser recognises a macro use, it can lookup the macro
+ expansion from the parse state, lex it, and then stuff the
+ lexed expansion back down into the parser.
+
Parsers do not return explicit failure. An exception is raised
+ instead. This allows partial results to be returned before a
+ full parse is complete.
+
The Parser datatype is a fairly generic parsing monad with error
+ reporting and a running state. It can be used for arbitrary token
+ types, not just String input.
+
Apply a parser to an initial state and input token sequence.
+ The parser cannot return an error value explicitly, so errors
+ raise an exception. Thus, results can be partial (lazily constructed,
+ but containing undefined).
+
Simple failure can be corrected, but when a simple fail is not strong
+ enough, use failBad for emphasis. It guarantees parsing will terminate
+ with an exception.
+
Commit is a way of raising the severity of any errors found within
+ its argument. Used in the middle of a parser definition, it means that
+ any operations prior to commitment fail softly, but after commitment,
+ they fail hard.
+
p onFail q means parse p unless p fails in which case parse q instead.
+ Can be chained together to give multiple attempts to parse something.
+ (Note that q could itself be a failing parser, e.g. to change the error
+ message from that defined in p to something different.)
+ However, a *severe* failure in p cannot be ignored.
+
Parse the first alternative that succeeds, but if none succeed,
+ report only the severe errors, and if none of those, then report
+ all the soft errors.
+
'manyFinally e t' parses a possibly-empty sequence of e's,
+ terminated by a t. Any parse failures could be due either to
+ a badly-formed terminator or a badly-formed element, so raise
+ both possible errors.
+
Push some tokens back onto the front of the input stream and reparse.
+ This is useful e.g. for recursively expanding macros. When the
+ user-parser recognises a macro use, it can lookup the macro
+ expansion from the parse state, lex it, and then stuff the
+ lexed expansion back down into the parser.
+
diff --git a/docs/haddock/minus.gif b/docs/haddock/minus.gif
new file mode 100644
Binary files /dev/null and b/docs/haddock/minus.gif differ
diff --git a/docs/haddock/plus.gif b/docs/haddock/plus.gif
new file mode 100644
Binary files /dev/null and b/docs/haddock/plus.gif differ
diff --git a/docs/haddock/src/Text/Parse.html b/docs/haddock/src/Text/Parse.html
new file mode 100644
--- /dev/null
+++ b/docs/haddock/src/Text/Parse.html
@@ -0,0 +1,179 @@
+
module Text.Parse
+ ( -- * The Parse class is a replacement for the standard Read class.
+ -- $parser
+ TextParser -- synonym for Parser Char, i.e. string input, no state
+ , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a],
+ -- Int, Integer, Float, Double, Char, Bool
+ , parseByRead -- :: Read a => String -> TextParser a
+ -- ** Combinators specific to string input, lexed haskell-style
+ , word -- :: TextParser String
+ , isWord -- :: String -> TextParser ()
+ , optionalParens -- :: TextParser a -> TextParser a
+ , field -- :: Parse a => String -> TextParser a
+ , constructors-- :: [(String,TextParser a)] -> TextParser a
+ , enumeration -- :: Show a => String -> [a] -> TextParser a
+ -- ** Re-export all the more general combinators from Poly too
+ , module Text.ParserCombinators.Poly
+ ) where
+
+import Char (isSpace)
+import List (intersperse)
+import Text.ParserCombinators.Poly
+
+------------------------------------------------------------------------
+-- $parser
+-- The Parse class is a replacement for the standard Read class. It is a
+-- specialisation of the (poly) Parser monad for String input.
+-- There are instances defined for all Prelude types.
+-- For user-defined types, you can write your own instance, or use
+-- DrIFT to generate them automatically, e.g. {-! derive : Parse !-}
+
+-- | A synonym for Parser Char, i.e. string input (no state)
+type TextParser a = Parser Char a
+
+-- | The class @Parse@ is a replacement for @Read@, operating over String input.
+-- Essentially, it permits better error messages for why something failed to
+-- parse. It is rather important that @parse@ can read back exactly what
+-- is generated by the corresponding instance of @show@. To apply a parser
+-- to some text, use @runParser@.
+class Parse a where
+ parse :: TextParser a
+ parseList :: TextParser [a] -- only to distinguish [] and ""
+ parseList = do { isWord "[]"; return [] }
+ `onFail`
+ do { isWord "["; isWord "]"; return [] }
+ `onFail`
+ bracketSep (isWord "[") (isWord ",") (isWord "]") parse
+ `adjustErr` ("Expected a list, but\n"++)
+
+-- | If there already exists a Read instance for a type, then we can make
+-- a Parser for it, but with only poor error-reporting.
+parseByRead :: Read a => String -> TextParser a
+parseByRead name =
+ P (\s-> case reads s of
+ [] -> (Left (False,"no parse, expected a "++name), s)
+ [(a,s')] -> (Right a, s')
+ _ -> (Left (False,"ambiguous parse, expected a "++name), s)
+ )
+
+-- | One lexical chunk (Haskell-style lexing).
+word :: TextParser String
+word = P (\s-> case lex s of
+ [] -> (Left (False,"no input? (impossible)"), s)
+ [("",s')] -> (Left (False,"no input?"), s')
+ ((x,s'):_) -> (Right x, s') )
+
+-- | Ensure that the next input word is the given string. (Note the input
+-- is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
+isWord :: String -> TextParser String
+isWord w = do { w' <- word
+ ; if w'==w then return w else fail ("expected "++w++" got "++w')
+ }
+
+-- | Allow true string parens around an item.
+optionalParens :: TextParser a -> TextParser a
+optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p
+
+-- | Deal with named field syntax. The string argument is the field name,
+-- and the parser returns the value of the field.
+field :: Parse a => String -> TextParser a
+field name = do { isWord name; commit $ do { isWord "="; parse } }
+
+-- | Parse one of a bunch of alternative constructors. In the list argument,
+-- the first element of the pair is the constructor name, and
+-- the second is the parser for the rest of the value. The first matching
+-- parse is returned.
+constructors :: [(String,TextParser a)] -> TextParser a
+constructors cs = oneOf' (map cons cs)
+ where cons (name,p) =
+ ( name
+ , do { isWord name
+ ; p `adjustErrBad` (("got constructor, but within "
+ ++name++",\n")++)
+ }
+ )
+
+-- | Parse one of the given nullary constructors (an enumeration).
+-- The string argument is the name of the type, and the list argument
+-- should contain all of the possible enumeration values.
+enumeration :: (Show a) => String -> [a] -> TextParser a
+enumeration typ cs = oneOf (map (\c-> do { isWord (show c); return c }) cs)
+ `adjustErr`
+ (++("\n expected "++typ++" value ("++e++")"))
+ where e = concat (intersperse ", " (map show (init cs)))
+ ++ ", or " ++ show (last cs)
+
+------------------------------------------------------------------------
+-- Instances for all the Standard Prelude types.
+
+-- Basic types
+instance Parse Int where
+ parse = parseByRead "Int"
+instance Parse Integer where
+ parse = parseByRead "Integer"
+instance Parse Float where
+ parse = parseByRead "Float"
+instance Parse Double where
+ parse = parseByRead "Double"
+instance Parse Char where
+ parse = parseByRead "Char"
+ -- parseList = bracket (isWord "\"") (satisfy (=='"'))
+ -- (many (satisfy (/='"')))
+ -- not totally correct for strings...
+ parseList = do { w <- word; if head w == '"' then return (init (tail w))
+ else fail "not a string" }
+
+instance Parse Bool where
+ parse = enumeration "Bool" [False,True]
+
+instance Parse Ordering where
+ parse = enumeration "Ordering" [LT,EQ,GT]
+
+-- Structural types
+instance Parse () where
+ parse = P p
+ where p [] = (Left (False,"no input: expected a ()"), [])
+ p ('(':cs) = case dropWhile isSpace cs of
+ (')':s) -> (Right (), s)
+ _ -> (Left (False,"Expected ) after ("), cs)
+ p (c:cs) | isSpace c = p cs
+ | otherwise = ( Left (False,"Expected a (), got "++show c)
+ , (c:cs))
+
+instance (Parse a, Parse b) => Parse (a,b) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
+ ; return (x,y) }
+
+instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
+ ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
+ ; return (x,y,z) }
+
+instance Parse a => Parse (Maybe a) where
+ parse = do { isWord "Nothing"; return Nothing }
+ `onFail`
+ do { isWord "Just"
+ ; fmap Just $ optionalParens parse
+ `adjustErrBad` ("but within Just, "++)
+ }
+ `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
+
+instance (Parse a, Parse b) => Parse (Either a b) where
+ parse = constructors [ ("Left", do { fmap Left $ optionalParens parse } )
+ , ("Right", do { fmap Right $ optionalParens parse } )
+ ]
+
+instance Parse a => Parse [a] where
+ parse = parseList
+
+------------------------------------------------------------------------
+
-----------------------------------------------------------------------------
+-- |
+-- Module : Text.ParserCombinators.HuttonMeijer
+-- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
+-- Licence : BSD
+--
+-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability : Stable
+-- Portability : All
+--
+-- A LIBRARY OF MONADIC PARSER COMBINATORS
+--
+-- 29th July 1996
+--
+-- Graham Hutton Erik Meijer
+-- University of Nottingham University of Utrecht
+--
+-- This Haskell script defines a library of parser combinators, and is
+-- taken from sections 1-6 of our article "Monadic Parser Combinators".
+-- Some changes to the library have been made in the move from Gofer
+-- to Haskell:
+--
+-- * Do notation is used in place of monad comprehension notation;
+--
+-- * The parser datatype is defined using "newtype", to avoid the overhead
+-- of tagging and untagging parsers with the P constructor.
+-----------------------------------------------------------------------------
+
+
+module Text.ParserCombinators.HuttonMeijer
+ (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
+ sepby, sepby1, chainl,
+ chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
+ letter, alphanum, string, ident, nat, int, spaces, comment, junk,
+ skip, token, natural, integer, symbol, identifier) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+type Token = Char
+
+---------------------------------------------------------
+-- | The parser monad
+
+newtype Parser a = P ([Token] -> [(a,[Token])])
+
+instance Functor Parser where
+ -- map :: (a -> b) -> (Parser a -> Parser b)
+ fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
+
+instance Monad Parser where
+ -- return :: a -> Parser a
+ return v = P (\inp -> [(v,inp)])
+
+ -- >>= :: Parser a -> (a -> Parser b) -> Parser b
+ (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
+
+ -- fail :: String -> Parser a
+ fail _ = P (\_ -> [])
+
+instance MonadPlus Parser where
+ -- mzero :: Parser a
+ mzero = P (\_ -> [])
+
+ -- mplus :: Parser a -> Parser a -> Parser a
+ (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
+
+-- ------------------------------------------------------------
+-- * Other primitive parser combinators
+-- ------------------------------------------------------------
+
+item :: Parser Token
+item = P (\inp -> case inp of
+ [] -> []
+ (x:xs) -> [(x,xs)])
+
+first :: Parser a -> Parser a
+first (P p) = P (\inp -> case p inp of
+ [] -> []
+ (x:_) -> [x])
+
+papply :: Parser a -> [Token] -> [(a,[Token])]
+papply (P p) inp = p inp
+
+-- ------------------------------------------------------------
+-- * Derived combinators
+-- ------------------------------------------------------------
+
+(+++) :: Parser a -> Parser a -> Parser a
+p +++ q = first (p `mplus` q)
+
+sat :: (Token -> Bool) -> Parser Token
+sat p = do {x <- item; if p x then return x else mzero}
+
+--tok :: Token -> Parser Token
+--tok t = do {x <- item; if t==snd x then return t else mzero}
+
+many :: Parser a -> Parser [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+many1 :: Parser a -> Parser [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+sepby :: Parser a -> Parser b -> Parser [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+sepby1 :: Parser a -> Parser b -> Parser [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
+ +++ return x
+
+ops :: [(Parser a, b)] -> Parser b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: Parser a -> Parser b -> Parser c -> Parser b
+bracket open p close = do {open; x <- p; close; return x}
+
+-- ------------------------------------------------------------
+-- * Useful parsers
+-- ------------------------------------------------------------
+
+char :: Char -> Parser Char
+char x = sat (\y -> x == y)
+
+digit :: Parser Char
+digit = sat isDigit
+
+lower :: Parser Char
+lower = sat isLower
+
+upper :: Parser Char
+upper = sat isUpper
+
+letter :: Parser Char
+letter = sat isAlpha
+
+alphanum :: Parser Char
+alphanum = sat isAlphaNum +++ char '_'
+
+string :: String -> Parser String
+string "" = return ""
+string (x:xs) = do {char x; string xs; return (x:xs)}
+
+ident :: Parser String
+ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
+
+nat :: Parser Int
+nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
+ where
+ m `op` n = 10*m + n
+
+int :: Parser Int
+int = do {char '-'; n <- nat; return (-n)} +++ nat
+
+-- ------------------------------------------------------------
+-- * Lexical combinators
+-- ------------------------------------------------------------
+
+spaces :: Parser ()
+spaces = do {many1 (sat isSpace); return ()}
+
+comment :: Parser ()
+--comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
+--comment = do
+-- _ <- string "--"
+-- _ <- many (sat (\x -> x /= '\n'))
+-- return ()
+comment = do
+ bracket (string "/*") (many item) (string "*/")
+ return ()
+
+junk :: Parser ()
+junk = do {many (spaces +++ comment); return ()}
+
+skip :: Parser a -> Parser a
+skip p = do {junk; p}
+
+token :: Parser a -> Parser a
+token p = do {v <- p; junk; return v}
+
+-- ------------------------------------------------------------
+-- * Token parsers
+-- ------------------------------------------------------------
+
+natural :: Parser Int
+natural = token nat
+
+integer :: Parser Int
+integer = token int
+
+symbol :: String -> Parser String
+symbol xs = token (string xs)
+
+identifier :: [String] -> Parser String
+identifier ks = token (do {x <- ident;
+ if not (elem x ks) then return x
+ else return mzero})
+
+------------------------------------------------------------------------------
+
{-----------------------------------------------------------------------------
+
+ A LIBRARY OF MONADIC PARSER COMBINATORS
+
+ 29th July 1996
+
+ Graham Hutton Erik Meijer
+ University of Nottingham University of Utrecht
+
+This Haskell 1.3 script defines a library of parser combinators, and is taken
+from sections 1-6 of our article "Monadic Parser Combinators". Some changes
+to the library have been made in the move from Gofer to Haskell:
+
+ * Do notation is used in place of monad comprehension notation;
+
+ * The parser datatype is defined using "newtype", to avoid the overhead
+ of tagging and untagging parsers with the P constructor.
+
+------------------------------------------------------------------------------
+** Extended to allow a symbol table/state to be threaded through the monad.
+** Extended to allow a parameterised token type, rather than just strings.
+** Extended to allow error-reporting.
+
+(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
+(More extensions: 2004 gk-haskell@ninebynine.org)
+
+------------------------------------------------------------------------------}
+
+-- | This library of monadic parser combinators is based on the ones
+-- defined by Graham Hutton and Erik Meijer. It has been extended by
+-- Malcolm Wallace to use an abstract token type (no longer just a
+-- string) as input, and to incorporate a State Transformer monad, useful
+-- for symbol tables, macros, and so on. Basic facilities for error
+-- reporting have also been added, and later extended by Graham Klyne
+-- to return the errors through an @Either@ type, rather than just
+-- calling @error@.
+
+module Text.ParserCombinators.HuttonMeijerWallace
+ (
+ -- * The parser monad
+ Parser(..)
+ -- * Primitive parser combinators
+ , item, eof, papply, papply'
+ -- * Derived combinators
+ , (+++), {-sat,-} tok, nottok, many, many1
+ , sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket
+ , toEOF
+ -- * Error handling
+ , elserror
+ -- * State handling
+ , stupd, stquery, stget
+ -- * Re-parsing
+ , reparse
+ ) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+--- The parser monad ---------------------------------------------------------
+
+type ParseResult s t e a = Either e [(a,s,[Either e t])]
+
+newtype Parser s t e a = P ( s -> [Either e t] -> ParseResult s t e a )
+ -- ^ The parser type is parametrised on the types of the state @s@,
+ -- the input tokens @t@, error-type @e@, and the result value @a@.
+ -- The state and remaining input are threaded through the monad.
+
+instance Functor (Parser s t e) where
+ -- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)
+ fmap f (P p) = P (\st inp -> case p st inp of
+ Right res -> Right [(f v, s, out) | (v,s,out) <- res]
+ Left err -> Left err
+ )
+
+instance Monad (Parser s t e) where
+ -- return :: a -> Parser s t e a
+ return v = P (\st inp -> Right [(v,st,inp)])
+ -- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b
+ (P p) >>= f = P (\st inp -> case p st inp of
+ Right res -> foldr joinresults (Right [])
+ [ papply' (f v) s out | (v,s,out) <- res ]
+ Left err -> Left err
+ )
+ -- fail :: String -> Parser s t e a
+ fail err = P (\st inp -> Right [])
+ -- I know it's counterintuitive, but we want no-parse, not an error.
+
+instance MonadPlus (Parser s t e) where
+ -- mzero :: Parser s t e a
+ mzero = P (\st inp -> Right [])
+ -- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a
+ (P p) `mplus` (P q) = P (\st inp -> joinresults (p st inp) (q st inp))
+
+-- joinresults ensures that explicitly raised errors are dominant,
+-- provided no parse has yet been found. The commented out code is
+-- a slightly stricter specification of the real code.
+joinresults :: ParseResult s t e a -> ParseResult s t e a -> ParseResult s t e a
+{-
+joinresults (Left p) (Left q) = Left p
+joinresults (Left p) (Right _) = Left p
+joinresults (Right []) (Left q) = Left q
+joinresults (Right p) (Left q) = Right p
+joinresults (Right p) (Right q) = Right (p++q)
+-}
+joinresults (Left p) q = Left p
+joinresults (Right []) q = q
+joinresults (Right p) q = Right (p++ case q of Left _ -> []
+ Right r -> r)
+
+
+--- Primitive parser combinators ---------------------------------------------
+
+-- | Deliver the first remaining token.
+item :: Parser s t e t
+item = P (\st inp -> case inp of
+ [] -> Right []
+ (Left e:_) -> Left e
+ (Right x: xs) -> Right [(x,st,xs)]
+ )
+
+-- | Fail if end of input is not reached
+eof :: Show p => Parser s (p,t) String ()
+eof = P (\st inp -> case inp of
+ [] -> Right [((),st,[])]
+ (Left e:_) -> Left e
+ (Right (p,_):_) -> Left ("End of input expected at "
+ ++show p++"\n but found text")
+ )
+
+{-
+-- | Ensure the value delivered by the parser is evaluated to WHNF.
+force :: Parser s t e a -> Parser s t e a
+force (P p) = P (\st inp -> let Right xs = p st inp
+ h = head xs in
+ h `seq` Right (h: tail xs)
+ )
+-- [[[GK]]] ^^^^^^
+-- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
+-- In this case, I think that means that the first element of the list
+-- is fully evaluated.
+--
+-- NOTE: the original form of this function fails if there is no parse
+-- result for p st inp (head xs fails if xs is null), so the modified
+-- form can assume a Right value only.
+--
+-- Why is this needed?
+-- It's not exported, and the only use of this I see is commented out.
+---------------------------------------
+-}
+
+
+-- | Deliver the first parse result only, eliminating any backtracking.
+first :: Parser s t e a -> Parser s t e a
+first (P p) = P (\st inp -> case p st inp of
+ Right (x:xs) -> Right [x]
+ otherwise -> otherwise
+ )
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, raise 'error' to halt the program.
+-- (This is the original exported behaviour - to allow the caller to
+-- deal with the error differently, see @papply'@.)
+papply :: Parser s t String a -> s -> [Either String t]
+ -> [(a,s,[Either String t])]
+papply (P p) st inp = either error id (p st inp)
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, return a diagnostic message to the caller.
+papply' :: Parser s t e a -> s -> [Either e t]
+ -> Either e [(a,s,[Either e t])]
+papply' (P p) st inp = p st inp
+
+--- Derived combinators ------------------------------------------------------
+
+-- | A choice between parsers. Keep only the first success.
+(+++) :: Parser s t e a -> Parser s t e a -> Parser s t e a
+p +++ q = first (p `mplus` q)
+
+-- | Deliver the first token if it satisfies a predicate.
+sat :: (t -> Bool) -> Parser s (p,t) e t
+sat p = do {(_,x) <- item; if p x then return x else mzero}
+
+-- | Deliver the first token if it equals the argument.
+tok :: Eq t => t -> Parser s (p,t) e t
+tok t = do {(_,x) <- item; if x==t then return t else mzero}
+
+-- | Deliver the first token if it does not equal the argument.
+nottok :: Eq t => [t] -> Parser s (p,t) e t
+nottok ts = do {(_,x) <- item; if x `notElem` ts then return x
+ else mzero}
+
+-- | Deliver zero or more values of @a@.
+many :: Parser s t e a -> Parser s t e [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+-- | Deliver one or more values of @a@.
+many1 :: Parser s t e a -> Parser s t e [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+-- | Deliver zero or more values of @a@ separated by @b@'s.
+sepby :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+-- | Deliver one or more values of @a@ separated by @b@'s.
+sepby1 :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do { f <- op
+ ; y <- p `chainr1` op
+ ; return (f x y)
+ }
+ +++ return x
+
+ops :: [(Parser s t e a, b)] -> Parser s t e b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: (Show p,Show t) =>
+ Parser s (p,t) e a -> Parser s (p,t) e b ->
+ Parser s (p,t) e c -> Parser s (p,t) e b
+bracket open p close = do { open
+ ; x <- p
+ ; close -- `elserror` "improperly matched construct";
+ ; return x
+ }
+
+-- | Accept a complete parse of the input only, no partial parses.
+toEOF :: Show p =>
+ Parser s (p,t) String a -> Parser s (p,t) String a
+toEOF p = do { x <- p; eof; return x }
+
+
+--- Error handling -----------------------------------------------------------
+
+-- | Return an error using the supplied diagnostic string, and a token type
+-- which includes position information.
+parseerror :: (Show p,Show t) => String -> Parser s (p,t) String a
+parseerror err = P (\st inp ->
+ case inp of
+ [] -> Left "Parse error: unexpected EOF\n"
+ (Left e:_) -> Left ("Lexical error: "++e)
+ (Right (p,t):_) ->
+ Left ("Parse error: in "++show p++"\n "
+ ++err++"\n "++"Found "++show t)
+ )
+
+
+-- | If the parser fails, generate an error message.
+elserror :: (Show p,Show t) => Parser s (p,t) String a -> String
+ -> Parser s (p,t) String a
+p `elserror` s = p +++ parseerror s
+
+--- State handling -----------------------------------------------------------
+
+-- | Update the internal state.
+stupd :: (s->s) -> Parser s t e ()
+stupd f = P (\st inp-> {-let newst = f st in newst `seq`-}
+ Right [((), f st, inp)])
+
+-- | Query the internal state.
+stquery :: (s->a) -> Parser s t e a
+stquery f = P (\st inp-> Right [(f st, st, inp)])
+
+-- | Deliver the entire internal state.
+stget :: Parser s t e s
+stget = P (\st inp-> Right [(st, st, inp)])
+
+
+--- Push some tokens back onto the input stream and reparse ------------------
+
+-- | This is useful for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [Either e t] -> Parser s t e ()
+reparse ts = P (\st inp-> Right [((), st, ts++inp)])
+
+------------------------------------------------------------------------------
+
module Text.ParserCombinators.Poly
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
+ , failBad -- :: String -> Parser t a
+ , commit -- :: Parser t a -> Parser t a
+
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+ , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
+ , discard -- :: Parser t a -> Parser t b -> Parser t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
+ , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser t a -> Parser t a -> Parser t a
+ , oneOf -- :: Show t => [Parser t a] -> Parser t a
+ , oneOf' -- :: [(String,Parser t a)] -> Parser t a
+ , optional -- :: Parser t a -> Parser t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser t a -> Parser t [a]
+ , many1 -- :: Parser t a -> Parser t [a]
+ , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
+ -- -> Parser t a -> Parser t [a]
+ , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
+ -- -> Parser t a
+ , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ ) where
+
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser t a = P ([t] -> (EitherE String a, [t]))
+
+-- A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser t a -> [t] -> (Either String a, [t])
+runParser (P p) =
+ (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
+ . p
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> (Right (f x), ts'))
+instance Monad (Parser t) where
+ return x = P (\ts-> (Right x, ts))
+ (P f) >>= g = P (\ts-> case f ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> let (P g') = g x in g' ts')
+ fail e = P (\ts-> (Left (False,e), ts))
+
+-- | When a simple fail is not strong enough, use failBad for emphasis.
+-- An emphasised (severe) error can propagate out through choice operators.
+failBad :: String -> Parser t a
+failBad msg = P (\ts-> (Left (True,msg), ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser t a -> Parser t a
+commit (P p) = P (\ts-> case p ts of
+ (Left (_,e), ts') -> (Left (True,e), ts')
+ right -> right )
+
+
+-- Combinators
+
+-- | One token
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> (Left (False,"Ran out of input (EOF)"), [])
+ (t:ts') -> (Right t, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser t (a->b) -> Parser t a -> Parser t b
+pf `apply` px = do { f <- pf; x <- px; return (f x) }
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser t a -> Parser t b -> Parser t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser t a -> (String->String) -> Parser t a
+(P p) `adjustErr` f = P (\ts-> case p ts of
+ (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser t a -> (String->String) -> Parser t a
+p `adjustErrBad` f = commit (p `adjustErr` f)
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser t a -> Parser t a -> Parser t a
+(P p) `onFail` (P q) = P (\ts-> case p ts of
+ r@(Left (True,_), _) -> r
+ (Left _, _) -> q ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser t a] -> Parser t a
+oneOf [] = do { n <- next
+ ; fail ("failed to parse any of the possible choices")
+ }
+--oneOf :: Show t => [Parser t a] -> Parser t a
+--oneOf [] = do { n <- next
+-- ; fail ("failed to parse any of the possible choices"
+-- ++"\n next token is "++show n)
+-- }
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser t a)] -> Parser t a
+oneOf' = accum []
+ where accum errs [] =
+ case filter isBad errs of
+ [] -> fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ [(_,(_,e))] -> failBad e
+ es -> failBad ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ (Left err,_) -> let (P p) = accum ((e,err):errs) ps
+ in p ts
+ right -> right )
+ showErr (name,(_,err)) = name++":\n"++indent 2 err
+ isBad (_,(b,_)) = b
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser t a -> Parser t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser t a -> Parser t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser t a -> Parser t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
+ -> Parser t a -> Parser t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser t a -> Parser t z -> Parser t [a]
+manyFinally p t =
+ do { xs <- many p
+ ; oneOf' [ ("sequence terminator", do { t; return () } )
+ , ("item in a sequence", do { p; return () } )
+ ]
+ ; return xs
+ }
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> (Right (), ts++inp))
+
+------------------------------------------------------------------------
+
module Text.ParserCombinators.PolyLazy
+ ( -- * The Parser datatype.
+ -- $parser
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser t a -> [t] -> (a, [t])
+ , failBad -- :: String -> Parser t a
+ , commit -- :: Parser t a -> Parser t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+ , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
+ , discard -- :: Parser t a -> Parser t b -> Parser t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
+ , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser t a -> Parser t a -> Parser t a
+ , oneOf -- :: Show t => [Parser t a] -> Parser t a
+ , oneOf' -- :: [(String,Parser t a)] -> Parser t a
+ , optional -- :: Parser t a -> Parser t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser t a -> Parser t [a]
+ , many1 -- :: Parser t a -> Parser t [a]
+ , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
+ -- -> Parser t a -> Parser t [a]
+ , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
+ -- -> Parser t a
+ , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ ) where
+
+#if__GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+-- $parser
+-- When applied, these parsers do not return explicit failure.
+-- An exception is
+-- raised instead. This allows partial results to be returned
+-- before a full parse is complete.
+-- One of the key ways to ensure that your parser is properly lazy,
+-- is to parse the initial portion of text returning a function, then
+-- use the @apply@ combinator to build the final value.
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyStateLazy
+-- instead.)
+newtype Parser t a = P ([t] -> (Either String a, [t]))
+
+-- A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+-- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!!
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an input token sequence. The parser cannot return
+-- an error value explicitly, so errors raise an exception. Thus, results
+-- can be partial (lazily constructed, but containing undefined).
+runParser :: Parser t a -> [t] -> (a, [t])
+runParser (P p) =
+ (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) )
+ . p
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> (Right (f x), ts'))
+instance Monad (Parser t) where
+ return x = P (\ts-> (Right x, ts))
+ (P f) >>= g = P (\ts-> case f ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> let (P g') = g x in g' ts')
+ fail e = P (\ts-> (Left e, ts))
+
+-- | Simple failure can be corrected, but when a simple fail is not strong
+-- enough, use failBad for emphasis. It guarantees parsing will
+-- terminate with an exception.
+
+failBad :: String -> Parser t a
+failBad msg = P (\ts-> (throwE msg, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser t a -> Parser t a
+commit (P p) = P (\ts-> case p ts of
+ (Left e, ts') -> (throwE e, ts')
+ right -> right )
+
+
+-- Combinators
+
+-- | One token
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> (Left "Ran out of input (EOF)", [])
+ (t:ts') -> (Right t, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser t (a->b) -> Parser t a -> Parser t b
+--pf `apply` px = do { f <- pf; x <- px; return (f x) }
+-- Needs to be lazier! Must not force the argument value too early.
+(P pf) `apply` (P px) = P (\ts->
+ case pf ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right f, ts') -> let (x',ts'') = px ts'
+ x = case x' of { Right x -> x; Left e -> throwE e }
+ in (Right (f x), ts'') )
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser t a -> Parser t b -> Parser t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser t a -> (String->String) -> Parser t a
+(P p) `adjustErr` f = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left (f msg), ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser t a -> (String->String) -> Parser t a
+p `adjustErrBad` f = commit (p `adjustErr` f)
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser t a -> Parser t a -> Parser t a
+(P p) `onFail` (P q) = P (\ts-> case p ts of
+ (Left _, _) -> q ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser t a] -> Parser t a
+oneOf [] = do { n <- next
+ ; fail ("failed to parse any of the possible choices")
+ }
+--oneOf :: Show t => [Parser t a] -> Parser t a
+--oneOf [] = do { n <- next
+-- ; fail ("failed to parse any of the possible choices"
+-- ++"\n next token is "++show n)
+-- }
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser t a)] -> Parser t a
+oneOf' ps = accum [] ps
+ where accum errs [] =
+ case errs of
+ [] -> failBad ("internal failure in parser (oneOf'):\n"
+ ++indent 2 (show (map fst ps)))
+ [(_,e)] -> fail e
+ es -> fail ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ (Left err,_) -> let (P p) = accum ((e,err):errs) ps
+ in p ts
+ right -> right )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser t a -> Parser t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser t a -> Parser t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser t a -> Parser t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
+ -> Parser t a -> Parser t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser t a -> Parser t z -> Parser t [a]
+manyFinally pp@(P p) pt@(P t) = P (\ts ->
+ case p ts of
+ (Left e, _) ->
+ case t ts of
+ (Right _, ts') -> (Right [], ts')
+ (Left e, ts') -> (Left e, ts')
+ (Right x, ts') ->
+ let (tail,ts'') = runParser (manyFinally pp pt) ts'
+ in (Right (x:tail), ts'') )
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> (Right (), ts++inp))
+
+------------------------------------------------------------------------
+
module Text.ParserCombinators.PolyState
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+ , failBad -- :: String -> Parser s t a
+ , commit -- :: Parser s t a -> Parser s t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
+ , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
+ , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
+ , oneOf -- :: [Parser s t a] -> Parser s t a
+ , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
+ -- ** Sequences
+ , many -- :: Parser s t a -> Parser s t [a]
+ , many1 -- :: Parser s t a -> Parser s t [a]
+ , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -- -> Parser s t a -> Parser s t [a]
+ , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
+ -- -> Parser s t a
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ ) where
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting and a running state. It can be used for arbitrary token
+-- types, not just String input.
+newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t]))
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an initial state and input token sequence.
+runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+runParser (P p) s =
+ (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m
+ ,s,ts))
+ . p s
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> (Right (f x), s', ts'))
+instance Monad (Parser s t) where
+ return x = P (\s ts-> (Right x, s, ts))
+ (P f) >>= g = P (\s ts-> case f s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> let (P g') = g x
+ in g' s' ts')
+ fail msg = P (\s ts-> (Left (False,msg), s, ts))
+
+-- | When a simple fail is not strong enough, use failBad for emphasis.
+-- An emphasised (severe) error can propagate out through choice operators.
+failBad :: String -> Parser s t a
+failBad msg = P (\s ts-> (Left (True,msg), s, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser s t a -> Parser s t a
+commit (P p) = P (\s ts-> case p s ts of
+ (Left (_,e), s', ts') -> (Left (True,e), s', ts')
+ right -> right )
+
+-- Combinators
+
+-- | One token
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> (Left (False,"Ran out of input (EOF)"), s, [])
+ (t:ts') -> (Right t, s, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser s t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
+pf `apply` px = do { f <- pf; x <- px; return (f x) }
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser s t a -> Parser s t b -> Parser s t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser s t a -> (String->String) -> Parser s t a
+(P p) `adjustErr` f =
+ P (\s ts-> case p s ts of
+ (Left (b,msg), s', ts') -> (Left (b,(f msg)), s, ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
+-- p `adjustErrBad` f = commit (p `adjustErr` f)
+(P p) `adjustErrBad` f =
+ P (\s ts-> case p s ts of
+ (Left (_,msg), s', ts') -> (Left (True,(f msg)), s, ts')
+ right -> right )
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a severe failure in p cannot be ignored.
+onFail :: Parser s t a -> Parser s t a -> Parser s t a
+(P p) `onFail` (P q) = P (\s ts-> case p s ts of
+ r@(Left (True,_), _, _) -> r
+ (Left _, _, _) -> q s ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser s t a] -> Parser s t a
+oneOf [] = fail ("Failed to parse any of the possible choices")
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser s t a)] -> Parser s t a
+oneOf' = accum []
+ where accum errs [] =
+ case filter isBad errs of
+ [] -> fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ [(_,(_,e))] -> failBad e
+ es -> failBad ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\u ts-> case p u ts of
+ (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
+ in p u ts
+ right -> right )
+ showErr (name,(_,err)) = name++":\n"++indent 2 err
+ isBad (_,(b,_)) = b
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser s t a -> Parser s t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser s t a -> Parser s t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -> Parser s t a -> Parser s t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+manyFinally p t =
+ do { xs <- many p
+ ; oneOf' [ ("sequence terminator", do { t; return () } )
+ , ("item in a sequence", do { p; return () } )
+ ]
+ ; return xs
+ }
+
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> (Right (), f s, ts))
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> (Right (f s), s, ts))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> (Right s, s, ts))
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> (Right (), s, ts++inp))
+
+------------------------------------------------------------------------
+
module Text.ParserCombinators.PolyStateLazy
+ ( -- * The Parser datatype.
+ -- $parser
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t])
+ , failBad -- :: String -> Parser s t a
+ , commit -- :: Parser s t a -> Parser s t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
+ , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
+ , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
+ , oneOf -- :: [Parser s t a] -> Parser s t a
+ , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
+ , optional -- :: Parser s t a -> Parser s t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser s t a -> Parser s t [a]
+ , many1 -- :: Parser s t a -> Parser s t [a]
+ , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -- -> Parser s t a -> Parser s t [a]
+ , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
+ -- -> Parser s t a
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ ) where
+
+#if__GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+-- $parser
+-- Parsers do not return explicit failure. An exception is raised
+-- instead. This allows partial results to be returned before a
+-- full parse is complete.
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting and a running state. It can be used for arbitrary token
+-- types, not just String input.
+newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t]))
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+-- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an initial state and input token sequence.
+-- The parser cannot return an error value explicitly, so errors
+-- raise an exception. Thus, results can be partial (lazily constructed,
+-- but containing undefined).
+runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
+runParser (P p) s =
+ (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts))
+ . p s
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> (Right (f x), s', ts'))
+instance Monad (Parser s t) where
+ return x = P (\s ts-> (Right x, s, ts))
+ (P f) >>= g = P (\s ts-> case f s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> let (P g') = g x
+ in g' s' ts')
+ fail msg = P (\s ts-> (Left msg, s, ts))
+
+-- | Simple failure can be corrected, but when a simple fail is not strong
+-- enough, use failBad for emphasis. It guarantees parsing will terminate
+-- with an exception.
+failBad :: String -> Parser s t a
+failBad msg = P (\s ts-> (throwE msg, s, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser s t a -> Parser s t a
+commit (P p) = P (\s ts-> case p s ts of
+ (Left e, s', ts') -> (throwE e, s', ts')
+ right -> right )
+
+-- Combinators
+
+-- | One token
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> (Left "Ran out of input (EOF)", s, [])
+ (t:ts') -> (Right t, s, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser s t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
+--pf `apply` px = do { f <- pf; x <- px; return (f x) }
+-- Needs to be lazier! Must not force the argument value too early.
+(P pf) `apply` (P px) = P (\s ts->
+ case pf s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right f, s', ts') -> let (x',s'',ts'') = px s' ts'
+ x = case x' of
+ Right x -> x
+ Left e -> throwE e
+ in (Right (f x), s'', ts''))
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser s t a -> Parser s t b -> Parser s t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser s t a -> (String->String) -> Parser s t a
+(P p) `adjustErr` f =
+ P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left (f msg), s, ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
+-- p `adjustErrBad` f = commit (p `adjustErr` f)
+(P p) `adjustErrBad` f =
+ P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (throwE (f msg), s, ts')
+ right -> right )
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser s t a -> Parser s t a -> Parser s t a
+(P p) `onFail` (P q) = P (\s ts-> case p s ts of
+ (Left _, _, _) -> q s ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser s t a] -> Parser s t a
+oneOf [] = fail ("Failed to parse any of the possible choices")
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser s t a)] -> Parser s t a
+oneOf' ps = accum [] ps
+ where accum errs [] =
+ case errs of
+ [] -> failBad ("internal failure in parser (oneOf'):\n"
+ ++indent 2 (show (map fst ps)))
+ [(_,e)] -> fail e
+ es -> fail ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\u ts-> case p u ts of
+ (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
+ in p u ts
+ right -> right )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser s t a -> Parser s t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser s t a -> Parser s t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser s t a -> Parser s t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -> Parser s t a -> Parser s t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+manyFinally pp@(P p) pt@(P t) = P (\s ts ->
+ case p s ts of
+ (Left e, _, _) ->
+ case t s ts of
+ (Right _, s', ts') -> (Right [], s', ts')
+ (Left e, s', ts') -> (Left e, s', ts')
+ (Right x, s', ts') ->
+ let (tail,s'',ts'') = runParser (manyFinally pp pt) s' ts'
+ in (Right (x:tail), s'', ts'') )
+
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> (Right (), f s, ts))
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> (Right (f s), s, ts))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> (Right s, s, ts))
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> (Right (), s, ts++inp))
+
+------------------------------------------------------------------------
+
+polyparse is a collection of parser combinator libraries in
+Haskell. It is distributed as a package, but you are likely to use only
+one of the included modules at any one time - they are generally
+alternatives to each other, as well as an alternative to other
+widely-used parser libraries available elsewhere.
+
+
+
Text.ParserCombinators.HuttonMeijer The most venerable of all
+ monadic parser combinator libraries, this version dates from 1996.
+ Originally distributed with Gofer, then Hugs, as ParseLib. It uses
+ the idea of "failure as a list of successes" to give multiple
+ possible parses through backtracking. (But in practice, almost
+ nobody wants any parse except the first complete one.)
+
Text.ParserCombinators.HuttonMeijerWallace The
+ Hutton/Meijer combinators, extended to take an arbitrary token type
+ as input (not just characters), plus a running state (e.g. to
+ collect a symbol table, or macros), plus some facilities for
+ simple error-reporting.
+
Text.ParserCombinators.Poly
+ The name Poly comes from the arbitrary token type. Thus, you can
+ write your own lexer if you wish, rather than needing to encode
+ lexical analysis within the parser itself. This is a fresh
+ set of combinators, improving on the HuttonMeijer variety by
+ keeping only a single success, not a list of them. This is
+ more space-efficient, whilst still permitting backtracking.
+ Error-handling is also much improved: there are essentially two
+ kinds of failure, soft and hard. Soft failure just means that the
+ current parse did not work out, but another parse might be OK.
+ Hard failure means that no parse will succeed, because we have
+ already passed a point of commitment. Thus you can give far more
+ accurate error messages to the user, including multi-layered
+ locations.
+
Text.ParserCombinators.PolyState is just like Poly, except it
+ adds an arbitrary running state parameter.
+
Text.ParserCombinators.PolyLazy is just like Poly, except it
+ does not return explicit failures. Instead, an exception is raised.
+ Thus, it can return a partial parse result, before a full parse is
+ complete. The word partial indicates that, having committed to
+ return some outer data constructor, we might later discover some
+ parse error further inside, so the value will be partial, as in
+ incomplete: containing bottom. However, if you are confident that
+ the input is error-free, then you will gain hugely in
+ space-efficiency - essentially you can stream-process your parsed
+ data-structure within very small constant space. This is especially
+ useful for large structures like e.g. XML trees.
+
Text.ParserCombinators.PolyStateLazy combines PolyState and
+ PolyLazy.
+
Text.Parse The Text.Read class from Haskell'98 is widely
+ recognised to have many problems. It is inefficient. If a read
+ fails, there is no indication of why. Worst of all, a read failure
+ crashes your whole program! Text.Parse is a proposed replacement
+ for the Read class. It defines a new class, Parse, with methods
+ that return an explicit notification of errors, through the Either
+ type. It also defines a number of useful helper functions to
+ enable the construction of parsers for textual representations of
+ Haskell data structures, e.g. named fields. Unsurprisingly,
+ Text.Parse is really just a specialisation of the Poly combinators
+ for String input, and the entire Poly API is also re-exported.
+ The DrIFT
+ tool can derive instances of the Parse class for you
+ automatically. (Use the syntax {-! derive : Parse !-})
+
+
+All the Poly* variations share the same basic API, so it is easy
+to switch from one set to another, when you discover you need an extra
+facility, just by changing a single import.
+
+
+In general, you can just add an import of the relevant module to your
+source code, and everything should just compile OK. However, if the
+package is not 'exposed' (in ghc-pkg terminology), then you might need
+to use a command-line option --package polyparse at compile
+time.
+
+
+I wrote some motivation for Text.Parse (including simple examples)
+on my blog a while back. Here is the posting.
+
+
+User-contributed documentation for polyparse is on the Haskell wiki at:
+http://haskell.org/haskellwiki/Polyparse
+Please edit the wiki if you discover any nice tricks!
+
+
+Known problems:
+
+
No problems currently known.
+
Report bugs to Malcolm.Wallace@cs.york.ac.uk
+
Even better, fix any bugs you find, and then darcs send a patch.
+
+To install polyparse, you must have a Haskell compiler: ghc-6.2
+or later, and/or nhc98-1.16/hmake-3.06 or later, and/or
+Hugs98 (Sept 2003) or later. For more recent compilers,
+use the standard Cabal method of installation:
+
+ sh configure [--prefix=...] [--buildwith=...]
+ make
+ make install
+
+to configure, build, and install polyparse as a package for your
+compiler(s). If you don't use the --prefix option, you may need write
+permission on the library installation directories of your compiler(s).
+Afterwards, to gain access to the polyparse libraries, you only need to
+add the option -package polyparse to your compiler commandline
+(no option required for Hugs).
+
+
+
+Version 1.00 is the first release of polyparse as a separate package.
+It was previously part of the HaXml suite. HaXml continues to use
+polyparse, but polyparse will be useful more widely. If you are looking
+for examples of the usage of polyparse, the implementations of
+Text.XML.HaXml.Parse and Text.XML.HaXml.XmlContent are two good places
+to look.
+
+
+Complete Changelog
+
+
+We are interested in hearing your feedback on these parser combinators -
+suggestions for improvements, comments, criticisms, bug reports. Please mail
+
Licence: The library is Free and Open Source Software,
+i.e., the bits we wrote are copyright to us, but freely licensed
+for your use, modification, and re-distribution, provided you don't
+restrict anyone else's use of it. The polyparse library is distributed
+under the GNU Lesser General Public Licence (LGPL) - see file
+LICENCE-LGPL for more details. We allow one
+special exception to the LGPL - see COPYRIGHT.
+(If you don't like any of these licensing conditions, please contact us
+to discuss your requirements.)
+
+
+Parser combinators have a long history in Haskell. The first(?) monadic
+combinator tutorial was introduced by Hutton and Meijer in 1994, and the
+accompanying library was distributed with Gofer (a precursor to Hugs),
+and known simply as ParseLib. That library lives on here as
+Text.ParserCombinators.HuttonMeijer.
+
+
Niklas Rojemo's combinators.
+The parser combinators developed and used in the implementation of the
+nhc98 compiler are monadic and space-efficient. However, they do not
+use the standard do-notation, because in fact they are more general than
+the standard monad category.
+
+
Daan Leijen's parsec.
+The parsec library is widely used, since it is distributed with ghc.
+Its combinators are fairly robust, but you need to place explicit
+backtracking into your parsers, using the try operator. This
+can be tricky.
+
+
Koen Claessen's ReadP.
+This is a different proposed replacement for the standard Haskell'98
+Read class. It is a whole lot more efficient that Read, but because it
+is also API-compatible with Read, that unfortunately means it suffers
+from not giving good error messages. Also, it requires rank-2 types,
+which is a non-Haskell'98 extension.
+
+
+
+
+
+
+
diff --git a/polyparse.cabal b/polyparse.cabal
new file mode 100644
--- /dev/null
+++ b/polyparse.cabal
@@ -0,0 +1,29 @@
+name: polyparse
+version: 1.0
+ghc-options: -DVERSION="1.0"
+cc-options: -DVERSION="1.0"
+license: LGPL
+license-file: COPYRIGHT
+author: Malcolm Wallace
+maintainer: author
+homepage: http://www.cs.york.ac.uk/fp/polyparse/
+category: Text, Parsing
+synopsis: A variety of alternative parser combinator libraries.
+description:
+ A variety of alternative parser combinator libraries, including
+ the original HuttonMeijer set. The Poly sets have features like
+ good error reporting, arbitrary token type, running state, lazy
+ parsing, and so on. Finally, Text.Parse is a proposed
+ replacement for the standard Read class, for better
+ deserialisation of Haskell values from Strings.
+exposed-modules:
+ Text.ParserCombinators.HuttonMeijer,
+ Text.ParserCombinators.HuttonMeijerWallace,
+ Text.ParserCombinators.Poly,
+ Text.ParserCombinators.PolyState,
+ Text.ParserCombinators.PolyLazy,
+ Text.ParserCombinators.PolyStateLazy,
+ Text.Parse
+hs-source-dirs: src
+build-depends: base, haskell98
+extensions: CPP
diff --git a/script/echo.c b/script/echo.c
new file mode 100644
--- /dev/null
+++ b/script/echo.c
@@ -0,0 +1,20 @@
+#include
+
+int main (int argc, char** argv) {
+ int i=0;
+ if (argc>1) {
+ if (strcmp(argv[1],"-n")==0) {
+ for (i=2; i>$@
+ echo "library-dirs: `cat ghclibdirraw`" >>$@
+ echo "depends: base, haskell98" >>$@
+ echo "hs-libraries: HS$(SOFTWARE)" >>$@
+
+
+
+# packaged library
+libHS$(SOFTWARE).a: $(LIBSRCS)
+ $(COMPILE) $(LIBSRCS)
+ ar r libHS$(SOFTWARE).a $(LIBOBJS)
+ -ld -r $(WHOLEARCHIVE) -o $(SOFTWARE).o libHS$(SOFTWARE).a # for GHCi only
+ tar cf interfaces.tar `find Text -name *.hi -print`
+
+$(INSTALLDIR):
+ if [ ! -d $(INSTALLDIR) ] ; then mkdir -p $(INSTALLDIR); fi
+
diff --git a/src/Text/Parse.hs b/src/Text/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Parse.hs
@@ -0,0 +1,178 @@
+module Text.Parse
+ ( -- * The Parse class is a replacement for the standard Read class.
+ -- $parser
+ TextParser -- synonym for Parser Char, i.e. string input, no state
+ , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a],
+ -- Int, Integer, Float, Double, Char, Bool
+ , parseByRead -- :: Read a => String -> TextParser a
+ -- ** Combinators specific to string input, lexed haskell-style
+ , word -- :: TextParser String
+ , isWord -- :: String -> TextParser ()
+ , optionalParens -- :: TextParser a -> TextParser a
+ , field -- :: Parse a => String -> TextParser a
+ , constructors-- :: [(String,TextParser a)] -> TextParser a
+ , enumeration -- :: Show a => String -> [a] -> TextParser a
+ -- ** Re-export all the more general combinators from Poly too
+ , module Text.ParserCombinators.Poly
+ ) where
+
+import Char (isSpace)
+import List (intersperse)
+import Text.ParserCombinators.Poly
+
+------------------------------------------------------------------------
+-- $parser
+-- The Parse class is a replacement for the standard Read class. It is a
+-- specialisation of the (poly) Parser monad for String input.
+-- There are instances defined for all Prelude types.
+-- For user-defined types, you can write your own instance, or use
+-- DrIFT to generate them automatically, e.g. {-! derive : Parse !-}
+
+-- | A synonym for Parser Char, i.e. string input (no state)
+type TextParser a = Parser Char a
+
+-- | The class @Parse@ is a replacement for @Read@, operating over String input.
+-- Essentially, it permits better error messages for why something failed to
+-- parse. It is rather important that @parse@ can read back exactly what
+-- is generated by the corresponding instance of @show@. To apply a parser
+-- to some text, use @runParser@.
+class Parse a where
+ parse :: TextParser a
+ parseList :: TextParser [a] -- only to distinguish [] and ""
+ parseList = do { isWord "[]"; return [] }
+ `onFail`
+ do { isWord "["; isWord "]"; return [] }
+ `onFail`
+ bracketSep (isWord "[") (isWord ",") (isWord "]") parse
+ `adjustErr` ("Expected a list, but\n"++)
+
+-- | If there already exists a Read instance for a type, then we can make
+-- a Parser for it, but with only poor error-reporting.
+parseByRead :: Read a => String -> TextParser a
+parseByRead name =
+ P (\s-> case reads s of
+ [] -> (Left (False,"no parse, expected a "++name), s)
+ [(a,s')] -> (Right a, s')
+ _ -> (Left (False,"ambiguous parse, expected a "++name), s)
+ )
+
+-- | One lexical chunk (Haskell-style lexing).
+word :: TextParser String
+word = P (\s-> case lex s of
+ [] -> (Left (False,"no input? (impossible)"), s)
+ [("",s')] -> (Left (False,"no input?"), s')
+ ((x,s'):_) -> (Right x, s') )
+
+-- | Ensure that the next input word is the given string. (Note the input
+-- is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
+isWord :: String -> TextParser String
+isWord w = do { w' <- word
+ ; if w'==w then return w else fail ("expected "++w++" got "++w')
+ }
+
+-- | Allow true string parens around an item.
+optionalParens :: TextParser a -> TextParser a
+optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p
+
+-- | Deal with named field syntax. The string argument is the field name,
+-- and the parser returns the value of the field.
+field :: Parse a => String -> TextParser a
+field name = do { isWord name; commit $ do { isWord "="; parse } }
+
+-- | Parse one of a bunch of alternative constructors. In the list argument,
+-- the first element of the pair is the constructor name, and
+-- the second is the parser for the rest of the value. The first matching
+-- parse is returned.
+constructors :: [(String,TextParser a)] -> TextParser a
+constructors cs = oneOf' (map cons cs)
+ where cons (name,p) =
+ ( name
+ , do { isWord name
+ ; p `adjustErrBad` (("got constructor, but within "
+ ++name++",\n")++)
+ }
+ )
+
+-- | Parse one of the given nullary constructors (an enumeration).
+-- The string argument is the name of the type, and the list argument
+-- should contain all of the possible enumeration values.
+enumeration :: (Show a) => String -> [a] -> TextParser a
+enumeration typ cs = oneOf (map (\c-> do { isWord (show c); return c }) cs)
+ `adjustErr`
+ (++("\n expected "++typ++" value ("++e++")"))
+ where e = concat (intersperse ", " (map show (init cs)))
+ ++ ", or " ++ show (last cs)
+
+------------------------------------------------------------------------
+-- Instances for all the Standard Prelude types.
+
+-- Basic types
+instance Parse Int where
+ parse = parseByRead "Int"
+instance Parse Integer where
+ parse = parseByRead "Integer"
+instance Parse Float where
+ parse = parseByRead "Float"
+instance Parse Double where
+ parse = parseByRead "Double"
+instance Parse Char where
+ parse = parseByRead "Char"
+ -- parseList = bracket (isWord "\"") (satisfy (=='"'))
+ -- (many (satisfy (/='"')))
+ -- not totally correct for strings...
+ parseList = do { w <- word; if head w == '"' then return (init (tail w))
+ else fail "not a string" }
+
+instance Parse Bool where
+ parse = enumeration "Bool" [False,True]
+
+instance Parse Ordering where
+ parse = enumeration "Ordering" [LT,EQ,GT]
+
+-- Structural types
+instance Parse () where
+ parse = P p
+ where p [] = (Left (False,"no input: expected a ()"), [])
+ p ('(':cs) = case dropWhile isSpace cs of
+ (')':s) -> (Right (), s)
+ _ -> (Left (False,"Expected ) after ("), cs)
+ p (c:cs) | isSpace c = p cs
+ | otherwise = ( Left (False,"Expected a (), got "++show c)
+ , (c:cs))
+
+instance (Parse a, Parse b) => Parse (a,b) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
+ ; return (x,y) }
+
+instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
+ ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
+ ; return (x,y,z) }
+
+instance Parse a => Parse (Maybe a) where
+ parse = do { isWord "Nothing"; return Nothing }
+ `onFail`
+ do { isWord "Just"
+ ; fmap Just $ optionalParens parse
+ `adjustErrBad` ("but within Just, "++)
+ }
+ `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
+
+instance (Parse a, Parse b) => Parse (Either a b) where
+ parse = constructors [ ("Left", do { fmap Left $ optionalParens parse } )
+ , ("Right", do { fmap Right $ optionalParens parse } )
+ ]
+
+instance Parse a => Parse [a] where
+ parse = parseList
+
+------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/HuttonMeijer.hs b/src/Text/ParserCombinators/HuttonMeijer.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/HuttonMeijer.hs
@@ -0,0 +1,218 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Text.ParserCombinators.HuttonMeijer
+-- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
+-- Licence : BSD
+--
+-- Maintainer : Malcolm Wallace
+-- Stability : Stable
+-- Portability : All
+--
+-- A LIBRARY OF MONADIC PARSER COMBINATORS
+--
+-- 29th July 1996
+--
+-- Graham Hutton Erik Meijer
+-- University of Nottingham University of Utrecht
+--
+-- This Haskell script defines a library of parser combinators, and is
+-- taken from sections 1-6 of our article "Monadic Parser Combinators".
+-- Some changes to the library have been made in the move from Gofer
+-- to Haskell:
+--
+-- * Do notation is used in place of monad comprehension notation;
+--
+-- * The parser datatype is defined using "newtype", to avoid the overhead
+-- of tagging and untagging parsers with the P constructor.
+-----------------------------------------------------------------------------
+
+
+module Text.ParserCombinators.HuttonMeijer
+ (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
+ sepby, sepby1, chainl,
+ chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
+ letter, alphanum, string, ident, nat, int, spaces, comment, junk,
+ skip, token, natural, integer, symbol, identifier) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+type Token = Char
+
+---------------------------------------------------------
+-- | The parser monad
+
+newtype Parser a = P ([Token] -> [(a,[Token])])
+
+instance Functor Parser where
+ -- map :: (a -> b) -> (Parser a -> Parser b)
+ fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
+
+instance Monad Parser where
+ -- return :: a -> Parser a
+ return v = P (\inp -> [(v,inp)])
+
+ -- >>= :: Parser a -> (a -> Parser b) -> Parser b
+ (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
+
+ -- fail :: String -> Parser a
+ fail _ = P (\_ -> [])
+
+instance MonadPlus Parser where
+ -- mzero :: Parser a
+ mzero = P (\_ -> [])
+
+ -- mplus :: Parser a -> Parser a -> Parser a
+ (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
+
+-- ------------------------------------------------------------
+-- * Other primitive parser combinators
+-- ------------------------------------------------------------
+
+item :: Parser Token
+item = P (\inp -> case inp of
+ [] -> []
+ (x:xs) -> [(x,xs)])
+
+first :: Parser a -> Parser a
+first (P p) = P (\inp -> case p inp of
+ [] -> []
+ (x:_) -> [x])
+
+papply :: Parser a -> [Token] -> [(a,[Token])]
+papply (P p) inp = p inp
+
+-- ------------------------------------------------------------
+-- * Derived combinators
+-- ------------------------------------------------------------
+
+(+++) :: Parser a -> Parser a -> Parser a
+p +++ q = first (p `mplus` q)
+
+sat :: (Token -> Bool) -> Parser Token
+sat p = do {x <- item; if p x then return x else mzero}
+
+--tok :: Token -> Parser Token
+--tok t = do {x <- item; if t==snd x then return t else mzero}
+
+many :: Parser a -> Parser [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+many1 :: Parser a -> Parser [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+sepby :: Parser a -> Parser b -> Parser [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+sepby1 :: Parser a -> Parser b -> Parser [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
+ +++ return x
+
+ops :: [(Parser a, b)] -> Parser b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: Parser a -> Parser b -> Parser c -> Parser b
+bracket open p close = do {open; x <- p; close; return x}
+
+-- ------------------------------------------------------------
+-- * Useful parsers
+-- ------------------------------------------------------------
+
+char :: Char -> Parser Char
+char x = sat (\y -> x == y)
+
+digit :: Parser Char
+digit = sat isDigit
+
+lower :: Parser Char
+lower = sat isLower
+
+upper :: Parser Char
+upper = sat isUpper
+
+letter :: Parser Char
+letter = sat isAlpha
+
+alphanum :: Parser Char
+alphanum = sat isAlphaNum +++ char '_'
+
+string :: String -> Parser String
+string "" = return ""
+string (x:xs) = do {char x; string xs; return (x:xs)}
+
+ident :: Parser String
+ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
+
+nat :: Parser Int
+nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
+ where
+ m `op` n = 10*m + n
+
+int :: Parser Int
+int = do {char '-'; n <- nat; return (-n)} +++ nat
+
+-- ------------------------------------------------------------
+-- * Lexical combinators
+-- ------------------------------------------------------------
+
+spaces :: Parser ()
+spaces = do {many1 (sat isSpace); return ()}
+
+comment :: Parser ()
+--comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
+--comment = do
+-- _ <- string "--"
+-- _ <- many (sat (\x -> x /= '\n'))
+-- return ()
+comment = do
+ bracket (string "/*") (many item) (string "*/")
+ return ()
+
+junk :: Parser ()
+junk = do {many (spaces +++ comment); return ()}
+
+skip :: Parser a -> Parser a
+skip p = do {junk; p}
+
+token :: Parser a -> Parser a
+token p = do {v <- p; junk; return v}
+
+-- ------------------------------------------------------------
+-- * Token parsers
+-- ------------------------------------------------------------
+
+natural :: Parser Int
+natural = token nat
+
+integer :: Parser Int
+integer = token int
+
+symbol :: String -> Parser String
+symbol xs = token (string xs)
+
+identifier :: [String] -> Parser String
+identifier ks = token (do {x <- ident;
+ if not (elem x ks) then return x
+ else return mzero})
+
+------------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/HuttonMeijerWallace.hs b/src/Text/ParserCombinators/HuttonMeijerWallace.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/HuttonMeijerWallace.hs
@@ -0,0 +1,297 @@
+{-----------------------------------------------------------------------------
+
+ A LIBRARY OF MONADIC PARSER COMBINATORS
+
+ 29th July 1996
+
+ Graham Hutton Erik Meijer
+ University of Nottingham University of Utrecht
+
+This Haskell 1.3 script defines a library of parser combinators, and is taken
+from sections 1-6 of our article "Monadic Parser Combinators". Some changes
+to the library have been made in the move from Gofer to Haskell:
+
+ * Do notation is used in place of monad comprehension notation;
+
+ * The parser datatype is defined using "newtype", to avoid the overhead
+ of tagging and untagging parsers with the P constructor.
+
+------------------------------------------------------------------------------
+** Extended to allow a symbol table/state to be threaded through the monad.
+** Extended to allow a parameterised token type, rather than just strings.
+** Extended to allow error-reporting.
+
+(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
+(More extensions: 2004 gk-haskell@ninebynine.org)
+
+------------------------------------------------------------------------------}
+
+-- | This library of monadic parser combinators is based on the ones
+-- defined by Graham Hutton and Erik Meijer. It has been extended by
+-- Malcolm Wallace to use an abstract token type (no longer just a
+-- string) as input, and to incorporate a State Transformer monad, useful
+-- for symbol tables, macros, and so on. Basic facilities for error
+-- reporting have also been added, and later extended by Graham Klyne
+-- to return the errors through an @Either@ type, rather than just
+-- calling @error@.
+
+module Text.ParserCombinators.HuttonMeijerWallace
+ (
+ -- * The parser monad
+ Parser(..)
+ -- * Primitive parser combinators
+ , item, eof, papply, papply'
+ -- * Derived combinators
+ , (+++), {-sat,-} tok, nottok, many, many1
+ , sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket
+ , toEOF
+ -- * Error handling
+ , elserror
+ -- * State handling
+ , stupd, stquery, stget
+ -- * Re-parsing
+ , reparse
+ ) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+--- The parser monad ---------------------------------------------------------
+
+type ParseResult s t e a = Either e [(a,s,[Either e t])]
+
+newtype Parser s t e a = P ( s -> [Either e t] -> ParseResult s t e a )
+ -- ^ The parser type is parametrised on the types of the state @s@,
+ -- the input tokens @t@, error-type @e@, and the result value @a@.
+ -- The state and remaining input are threaded through the monad.
+
+instance Functor (Parser s t e) where
+ -- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)
+ fmap f (P p) = P (\st inp -> case p st inp of
+ Right res -> Right [(f v, s, out) | (v,s,out) <- res]
+ Left err -> Left err
+ )
+
+instance Monad (Parser s t e) where
+ -- return :: a -> Parser s t e a
+ return v = P (\st inp -> Right [(v,st,inp)])
+ -- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b
+ (P p) >>= f = P (\st inp -> case p st inp of
+ Right res -> foldr joinresults (Right [])
+ [ papply' (f v) s out | (v,s,out) <- res ]
+ Left err -> Left err
+ )
+ -- fail :: String -> Parser s t e a
+ fail err = P (\st inp -> Right [])
+ -- I know it's counterintuitive, but we want no-parse, not an error.
+
+instance MonadPlus (Parser s t e) where
+ -- mzero :: Parser s t e a
+ mzero = P (\st inp -> Right [])
+ -- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a
+ (P p) `mplus` (P q) = P (\st inp -> joinresults (p st inp) (q st inp))
+
+-- joinresults ensures that explicitly raised errors are dominant,
+-- provided no parse has yet been found. The commented out code is
+-- a slightly stricter specification of the real code.
+joinresults :: ParseResult s t e a -> ParseResult s t e a -> ParseResult s t e a
+{-
+joinresults (Left p) (Left q) = Left p
+joinresults (Left p) (Right _) = Left p
+joinresults (Right []) (Left q) = Left q
+joinresults (Right p) (Left q) = Right p
+joinresults (Right p) (Right q) = Right (p++q)
+-}
+joinresults (Left p) q = Left p
+joinresults (Right []) q = q
+joinresults (Right p) q = Right (p++ case q of Left _ -> []
+ Right r -> r)
+
+
+--- Primitive parser combinators ---------------------------------------------
+
+-- | Deliver the first remaining token.
+item :: Parser s t e t
+item = P (\st inp -> case inp of
+ [] -> Right []
+ (Left e: _) -> Left e
+ (Right x: xs) -> Right [(x,st,xs)]
+ )
+
+-- | Fail if end of input is not reached
+eof :: Show p => Parser s (p,t) String ()
+eof = P (\st inp -> case inp of
+ [] -> Right [((),st,[])]
+ (Left e:_) -> Left e
+ (Right (p,_):_) -> Left ("End of input expected at "
+ ++show p++"\n but found text")
+ )
+
+{-
+-- | Ensure the value delivered by the parser is evaluated to WHNF.
+force :: Parser s t e a -> Parser s t e a
+force (P p) = P (\st inp -> let Right xs = p st inp
+ h = head xs in
+ h `seq` Right (h: tail xs)
+ )
+-- [[[GK]]] ^^^^^^
+-- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
+-- In this case, I think that means that the first element of the list
+-- is fully evaluated.
+--
+-- NOTE: the original form of this function fails if there is no parse
+-- result for p st inp (head xs fails if xs is null), so the modified
+-- form can assume a Right value only.
+--
+-- Why is this needed?
+-- It's not exported, and the only use of this I see is commented out.
+---------------------------------------
+-}
+
+
+-- | Deliver the first parse result only, eliminating any backtracking.
+first :: Parser s t e a -> Parser s t e a
+first (P p) = P (\st inp -> case p st inp of
+ Right (x:xs) -> Right [x]
+ otherwise -> otherwise
+ )
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, raise 'error' to halt the program.
+-- (This is the original exported behaviour - to allow the caller to
+-- deal with the error differently, see @papply'@.)
+papply :: Parser s t String a -> s -> [Either String t]
+ -> [(a,s,[Either String t])]
+papply (P p) st inp = either error id (p st inp)
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, return a diagnostic message to the caller.
+papply' :: Parser s t e a -> s -> [Either e t]
+ -> Either e [(a,s,[Either e t])]
+papply' (P p) st inp = p st inp
+
+--- Derived combinators ------------------------------------------------------
+
+-- | A choice between parsers. Keep only the first success.
+(+++) :: Parser s t e a -> Parser s t e a -> Parser s t e a
+p +++ q = first (p `mplus` q)
+
+-- | Deliver the first token if it satisfies a predicate.
+sat :: (t -> Bool) -> Parser s (p,t) e t
+sat p = do {(_,x) <- item; if p x then return x else mzero}
+
+-- | Deliver the first token if it equals the argument.
+tok :: Eq t => t -> Parser s (p,t) e t
+tok t = do {(_,x) <- item; if x==t then return t else mzero}
+
+-- | Deliver the first token if it does not equal the argument.
+nottok :: Eq t => [t] -> Parser s (p,t) e t
+nottok ts = do {(_,x) <- item; if x `notElem` ts then return x
+ else mzero}
+
+-- | Deliver zero or more values of @a@.
+many :: Parser s t e a -> Parser s t e [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+-- | Deliver one or more values of @a@.
+many1 :: Parser s t e a -> Parser s t e [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+-- | Deliver zero or more values of @a@ separated by @b@'s.
+sepby :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+-- | Deliver one or more values of @a@ separated by @b@'s.
+sepby1 :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do { f <- op
+ ; y <- p `chainr1` op
+ ; return (f x y)
+ }
+ +++ return x
+
+ops :: [(Parser s t e a, b)] -> Parser s t e b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: (Show p,Show t) =>
+ Parser s (p,t) e a -> Parser s (p,t) e b ->
+ Parser s (p,t) e c -> Parser s (p,t) e b
+bracket open p close = do { open
+ ; x <- p
+ ; close -- `elserror` "improperly matched construct";
+ ; return x
+ }
+
+-- | Accept a complete parse of the input only, no partial parses.
+toEOF :: Show p =>
+ Parser s (p,t) String a -> Parser s (p,t) String a
+toEOF p = do { x <- p; eof; return x }
+
+
+--- Error handling -----------------------------------------------------------
+
+-- | Return an error using the supplied diagnostic string, and a token type
+-- which includes position information.
+parseerror :: (Show p,Show t) => String -> Parser s (p,t) String a
+parseerror err = P (\st inp ->
+ case inp of
+ [] -> Left "Parse error: unexpected EOF\n"
+ (Left e:_) -> Left ("Lexical error: "++e)
+ (Right (p,t):_) ->
+ Left ("Parse error: in "++show p++"\n "
+ ++err++"\n "++"Found "++show t)
+ )
+
+
+-- | If the parser fails, generate an error message.
+elserror :: (Show p,Show t) => Parser s (p,t) String a -> String
+ -> Parser s (p,t) String a
+p `elserror` s = p +++ parseerror s
+
+--- State handling -----------------------------------------------------------
+
+-- | Update the internal state.
+stupd :: (s->s) -> Parser s t e ()
+stupd f = P (\st inp-> {-let newst = f st in newst `seq`-}
+ Right [((), f st, inp)])
+
+-- | Query the internal state.
+stquery :: (s->a) -> Parser s t e a
+stquery f = P (\st inp-> Right [(f st, st, inp)])
+
+-- | Deliver the entire internal state.
+stget :: Parser s t e s
+stget = P (\st inp-> Right [(st, st, inp)])
+
+
+--- Push some tokens back onto the input stream and reparse ------------------
+
+-- | This is useful for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [Either e t] -> Parser s t e ()
+reparse ts = P (\st inp-> Right [((), st, ts++inp)])
+
+------------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly.hs b/src/Text/ParserCombinators/Poly.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/Poly.hs
@@ -0,0 +1,238 @@
+module Text.ParserCombinators.Poly
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
+ , failBad -- :: String -> Parser t a
+ , commit -- :: Parser t a -> Parser t a
+
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+ , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
+ , discard -- :: Parser t a -> Parser t b -> Parser t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
+ , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser t a -> Parser t a -> Parser t a
+ , oneOf -- :: Show t => [Parser t a] -> Parser t a
+ , oneOf' -- :: [(String,Parser t a)] -> Parser t a
+ , optional -- :: Parser t a -> Parser t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser t a -> Parser t [a]
+ , many1 -- :: Parser t a -> Parser t [a]
+ , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
+ -- -> Parser t a -> Parser t [a]
+ , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
+ -- -> Parser t a
+ , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ ) where
+
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser t a = P ([t] -> (EitherE String a, [t]))
+
+-- A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser t a -> [t] -> (Either String a, [t])
+runParser (P p) =
+ (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
+ . p
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> (Right (f x), ts'))
+instance Monad (Parser t) where
+ return x = P (\ts-> (Right x, ts))
+ (P f) >>= g = P (\ts-> case f ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> let (P g') = g x in g' ts')
+ fail e = P (\ts-> (Left (False,e), ts))
+
+-- | When a simple fail is not strong enough, use failBad for emphasis.
+-- An emphasised (severe) error can propagate out through choice operators.
+failBad :: String -> Parser t a
+failBad msg = P (\ts-> (Left (True,msg), ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser t a -> Parser t a
+commit (P p) = P (\ts-> case p ts of
+ (Left (_,e), ts') -> (Left (True,e), ts')
+ right -> right )
+
+
+-- Combinators
+
+-- | One token
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> (Left (False,"Ran out of input (EOF)"), [])
+ (t:ts') -> (Right t, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser t (a->b) -> Parser t a -> Parser t b
+pf `apply` px = do { f <- pf; x <- px; return (f x) }
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser t a -> Parser t b -> Parser t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser t a -> (String->String) -> Parser t a
+(P p) `adjustErr` f = P (\ts-> case p ts of
+ (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser t a -> (String->String) -> Parser t a
+p `adjustErrBad` f = commit (p `adjustErr` f)
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser t a -> Parser t a -> Parser t a
+(P p) `onFail` (P q) = P (\ts-> case p ts of
+ r@(Left (True,_), _) -> r
+ (Left _, _) -> q ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser t a] -> Parser t a
+oneOf [] = do { n <- next
+ ; fail ("failed to parse any of the possible choices")
+ }
+--oneOf :: Show t => [Parser t a] -> Parser t a
+--oneOf [] = do { n <- next
+-- ; fail ("failed to parse any of the possible choices"
+-- ++"\n next token is "++show n)
+-- }
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser t a)] -> Parser t a
+oneOf' = accum []
+ where accum errs [] =
+ case filter isBad errs of
+ [] -> fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ [(_,(_,e))] -> failBad e
+ es -> failBad ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ (Left err,_) -> let (P p) = accum ((e,err):errs) ps
+ in p ts
+ right -> right )
+ showErr (name,(_,err)) = name++":\n"++indent 2 err
+ isBad (_,(b,_)) = b
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser t a -> Parser t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser t a -> Parser t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser t a -> Parser t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
+ -> Parser t a -> Parser t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser t a -> Parser t z -> Parser t [a]
+manyFinally p t =
+ do { xs <- many p
+ ; oneOf' [ ("sequence terminator", do { t; return () } )
+ , ("item in a sequence", do { p; return () } )
+ ]
+ ; return xs
+ }
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> (Right (), ts++inp))
+
+------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyLazy.hs b/src/Text/ParserCombinators/PolyLazy.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/PolyLazy.hs
@@ -0,0 +1,267 @@
+module Text.ParserCombinators.PolyLazy
+ ( -- * The Parser datatype.
+ -- $parser
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser t a -> [t] -> (a, [t])
+ , failBad -- :: String -> Parser t a
+ , commit -- :: Parser t a -> Parser t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+ , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
+ , discard -- :: Parser t a -> Parser t b -> Parser t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
+ , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser t a -> Parser t a -> Parser t a
+ , oneOf -- :: Show t => [Parser t a] -> Parser t a
+ , oneOf' -- :: [(String,Parser t a)] -> Parser t a
+ , optional -- :: Parser t a -> Parser t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser t a -> Parser t [a]
+ , many1 -- :: Parser t a -> Parser t [a]
+ , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
+ , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
+ -- -> Parser t a -> Parser t [a]
+ , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
+ -- -> Parser t a
+ , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ ) where
+
+#if __GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+-- $parser
+-- When applied, these parsers do not return explicit failure.
+-- An exception is
+-- raised instead. This allows partial results to be returned
+-- before a full parse is complete.
+-- One of the key ways to ensure that your parser is properly lazy,
+-- is to parse the initial portion of text returning a function, then
+-- use the @apply@ combinator to build the final value.
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyStateLazy
+-- instead.)
+newtype Parser t a = P ([t] -> (Either String a, [t]))
+
+-- A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+-- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!!
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an input token sequence. The parser cannot return
+-- an error value explicitly, so errors raise an exception. Thus, results
+-- can be partial (lazily constructed, but containing undefined).
+runParser :: Parser t a -> [t] -> (a, [t])
+runParser (P p) =
+ (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) )
+ . p
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> (Right (f x), ts'))
+instance Monad (Parser t) where
+ return x = P (\ts-> (Right x, ts))
+ (P f) >>= g = P (\ts-> case f ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right x, ts') -> let (P g') = g x in g' ts')
+ fail e = P (\ts-> (Left e, ts))
+
+-- | Simple failure can be corrected, but when a simple fail is not strong
+-- enough, use failBad for emphasis. It guarantees parsing will
+-- terminate with an exception.
+
+failBad :: String -> Parser t a
+failBad msg = P (\ts-> (throwE msg, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser t a -> Parser t a
+commit (P p) = P (\ts-> case p ts of
+ (Left e, ts') -> (throwE e, ts')
+ right -> right )
+
+
+-- Combinators
+
+-- | One token
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> (Left "Ran out of input (EOF)", [])
+ (t:ts') -> (Right t, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser t (a->b) -> Parser t a -> Parser t b
+--pf `apply` px = do { f <- pf; x <- px; return (f x) }
+-- Needs to be lazier! Must not force the argument value too early.
+(P pf) `apply` (P px) = P (\ts->
+ case pf ts of
+ (Left msg, ts') -> (Left msg, ts')
+ (Right f, ts') -> let (x',ts'') = px ts'
+ x = case x' of { Right x -> x; Left e -> throwE e }
+ in (Right (f x), ts'') )
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser t a -> Parser t b -> Parser t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser t a -> (String->String) -> Parser t a
+(P p) `adjustErr` f = P (\ts-> case p ts of
+ (Left msg, ts') -> (Left (f msg), ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser t a -> (String->String) -> Parser t a
+p `adjustErrBad` f = commit (p `adjustErr` f)
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser t a -> Parser t a -> Parser t a
+(P p) `onFail` (P q) = P (\ts-> case p ts of
+ (Left _, _) -> q ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser t a] -> Parser t a
+oneOf [] = do { n <- next
+ ; fail ("failed to parse any of the possible choices")
+ }
+--oneOf :: Show t => [Parser t a] -> Parser t a
+--oneOf [] = do { n <- next
+-- ; fail ("failed to parse any of the possible choices"
+-- ++"\n next token is "++show n)
+-- }
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser t a)] -> Parser t a
+oneOf' ps = accum [] ps
+ where accum errs [] =
+ case errs of
+ [] -> failBad ("internal failure in parser (oneOf'):\n"
+ ++indent 2 (show (map fst ps)))
+ [(_,e)] -> fail e
+ es -> fail ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ (Left err,_) -> let (P p) = accum ((e,err):errs) ps
+ in p ts
+ right -> right )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser t a -> Parser t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser t a -> Parser t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser t a -> Parser t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
+ -> Parser t a -> Parser t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser t a -> Parser t z -> Parser t [a]
+manyFinally pp@(P p) pt@(P t) = P (\ts ->
+ case p ts of
+ (Left e, _) ->
+ case t ts of
+ (Right _, ts') -> (Right [], ts')
+ (Left e, ts') -> (Left e, ts')
+ (Right x, ts') ->
+ let (tail,ts'') = runParser (manyFinally pp pt) ts'
+ in (Right (x:tail), ts'') )
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> (Right (), ts++inp))
+
+------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyState.hs b/src/Text/ParserCombinators/PolyState.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/PolyState.hs
@@ -0,0 +1,248 @@
+module Text.ParserCombinators.PolyState
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+ , failBad -- :: String -> Parser s t a
+ , commit -- :: Parser s t a -> Parser s t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
+ , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
+ , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
+ , oneOf -- :: [Parser s t a] -> Parser s t a
+ , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
+ -- ** Sequences
+ , many -- :: Parser s t a -> Parser s t [a]
+ , many1 -- :: Parser s t a -> Parser s t [a]
+ , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -- -> Parser s t a -> Parser s t [a]
+ , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
+ -- -> Parser s t a
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ ) where
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting and a running state. It can be used for arbitrary token
+-- types, not just String input.
+newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t]))
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an initial state and input token sequence.
+runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+runParser (P p) s =
+ (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m
+ ,s,ts))
+ . p s
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> (Right (f x), s', ts'))
+instance Monad (Parser s t) where
+ return x = P (\s ts-> (Right x, s, ts))
+ (P f) >>= g = P (\s ts-> case f s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> let (P g') = g x
+ in g' s' ts')
+ fail msg = P (\s ts-> (Left (False,msg), s, ts))
+
+-- | When a simple fail is not strong enough, use failBad for emphasis.
+-- An emphasised (severe) error can propagate out through choice operators.
+failBad :: String -> Parser s t a
+failBad msg = P (\s ts-> (Left (True,msg), s, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser s t a -> Parser s t a
+commit (P p) = P (\s ts-> case p s ts of
+ (Left (_,e), s', ts') -> (Left (True,e), s', ts')
+ right -> right )
+
+-- Combinators
+
+-- | One token
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> (Left (False,"Ran out of input (EOF)"), s, [])
+ (t:ts') -> (Right t, s, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser s t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
+pf `apply` px = do { f <- pf; x <- px; return (f x) }
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser s t a -> Parser s t b -> Parser s t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser s t a -> (String->String) -> Parser s t a
+(P p) `adjustErr` f =
+ P (\s ts-> case p s ts of
+ (Left (b,msg), s', ts') -> (Left (b,(f msg)), s, ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
+-- p `adjustErrBad` f = commit (p `adjustErr` f)
+(P p) `adjustErrBad` f =
+ P (\s ts-> case p s ts of
+ (Left (_,msg), s', ts') -> (Left (True,(f msg)), s, ts')
+ right -> right )
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a severe failure in p cannot be ignored.
+onFail :: Parser s t a -> Parser s t a -> Parser s t a
+(P p) `onFail` (P q) = P (\s ts-> case p s ts of
+ r@(Left (True,_), _, _) -> r
+ (Left _, _, _) -> q s ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser s t a] -> Parser s t a
+oneOf [] = fail ("Failed to parse any of the possible choices")
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser s t a)] -> Parser s t a
+oneOf' = accum []
+ where accum errs [] =
+ case filter isBad errs of
+ [] -> fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ [(_,(_,e))] -> failBad e
+ es -> failBad ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\u ts-> case p u ts of
+ (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
+ in p u ts
+ right -> right )
+ showErr (name,(_,err)) = name++":\n"++indent 2 err
+ isBad (_,(b,_)) = b
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser s t a -> Parser s t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser s t a -> Parser s t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -> Parser s t a -> Parser s t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+manyFinally p t =
+ do { xs <- many p
+ ; oneOf' [ ("sequence terminator", do { t; return () } )
+ , ("item in a sequence", do { p; return () } )
+ ]
+ ; return xs
+ }
+
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> (Right (), f s, ts))
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> (Right (f s), s, ts))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> (Right s, s, ts))
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> (Right (), s, ts++inp))
+
+------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyStateLazy.hs b/src/Text/ParserCombinators/PolyStateLazy.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/ParserCombinators/PolyStateLazy.hs
@@ -0,0 +1,281 @@
+module Text.ParserCombinators.PolyStateLazy
+ ( -- * The Parser datatype.
+ -- $parser
+ Parser(P) -- datatype, instance of: Functor, Monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t])
+ , failBad -- :: String -> Parser s t a
+ , commit -- :: Parser s t a -> Parser s t a
+ -- * Combinators:
+ -- ** Primitives
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
+ , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
+ -- ** Error-handling
+ , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
+ , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
+ , oneOf -- :: [Parser s t a] -> Parser s t a
+ , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
+ , optional -- :: Parser s t a -> Parser s t (Maybe a)
+ -- ** Sequences
+ , many -- :: Parser s t a -> Parser s t [a]
+ , many1 -- :: Parser s t a -> Parser s t [a]
+ , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
+ , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -- -> Parser s t a -> Parser s t [a]
+ , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
+ -- -> Parser s t a
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** Re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ ) where
+
+#if __GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+-- $parser
+-- Parsers do not return explicit failure. An exception is raised
+-- instead. This allows partial results to be returned before a
+-- full parse is complete.
+
+-- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting and a running state. It can be used for arbitrary token
+-- types, not just String input.
+newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t]))
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also had gradations of wrongness.
+-- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!
+type EitherE a b = Either (Bool,a) b
+
+-- | Apply a parser to an initial state and input token sequence.
+-- The parser cannot return an error value explicitly, so errors
+-- raise an exception. Thus, results can be partial (lazily constructed,
+-- but containing undefined).
+runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
+runParser (P p) s =
+ (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts))
+ . p s
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> (Right (f x), s', ts'))
+instance Monad (Parser s t) where
+ return x = P (\s ts-> (Right x, s, ts))
+ (P f) >>= g = P (\s ts-> case f s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right x, s', ts') -> let (P g') = g x
+ in g' s' ts')
+ fail msg = P (\s ts-> (Left msg, s, ts))
+
+-- | Simple failure can be corrected, but when a simple fail is not strong
+-- enough, use failBad for emphasis. It guarantees parsing will terminate
+-- with an exception.
+failBad :: String -> Parser s t a
+failBad msg = P (\s ts-> (throwE msg, s, ts))
+
+-- | Commit is a way of raising the severity of any errors found within
+-- its argument. Used in the middle of a parser definition, it means that
+-- any operations prior to commitment fail softly, but after commitment,
+-- they fail hard.
+commit :: Parser s t a -> Parser s t a
+commit (P p) = P (\s ts-> case p s ts of
+ (Left e, s', ts') -> (throwE e, s', ts')
+ right -> right )
+
+-- Combinators
+
+-- | One token
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> (Left "Ran out of input (EOF)", s, [])
+ (t:ts') -> (Right t, s, ts') )
+
+-- | One token satifying a predicate
+satisfy :: (t->Bool) -> Parser s t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+
+infixl 3 `apply`
+-- | Apply a parsed function to a parsed value
+apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
+--pf `apply` px = do { f <- pf; x <- px; return (f x) }
+-- Needs to be lazier! Must not force the argument value too early.
+(P pf) `apply` (P px) = P (\s ts->
+ case pf s ts of
+ (Left msg, s', ts') -> (Left msg, s', ts')
+ (Right f, s', ts') -> let (x',s'',ts'') = px s' ts'
+ x = case x' of
+ Right x -> x
+ Left e -> throwE e
+ in (Right (f x), s'', ts''))
+
+infixl 3 `discard`
+-- | @x `discard` y@ parses both x and y, but discards the result of y
+discard :: Parser s t a -> Parser s t b -> Parser s t a
+px `discard` py = do { x <- px; _ <- py; return x }
+
+-- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+-- generated in @p@, having no effect if @p@ succeeds.
+adjustErr :: Parser s t a -> (String->String) -> Parser s t a
+(P p) `adjustErr` f =
+ P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (Left (f msg), s, ts')
+ right -> right )
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
+-- p `adjustErrBad` f = commit (p `adjustErr` f)
+(P p) `adjustErrBad` f =
+ P (\s ts-> case p s ts of
+ (Left msg, s', ts') -> (throwE (f msg), s, ts')
+ right -> right )
+
+infixl 6 `onFail` -- not sure about precedence 6?
+-- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
+-- Can be chained together to give multiple attempts to parse something.
+-- (Note that q could itself be a failing parser, e.g. to change the error
+-- message from that defined in p to something different.)
+-- However, a *severe* failure in p cannot be ignored.
+onFail :: Parser s t a -> Parser s t a -> Parser s t a
+(P p) `onFail` (P q) = P (\s ts-> case p s ts of
+ (Left _, _, _) -> q s ts
+ right -> right )
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: [Parser s t a] -> Parser s t a
+oneOf [] = fail ("Failed to parse any of the possible choices")
+oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Parse the first alternative that succeeds, but if none succeed,
+-- report only the severe errors, and if none of those, then report
+-- all the soft errors.
+oneOf' :: [(String, Parser s t a)] -> Parser s t a
+oneOf' ps = accum [] ps
+ where accum errs [] =
+ case errs of
+ [] -> failBad ("internal failure in parser (oneOf'):\n"
+ ++indent 2 (show (map fst ps)))
+ [(_,e)] -> fail e
+ es -> fail ("one of the following failures occurred:\n"
+ ++indent 2 (concatMap showErr (reverse es)))
+ accum errs ((e,P p):ps) =
+ P (\u ts-> case p u ts of
+ (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
+ in p u ts
+ right -> right )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: Parser s t a -> Parser s t (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: Parser s t a -> Parser s t [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: Parser s t a -> Parser s t [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; xs <- many p
+ ; return (x:xs)
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
+sepBy1 p sep = do { x <- p
+ ; xs <- many (do {sep; p})
+ ; return (x:xs)
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
+ -> Parser s t a -> Parser s t [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
+ ; xs <- many (do {sep; p})
+ ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
+ ; return (x:xs)
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n"++)
+ ; x <- p
+ ; close `adjustErrBad` ("Missing closing bracket:\n"++)
+ ; return x
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. Any parse failures could be due either to
+-- a badly-formed terminator or a badly-formed element, so raise
+-- both possible errors.
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+manyFinally pp@(P p) pt@(P t) = P (\s ts ->
+ case p s ts of
+ (Left e, _, _) ->
+ case t s ts of
+ (Right _, s', ts') -> (Right [], s', ts')
+ (Left e, s', ts') -> (Left e, s', ts')
+ (Right x, s', ts') ->
+ let (tail,s'',ts'') = runParser (manyFinally pp pt) s' ts'
+ in (Right (x:tail), s'', ts'') )
+
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> (Right (), f s, ts))
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> (Right (f s), s, ts))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> (Right s, s, ts))
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> (Right (), s, ts++inp))
+
+------------------------------------------------------------------------
diff --git a/src/pkg.conf b/src/pkg.conf
new file mode 100644
--- /dev/null
+++ b/src/pkg.conf
@@ -0,0 +1,16 @@
+Package
+ { name = "polyparse"
+ , auto = True
+ , import_dirs = ["$libdir/imports/polyparse"]
+ , source_dirs = []
+ , library_dirs = ["$libdir"]
+ , hs_libraries = ["HSpolyparse" ]
+ , extra_libraries = []
+ , include_dirs = []
+ , c_includes = []
+ , package_deps = ["base"]
+ , extra_ghc_opts = []
+ , extra_cc_opts = []
+ , extra_ld_opts = []
+ }
+
Instances