polyparse-1.13/0000755000000000000000000000000007346545000011645 5ustar0000000000000000polyparse-1.13/COPYRIGHT0000644000000000000000000000315307346545000013142 0ustar0000000000000000The 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 and Text.Parse.* are (c) copyright 2006-2014 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. ---- If you have a commercial use for polyparse, and feel that even the terms of the LGPL (as relaxed above) are too onerous, you have the option of distributing unmodified binaries (only, not sources) under the terms of a different licence (see LICENCE-commercial). ---- 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@me.com polyparse-1.13/Changelog.md0000755000000000000000000000021207346545000014054 0ustar0000000000000000## 1.13 - GHC-8.8 compatibility - PolyParse has MonadFail as a superclass. ## 1.12.1 - GHC-8.6 compatibility - MonadFail instances polyparse-1.13/LICENCE-LGPL0000644000000000000000000006363407346545000013402 0ustar0000000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 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! polyparse-1.13/LICENCE-commercial0000644000000000000000000000250707346545000014747 0ustar0000000000000000Commercial licence for polyparse. Copyright 2006-2014, Malcolm Wallace (malcolm.wallace@me.com) All rights reserved. * This software, built from original unmodified sources, may be used for any purpose whatsoever, without restriction. * Redistribution in binary form, without modification, is permitted provided that the above copyright notice, these conditions and the following disclaimer are reproduced in the documentation and/or other materials provided with the distribution. * Redistribution in source form, with or without modification, is not permitted under this license. THIS SOFTWARE IS PROVIDED BY Malcolm Wallace AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Malcolm Wallace OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. polyparse-1.13/Setup.hs0000644000000000000000000000005607346545000013302 0ustar0000000000000000import Distribution.Simple main = defaultMain polyparse-1.13/polyparse.cabal0000644000000000000000000000520507346545000014651 0ustar0000000000000000name: polyparse version: 1.13 license: LGPL license-files: COPYRIGHT, LICENCE-LGPL, LICENCE-commercial copyright: (c) 2006-2016 Malcolm Wallace author: Malcolm Wallace maintainer: author homepage: http://code.haskell.org/~malcolm/polyparse/ bug-reports: https://github.com/haskell-infra/hackage-trustees/issues category: Text, Parsing synopsis: A variety of alternative parser combinator libraries. description: This version, 1.13 is a Non-Maintainer Upload (NMU). Report issues to the Hackage Trustees issue tracker. . 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. build-type: Simple cabal-version: >=1.8 extra-source-files: Changelog.md tested-with: GHC ==8.8.1 || ==8.6.5 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 || ==7.6.3 || ==7.4.2 || ==7.2.2 || ==7.0.4 source-repository head type: darcs location: http://code.haskell.org/polyparse source-repository this type: git location: https://github.com/hackage-trustees/malcolm-wallace-universe.git tag: 1.12.1 library hs-source-dirs: src build-depends: base >= 4.3.1.0 && < 4.14 if !impl(ghc >= 8.0) build-depends: fail == 4.9.* exposed-modules: Text.ParserCombinators.HuttonMeijer, Text.ParserCombinators.HuttonMeijerWallace, Text.ParserCombinators.Poly, Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Result, Text.ParserCombinators.Poly.Parser, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.StateParser, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly.Lex, Text.Parse if impl(ghc) build-depends: bytestring >= 0.9.1.0 && < 0.11 build-depends: text >= 1.2.3.0 && <1.3 exposed-modules: Text.ParserCombinators.Poly.ByteString Text.ParserCombinators.Poly.ByteStringChar Text.Parse.ByteString Text.ParserCombinators.Poly.Text Text.ParserCombinators.Poly.StateText -- Text.Parse.Text cpp-options: -DVERSION="1.12" nhc98-options: -K6M extensions: CPP polyparse-1.13/src/Text/0000755000000000000000000000000007346545000013360 5ustar0000000000000000polyparse-1.13/src/Text/Parse.hs0000644000000000000000000005135107346545000014773 0ustar0000000000000000module 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 , readByParse -- :: TextParser a -> ReadS a , readsPrecByParsePrec -- :: (Int->TextParser a) -> Int -> ReadS a -- ** Combinators specific to string input, lexed haskell-style , word -- :: TextParser String , isWord -- :: String -> TextParser () , literal -- :: String -> TextParser () , optionalParens -- :: TextParser a -> TextParser a , parens -- :: Bool -> TextParser a -> TextParser a , field -- :: Parse a => String -> TextParser a , constructors-- :: [(String,TextParser a)] -> TextParser a , enumeration -- :: Show a => String -> [a] -> TextParser a -- ** Parsers for literal numerics and characters , parseSigned , parseInt , parseDec , parseOct , parseHex , parseFloat , parseLitChar , parseLitChar' -- ** Re-export all the more general combinators from Poly too , module Text.ParserCombinators.Poly -- ** Strings as whole entities , allAsString ) where import Data.Char as Char (isSpace,toLower,isUpper,isDigit,isOctDigit ,isHexDigit,digitToInt,isAlpha,isAlphaNum,ord,chr) import Data.List (intersperse) import Data.Ratio 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 -- | A straightforward parser for an item. (A minimal definition of -- a class instance requires either |parse| or |parsePrec|.) parse :: TextParser a parse = parsePrec 0 -- | A straightforward parser for an item, given the precedence of -- any surrounding expression. (Precedence determines whether -- parentheses are mandatory or optional.) parsePrec :: Int -> TextParser a parsePrec _ = optionalParens parse -- | Parsing a list of items by default accepts the [] and comma syntax, -- except when the list is really a character string using \"\". parseList :: TextParser [a] -- only to distinguish [] and "" parseList = do { isWord "[]"; return [] } `onFail` do { isWord "["; isWord "]"; return [] } `onFail` bracketSep (isWord "[") (isWord ",") (isWord "]") (optionalParens 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. The string argument -- is the expected type or value (for error-reporting only). parseByRead :: Read a => String -> TextParser a parseByRead name = P (\s-> case reads s of [] -> Failure s ("no parse, expected a "++name) [(a,s')] -> Success s' a _ -> Failure s ("ambiguous parse, expected a "++name) ) -- | If you have a TextParser for a type, you can easily make it into -- a Read instance, by throwing away any error messages. readByParse :: TextParser a -> ReadS a readByParse p = \inp-> case runParser p inp of (Left err, rest) -> [] (Right val, rest) -> [(val,rest)] -- | If you have a TextParser for a type, you can easily make it into -- a Read instance, by throwing away any error messages. readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a readsPrecByParsePrec p = \prec inp-> case runParser (p prec) inp of (Left err, rest) -> [] (Right val, rest) -> [(val,rest)] -- | One lexical chunk. This is Haskell'98-style lexing - the result -- should match Prelude.lex apart from better error-reporting. word :: TextParser String word = P p where p "" = Failure "" "end of input" p (c:s) | isSpace c = p (dropWhile isSpace s) p ('\'':s) = let (P lit) = parseLitChar' in fmap show (lit ('\'':s)) p ('"':s) = lexString "\"" s where lexString acc ('"':s) = Success s (reverse ('"':acc)) lexString acc [] = Failure [] ("end of input in " ++"string literal " ++acc) lexString acc s = let (P lit) = parseLitChar in case lit s of Failure a b -> Failure a b Success t c -> lexString (c:acc) t p ('0':'x':s) = Success t ('0':'x':ds) where (ds,t) = span isHexDigit s p ('0':'X':s) = Success t ('0':'X':ds) where (ds,t) = span isHexDigit s p ('0':'o':s) = Success t ('0':'o':ds) where (ds,t) = span isOctDigit s p ('0':'O':s) = Success t ('0':'O':ds) where (ds,t) = span isOctDigit s p (c:s) | isSingle c = Success s [c] | isSym c = let (sym,t) = span isSym s in Success t (c:sym) | isIdInit c = let (nam,t) = span isIdChar s in Success t (c:nam) | isDigit c = let (ds,t) = span isDigit s in lexFracExp (c:ds) t | otherwise = Failure (c:s) ("Bad character: "++show c) where isSingle c = c `elem` ",;()[]{}`" isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~" isIdInit c = isAlpha c || c == '_' isIdChar c = isAlphaNum c || c `elem` "_'" lexFracExp acc ('.':d:s) | isDigit d = lexExp (acc++'.':d:ds) t where (ds,t) = span isDigit s lexFracExp acc s = lexExp acc s lexExp acc (e:s) | e`elem`"eE" = case s of ('+':d:t) | isDigit d -> let (ds,u)=span isDigit t in Success u (acc++"e+"++d:ds) ('-':d:t) | isDigit d -> let (ds,u)=span isDigit t in Success u (acc++"e-"++d:ds) (d:t) |isDigit d -> let (ds,u)=span isDigit t in Success u (acc++"e"++d:ds) _ -> Failure s ("missing +/-/digit " ++"after e in float " ++"literal: " ++show (acc++"e"++"...")) lexExp acc s = Success s acc -- | One lexical chunk (Haskell'98-style lexing - the result should match -- Prelude.lex apart from error-reporting). oldword :: TextParser String oldword = P (\s-> case lex s of [] -> Failure s ("no input? (impossible)") [("","")] -> Failure "" ("no input?") [("",s')] -> Failure s ("lexing failed?") ((x,s'):_) -> Success s' x ) -- | 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') } -- | Ensure that the next input word is the given string. (No -- lexing, so mixed spaces, symbols, are accepted.) literal :: String -> TextParser String literal w = do { w' <- walk w ; if w'==w then return w else fail ("expected "++w++" got "++w') } where walk [] = return w walk (c:cs) = do { x <- next ; if x==c then walk cs else return [] } -- | Allow nested parens around an item. optionalParens :: TextParser a -> TextParser a optionalParens p = parens False p -- | Allow nested parens around an item (one set required when Bool is True). parens :: Bool -> TextParser a -> TextParser a parens True p = bracket (isWord "(") (isWord ")") (parens False p) parens False p = parens True 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. -- Numeric types parseSigned :: Real a => TextParser a -> TextParser a parseSigned p = do '-' <- next; commit (fmap negate p) `onFail` do p parseInt :: (Integral a) => String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a parseInt base radix isDigit digitToInt = do cs <- many1 (satisfy isDigit) return (foldl1 (\n d-> n*radix+d) (map (fromIntegral.digitToInt) cs)) `adjustErr` (++("\nexpected one or more "++base++" digits")) parseDec, parseOct, parseHex :: (Integral a) => TextParser a parseDec = parseInt "decimal" 10 Char.isDigit Char.digitToInt parseOct = parseInt "octal" 8 Char.isOctDigit Char.digitToInt parseHex = parseInt "hex" 16 Char.isHexDigit Char.digitToInt parseFloat :: (RealFrac a) => TextParser a parseFloat = do ds <- many1 (satisfy isDigit) frac <- (do '.' <- next many (satisfy isDigit) `adjustErrBad` (++"expected digit after .") `onFail` return [] ) exp <- exponent `onFail` return 0 ( return . fromRational . (* (10^^(exp - length frac))) . (%1) . (\ (Right x)->x) . fst . runParser parseDec ) (ds++frac) `onFail` do w <- many (satisfy (not.isSpace)) case map toLower w of "nan" -> return (0/0) "infinity" -> return (1/0) _ -> fail "expected a floating point number" where exponent = do 'e' <- fmap toLower next commit (do '+' <- next; parseDec `onFail` parseSigned parseDec ) -- | Parse a Haskell character literal, including the surrounding single quotes. parseLitChar' :: TextParser Char parseLitChar' = do '\'' <- next `adjustErr` (++"expected a literal char") char <- parseLitChar '\'' <- next `adjustErrBad` (++"literal char has no final '") return char -- | Parse a Haskell character literal, excluding the surrounding single quotes. parseLitChar :: TextParser Char parseLitChar = do c <- next char <- case c of '\\' -> next >>= escape '\'' -> fail "expected a literal char, got ''" _ -> return c return char where escape 'a' = return '\a' escape 'b' = return '\b' escape 'f' = return '\f' escape 'n' = return '\n' escape 'r' = return '\r' escape 't' = return '\t' escape 'v' = return '\v' escape '\\' = return '\\' escape '"' = return '"' escape '\'' = return '\'' escape '^' = do ctrl <- next if ctrl >= '@' && ctrl <= '_' then return (chr (ord ctrl - ord '@')) else fail ("literal char ctrl-escape malformed: \\^" ++[ctrl]) escape d | isDigit d = fmap chr $ (reparse [d] >> parseDec) escape 'o' = fmap chr $ parseOct escape 'x' = fmap chr $ parseHex escape c | isUpper c = mnemonic c escape c = fail ("unrecognised escape sequence in literal char: \\"++[c]) mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK' `wrap` "'\\ACK'" mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL' `onFail` do 'S' <- next; return '\BS' `wrap` "'\\BEL' or '\\BS'" mnemonic 'C' = do 'R' <- next; return '\CR' `onFail` do 'A' <- next; 'N' <- next; return '\CAN' `wrap` "'\\CR' or '\\CAN'" mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL' `onFail` do 'L' <- next; 'E' <- next; return '\DLE' `onFail` do 'C' <- next; ( do '1' <- next; return '\DC1' `onFail` do '2' <- next; return '\DC2' `onFail` do '3' <- next; return '\DC3' `onFail` do '4' <- next; return '\DC4' ) `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'" mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX' `onFail` do 'O' <- next; 'T' <- next; return '\EOT' `onFail` do 'N' <- next; 'Q' <- next; return '\ENQ' `onFail` do 'T' <- next; 'B' <- next; return '\ETB' `onFail` do 'M' <- next; return '\EM' `onFail` do 'S' <- next; 'C' <- next; return '\ESC' `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'" mnemonic 'F' = do 'F' <- next; return '\FF' `onFail` do 'S' <- next; return '\FS' `wrap` "'\\FF' or '\\FS'" mnemonic 'G' = do 'S' <- next; return '\GS' `wrap` "'\\GS'" mnemonic 'H' = do 'T' <- next; return '\HT' `wrap` "'\\HT'" mnemonic 'L' = do 'F' <- next; return '\LF' `wrap` "'\\LF'" mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL' `onFail` do 'A' <- next; 'K' <- next; return '\NAK' `wrap` "'\\NUL' or '\\NAK'" mnemonic 'R' = do 'S' <- next; return '\RS' `wrap` "'\\RS'" mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH' `onFail` do 'O' <- next; return '\SO' `onFail` do 'T' <- next; 'X' <- next; return '\STX' `onFail` do 'I' <- next; return '\SI' `onFail` do 'Y' <- next; 'N' <- next; return '\SYN' `onFail` do 'U' <- next; 'B' <- next; return '\SUB' `onFail` do 'P' <- next; return '\SP' `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'" mnemonic 'U' = do 'S' <- next; return '\US' `wrap` "'\\US'" mnemonic 'V' = do 'T' <- next; return '\VT' `wrap` "'\\VT'" wrap p s = p `onFail` fail ("expected literal char "++s) -- Basic types instance Parse Int where -- parse = parseByRead "Int" -- convert from Integer, deals with minInt parse = fmap fromInteger $ do many (satisfy isSpace); parseSigned parseDec instance Parse Integer where -- parse = parseByRead "Integer" parse = do many (satisfy isSpace); parseSigned parseDec instance Parse Float where -- parse = parseByRead "Float" parse = do many (satisfy isSpace); parseSigned parseFloat instance Parse Double where -- parse = parseByRead "Double" parse = do many (satisfy isSpace); parseSigned parseFloat instance Parse Char where -- parse = parseByRead "Char" parse = do many (satisfy isSpace); parseLitChar' -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w) -- else fail "expected a 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 [] = Failure [] "no input: expected a ()" p ('(':cs) = case dropWhile isSpace cs of (')':s) -> Success s () _ -> Failure cs "Expected ) after (" p (c:cs) | isSpace c = p cs | otherwise = Failure (c:cs) ("Expected a (), got "++show c) 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 parsePrec p = optionalParens (do { isWord "Nothing"; return Nothing }) `onFail` parens (p>9) (do { isWord "Just" ; fmap Just $ parsePrec 10 `adjustErrBad` ("but within Just, "++) }) `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2) instance (Parse a, Parse b) => Parse (Either a b) where parsePrec p = parens (p>9) $ constructors [ ("Left", do { fmap Left $ parsePrec 10 } ) , ("Right", do { fmap Right $ parsePrec 10 } ) ] instance Parse a => Parse [a] where parse = parseList -- | Simply return the entire remaining input String. allAsString :: TextParser String allAsString = P (\s-> Success [] s) ------------------------------------------------------------------------ polyparse-1.13/src/Text/Parse/0000755000000000000000000000000007346545000014432 5ustar0000000000000000polyparse-1.13/src/Text/Parse/ByteString.hs0000644000000000000000000005640207346545000017067 0ustar0000000000000000module Text.Parse.ByteString ( -- * The Parse class is a replacement for the standard Read class. -- This particular instance reads from ByteString rather than String. -- $parser TextParser -- synonym for Text.ParserCombinators.Poly.ByteString , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a], -- Int, Integer, Float, Double, Char, Bool , parseByRead -- :: Read a => String -> TextParser a , readByParse -- :: TextParser a -> ReadS a , readsPrecByParsePrec -- :: (Int->TextParser a) -> Int -> ReadS a -- ** Combinators specific to bytestring input, lexed haskell-style , word -- :: TextParser String , isWord -- :: String -> TextParser () , literal -- :: String -> TextParser () , optionalParens -- :: TextParser a -> TextParser a , parens -- :: Bool -> TextParser a -> TextParser a , field -- :: Parse a => String -> TextParser a , constructors-- :: [(String,TextParser a)] -> TextParser a , enumeration -- :: Show a => String -> [a] -> TextParser a -- ** Parsers for literal numerics and characters , parseSigned , parseInt , parseDec , parseOct , parseHex , parseUnsignedInteger , parseFloat , parseLitChar , parseLitChar' -- ** Re-export all the more general combinators from Poly too , module Text.ParserCombinators.Poly.ByteStringChar -- ** ByteStrings and Strings as whole entities , allAsByteString , allAsString ) where import Data.Char as Char (isUpper,isDigit,isOctDigit,isHexDigit,digitToInt ,isSpace,isAlpha,isAlphaNum,ord,chr,toLower) import Data.List (intersperse) import Data.Ratio import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) import Text.ParserCombinators.Poly.ByteStringChar ------------------------------------------------------------------------ -- $parser -- The Parse class is a replacement for the standard Read class. It is a -- specialisation of the (poly) Parser monad for ByteString 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 a ByteString Parser, i.e. bytestring input (no state) type TextParser a = Parser 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 -- | A straightforward parser for an item. (A minimal definition of -- a class instance requires either |parse| or |parsePrec|. In general, -- for a type that never needs parens, you should define |parse|, but -- for a type that _may_ need parens, you should define |parsePrec|.) parse :: TextParser a parse = parsePrec 0 -- | A straightforward parser for an item, given the precedence of -- any surrounding expression. (Precedence determines whether -- parentheses are mandatory or optional.) parsePrec :: Int -> TextParser a parsePrec _ = optionalParens parse -- | Parsing a list of items by default accepts the [] and comma syntax, -- except when the list is really a character string using \"\". parseList :: TextParser [a] -- only to distinguish [] and "" parseList = do { isWord "[]"; return [] } `onFail` do { isWord "["; isWord "]"; return [] } `onFail` bracketSep (isWord "[") (isWord ",") (isWord "]") (optionalParens 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. The string argument -- is the expected type or value (for error-reporting only). Use of this -- wrapper function is NOT recommended with ByteString, because there -- is a lot of inefficiency in repeated conversions to/from String. parseByRead :: Read a => String -> TextParser a parseByRead name = P (\s-> case reads (BS.unpack s) of [] -> Failure s ("no parse, expected a "++name) [(a,s')] -> Success (BS.pack s') a _ -> Failure s ("ambiguous parse, expected a "++name) ) -- | If you have a TextParser for a type, you can easily make it into -- a Read instance, by throwing away any error messages. Use of this -- wrapper function is NOT recommended with ByteString, because there -- is a lot of inefficiency in conversions to/from String. readByParse :: TextParser a -> ReadS a readByParse p = \inp-> case runParser p (BS.pack inp) of (Left err, rest) -> [] (Right val, rest) -> [(val, BS.unpack rest)] -- | If you have a TextParser for a type, you can easily make it into -- a Read instance, by throwing away any error messages. Use of this -- wrapper function is NOT recommended with ByteString, because there -- is a lot of inefficiency in conversions to/from String. readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a readsPrecByParsePrec p = \prec inp-> case runParser (p prec) (BS.pack inp) of (Left err, rest) -> [] (Right val, rest) -> [(val, BS.unpack rest)] -- | One lexical chunk (Haskell-style lexing). word :: TextParser String {- word = P (\s-> case lex (BS.unpack s) of [] -> Failure s ("no input? (impossible)") [("","")] -> Failure s ("no input?") [("",_)] -> Failure s ("lexing failed?") ((x,_):_) -> Success (BS.drop (fromIntegral (length x)) s) x ) -} word = P (p . BS.dropWhile isSpace) where p s | BS.null s = Failure BS.empty "end of input" | otherwise = case (BS.head s, BS.tail s) of ('\'',t) -> let (P lit) = parseLitChar' in fmap show (lit s) ('\"',t) -> let (str,rest) = BS.span (not . (`elem` "\\\"")) t in litString ('\"': BS.unpack str) rest ('0',s) -> case BS.uncons s of Just ('x',r) -> Success t ("0x"++BS.unpack ds) where (ds,t) = BS.span isHexDigit r Just ('X',r) -> Success t ("0X"++BS.unpack ds) where (ds,t) = BS.span isHexDigit r Just ('o',r) -> Success t ("0o"++BS.unpack ds) where (ds,t) = BS.span isOctDigit r Just ('O',r) -> Success t ("0O"++BS.unpack ds) where (ds,t) = BS.span isOctDigit r _ -> lexFracExp ('0': BS.unpack ds) t where (ds,t) = BS.span isDigit s (c,s) | isIdInit c -> let (nam,t) = BS.span isIdChar s in Success t (c: BS.unpack nam) | isDigit c -> let (ds,t) = BS.span isDigit s in lexFracExp (c: BS.unpack ds) t | isSingle c -> Success s (c:[]) | isSym c -> let (sym,t) = BS.span isSym s in Success t (c: BS.unpack sym) | otherwise -> Failure (BS.cons c s) ("Bad character: "++show c) isSingle c = c `elem` ",;()[]{}`" isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~" isIdInit c = isAlpha c || c == '_' isIdChar c = isAlphaNum c || c `elem` "_'" lexFracExp acc s = case BS.uncons s of Just ('.',s') -> case BS.uncons s' of Just (d,s'') | isDigit d -> let (ds,t) = BS.span isDigit s'' in lexExp (acc++'.':d: BS.unpack ds) t _ -> lexExp acc s' _ -> lexExp acc s lexExp acc s = case BS.uncons s of Just (e,s') | e `elem` "eE" -> case BS.uncons s' of Just (sign,dt) | sign `elem` "+-" -> case BS.uncons dt of Just (d,t) | isDigit d -> let (ds,u) = BS.span isDigit t in Success u (acc++'e': sign: d: BS.unpack ds) | isDigit sign -> let (ds,u) = BS.span isDigit dt in Success u (acc++'e': sign: BS.unpack ds) _ -> Failure s' ("missing +/-/digit " ++"after e in float literal: " ++show (acc++'e':"...")) _ -> Success s acc litString acc s = case BS.uncons s of Nothing -> Failure (BS.empty) ("end of input in string literal "++acc) Just ('\"',r) -> Success r (acc++"\"") Just ('\\',r) -> let (P lit) = parseLitChar in case lit s of Failure a b -> Failure a b Success t char -> let (u,v) = BS.span (`notElem`"\\\"") t in litString (acc++[char]++BS.unpack u) v Just (_,r) -> error "Text.Parse.word(litString) - can't happen" -- | 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') } -- | Ensure that the next input word is the given string. (No -- lexing, so mixed spaces, symbols, are accepted.) literal :: String -> TextParser String literal w = do { w' <- exactly (length w) next ; if w'==w then return w else fail ("expected "++w++" got "++w') } -- | Allow optional nested string parens around an item. optionalParens :: TextParser a -> TextParser a optionalParens p = parens False p -- | Allow nested parens around an item (one set required when Bool is True). parens :: Bool -> TextParser a -> TextParser a parens True p = bracket (isWord "(") (isWord ")") (parens False p) parens False p = parens True 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. -- Numeric types -- | For any numeric parser, permit a negation sign in front of it. parseSigned :: Real a => TextParser a -> TextParser a parseSigned p = do '-' <- next; commit (fmap negate p) `onFail` do p -- | Parse any (unsigned) Integral numeric literal. -- Needs a base, radix, isDigit predicate, -- and digitToInt converter, appropriate to the result type. parseInt :: (Integral a) => String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a parseInt base radix isDigit digitToInt = do cs <- many1 (satisfy isDigit) return (foldl1 (\n d-> n*radix+d) (map (fromIntegral.digitToInt) cs)) `adjustErr` (++("\nexpected one or more "++base++" digits")) -- | Parse a decimal, octal, or hexadecimal (unsigned) Integral numeric literal. parseDec, parseOct, parseHex :: (Integral a) => TextParser a parseDec = parseInt "decimal" 10 Char.isDigit Char.digitToInt parseOct = parseInt "octal" 8 Char.isOctDigit Char.digitToInt parseHex = parseInt "hex" 16 Char.isHexDigit Char.digitToInt -- | parseUnsignedInteger uses the underlying ByteString readInteger, so -- will be a lot faster than the generic character-by-character parseInt. parseUnsignedInteger :: TextParser Integer parseUnsignedInteger = P (\bs -> case BS.uncons bs of Just (c, _) | Char.isDigit c -> case BS.readInteger bs of Just (i, bs') -> Success bs' i Nothing -> error "XXX Can't happen" _ -> Failure bs "parsing Integer: not a digit") `adjustErr` (++("\nexpected one or more decimal digits")) -- | Parse any (unsigned) Floating numeric literal, e.g. Float or Double. parseFloat :: (RealFrac a) => TextParser a parseFloat = do ds <- many1Satisfy isDigit frac <- (do '.' <- next manySatisfy isDigit `adjustErrBad` (++"expected digit after .") `onFail` return BS.empty ) exp <- exponent `onFail` return 0 ( return . fromRational . (* (10^^(exp - BS.length frac))) . (%1) . (\ (Right x)->x) . fst . runParser parseDec ) (ds `BS.append` frac) `onFail` do w <- manySatisfy isAlpha case map toLower (BS.unpack w) of "nan" -> return (0/0) "infinity" -> return (1/0) _ -> fail "expected a floating point number" where exponent = do 'e' <- fmap toLower next commit (do '+' <- next; parseDec `onFail` parseSigned parseDec ) -- | Parse a Haskell character literal, including surrounding single quotes. parseLitChar' :: TextParser Char parseLitChar' = do '\'' <- next `adjustErr` (++"expected a literal char") char <- parseLitChar '\'' <- next `adjustErrBad` (++"literal char has no final '") return char -- | Parse a Haskell character literal, excluding surrounding single quotes. parseLitChar :: TextParser Char parseLitChar = do c <- next char <- case c of '\\' -> next >>= escape '\'' -> fail "expected a literal char, got ''" _ -> return c return char where escape 'a' = return '\a' escape 'b' = return '\b' escape 'f' = return '\f' escape 'n' = return '\n' escape 'r' = return '\r' escape 't' = return '\t' escape 'v' = return '\v' escape '\\' = return '\\' escape '"' = return '"' escape '\'' = return '\'' escape '^' = do ctrl <- next if ctrl >= '@' && ctrl <= '_' then return (chr (ord ctrl - ord '@')) else fail ("literal char ctrl-escape malformed: \\^" ++[ctrl]) escape d | isDigit d = fmap chr $ (reparse (BS.pack [d]) >> parseDec) escape 'o' = fmap chr $ parseOct escape 'x' = fmap chr $ parseHex escape c | isUpper c = mnemonic c escape c = fail ("unrecognised escape sequence in literal char: \\"++[c]) mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK' `wrap` "'\\ACK'" mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL' `onFail` do 'S' <- next; return '\BS' `wrap` "'\\BEL' or '\\BS'" mnemonic 'C' = do 'R' <- next; return '\CR' `onFail` do 'A' <- next; 'N' <- next; return '\CAN' `wrap` "'\\CR' or '\\CAN'" mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL' `onFail` do 'L' <- next; 'E' <- next; return '\DLE' `onFail` do 'C' <- next; ( do '1' <- next; return '\DC1' `onFail` do '2' <- next; return '\DC2' `onFail` do '3' <- next; return '\DC3' `onFail` do '4' <- next; return '\DC4' ) `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'" mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX' `onFail` do 'O' <- next; 'T' <- next; return '\EOT' `onFail` do 'N' <- next; 'Q' <- next; return '\ENQ' `onFail` do 'T' <- next; 'B' <- next; return '\ETB' `onFail` do 'M' <- next; return '\EM' `onFail` do 'S' <- next; 'C' <- next; return '\ESC' `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'" mnemonic 'F' = do 'F' <- next; return '\FF' `onFail` do 'S' <- next; return '\FS' `wrap` "'\\FF' or '\\FS'" mnemonic 'G' = do 'S' <- next; return '\GS' `wrap` "'\\GS'" mnemonic 'H' = do 'T' <- next; return '\HT' `wrap` "'\\HT'" mnemonic 'L' = do 'F' <- next; return '\LF' `wrap` "'\\LF'" mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL' `onFail` do 'A' <- next; 'K' <- next; return '\NAK' `wrap` "'\\NUL' or '\\NAK'" mnemonic 'R' = do 'S' <- next; return '\RS' `wrap` "'\\RS'" mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH' `onFail` do 'O' <- next; return '\SO' `onFail` do 'T' <- next; 'X' <- next; return '\STX' `onFail` do 'I' <- next; return '\SI' `onFail` do 'Y' <- next; 'N' <- next; return '\SYN' `onFail` do 'U' <- next; 'B' <- next; return '\SUB' `onFail` do 'P' <- next; return '\SP' `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'" mnemonic 'U' = do 'S' <- next; return '\US' `wrap` "'\\US'" mnemonic 'V' = do 'T' <- next; return '\VT' `wrap` "'\\VT'" wrap p s = p `onFail` fail ("expected literal char "++s) -- Basic types instance Parse Int where parse = fmap fromInteger $ -- convert from Integer, deals with minInt do manySatisfy isSpace; parseSigned parseUnsignedInteger instance Parse Integer where parse = do manySatisfy isSpace; parseSigned parseUnsignedInteger instance Parse Float where parse = do manySatisfy isSpace; parseSigned parseFloat instance Parse Double where parse = do manySatisfy isSpace; parseSigned parseFloat instance Parse Char where parse = do manySatisfy isSpace; parseLitChar' -- 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 . BS.uncons) where p Nothing = Failure BS.empty "no input: expected a ()" p (Just ('(',cs)) = case BS.uncons (BS.dropWhile isSpace cs) of Just (')',s) -> Success s () _ -> Failure cs "Expected ) after (" p (Just (c,cs)) | isSpace c = p (BS.uncons cs) | otherwise = Failure (BS.cons c cs) ("Expected a (), got "++show c) 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 parsePrec p = optionalParens (do { isWord "Nothing"; return Nothing }) `onFail` parens (p>9) (do { isWord "Just" ; fmap Just $ parsePrec 10 `adjustErrBad` ("but within Just, "++) }) `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2) instance (Parse a, Parse b) => Parse (Either a b) where parsePrec p = parens (p>9) $ constructors [ ("Left", do { fmap Left $ parsePrec 10 } ) , ("Right", do { fmap Right $ parsePrec 10 } ) ] instance Parse a => Parse [a] where parse = parseList ------------------------------------------------------------------------ -- ByteStrings as a whole entity. -- | Simply return the remaining input ByteString. allAsByteString :: TextParser ByteString allAsByteString = P (\bs-> Success BS.empty bs) -- | Simply return the remaining input as a String. allAsString :: TextParser String allAsString = fmap BS.unpack allAsByteString ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/0000755000000000000000000000000007346545000017015 5ustar0000000000000000polyparse-1.13/src/Text/ParserCombinators/HuttonMeijer.hs0000644000000000000000000001755107346545000021777 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 Data.Char import Control.Applicative ( Applicative(pure,(<*>)), Alternative(empty,(<|>)) ) import Control.Monad import qualified Control.Monad.Fail as Fail 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 Applicative Parser where pure v = P (\inp -> [(v,inp)]) (<*>) = ap instance Monad Parser where -- return :: a -> Parser a return = pure -- >>= :: Parser a -> (a -> Parser b) -> Parser b (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp]) #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail Parser where -- fail :: String -> Parser a fail _ = P (\_ -> []) instance Alternative Parser where empty = mzero (<|>) = mplus 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}) ------------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/HuttonMeijerWallace.hs0000644000000000000000000003131507346545000023262 0ustar0000000000000000{----------------------------------------------------------------------------- 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 state in the 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 Data.Char import Control.Applicative ( Applicative(pure,(<*>)), Alternative(empty,(<|>)) ) import Control.Monad import qualified Control.Monad.Fail as Fail 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 Applicative (Parser s t e) where pure v = P (\st inp -> Right [(v,st,inp)]) (<*>) = ap instance Monad (Parser s t e) where -- return :: a -> Parser s t e a return = pure -- >>= :: 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 ) #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (Parser s t e) where -- 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 Alternative (Parser s t e) where empty = mzero (<|>) = mplus 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)]) ------------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly.hs0000644000000000000000000000020407346545000020270 0ustar0000000000000000module Text.ParserCombinators.Poly ( module Text.ParserCombinators.Poly.Plain ) where import Text.ParserCombinators.Poly.Plain polyparse-1.13/src/Text/ParserCombinators/Poly/0000755000000000000000000000000007346545000017740 5ustar0000000000000000polyparse-1.13/src/Text/ParserCombinators/Poly/Base.hs0000644000000000000000000002375407346545000021161 0ustar0000000000000000module Text.ParserCombinators.Poly.Base ( -- * The PolyParse classes Commitment(..) -- class of all two-level-error values , PolyParse -- class of all monadic two-level-error parsers -- * Combinators general to all parser types. -- ** Simple combinators , apply -- :: PolyParse p => p (a->b) -> p a -> p b , discard -- :: PolyParse p => p a -> p b -> p a -- ** Error-handling , failBad -- :: PolyParse p => String -> p a , adjustErrBad-- :: PolyParse p => p a -> (String->String) -> p a , indent -- :: Int -> String -> String -- ** Choices , oneOf -- :: PolyParse p => [p a] -> p a -- ** Sequences , exactly -- :: PolyParse p => Int -> p a -> p [a] , upto -- :: PolyParse p => Int -> p a -> p [a] , many1 -- :: PolyParse p => p a -> p [a] , sepBy -- :: PolyParse p => p a -> p sep -> p [a] , sepBy1 -- :: PolyParse p => p a -> p sep -> p [a] , bracketSep -- :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a] , bracket -- :: PolyParse p => p bra -> p ket -> p a -> p a , manyFinally -- :: PolyParse p => p a -> p z -> p [a] , manyFinally'-- :: PolyParse p => p a -> p z -> p [a] ) where import Control.Applicative import qualified Control.Monad.Fail as Fail #ifdef __NHC__ default (Integer,Double,[]) -- hack to avoid bizarre type defaulting error instance Commitment [] instance PolyParse [] #endif -- | The @Commitment@ class is an abstraction over all the current -- concrete representations of monadic/applicative parser combinators in this -- package. The common feature is two-level error-handling. -- Some primitives must be implemented specific to each parser type -- (e.g. depending on whether the parser has a running state, or -- whether it is lazy). But given those primitives, large numbers of -- combinators do not depend any further on the internal structure of -- the particular parser. class Commitment p where -- | 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 :: p a -> p a -- | @p `adjustErr` f@ applies the transformation @f@ to any error message -- generated in @p@, having no effect if @p@ succeeds. adjustErr :: p a -> (String -> String) -> p a -- | 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, p a)] -> p a -- | The @PolyParse@ class is an abstraction gathering all of the common -- features that a two-level error-handling parser requires: -- the applicative parsing interface, the monadic interface, and commitment. -- -- There are two additional basic combinators that we expect to be implemented -- afresh for every concrete type, but which (for technical reasons) -- cannot be class methods. They are @next@ and @satisfy@. class (Functor p, Monad p, Fail.MonadFail p, Applicative p, Alternative p, Commitment p) => PolyParse p infixl 3 `apply` infixl 3 `discard` -- | Apply a parsed function to a parsed value. -- Rather like ordinary function application lifted into parsers. apply :: PolyParse p => p (a->b) -> p a -> p b apply = (<*>) -- | @x `discard` y@ parses both x and y, but discards the result of y. -- Rather like @const@ lifted into parsers. discard :: PolyParse p => p a -> p b -> p a px `discard` py = do { x <- px; y <- py; y `seq` return x; } {- -- Combinators we expect most concrete parser types to implement. -- For technical reasons, they cannot be class members. -- | Yield the next token next :: PolyParse p => p t -- where t is constrained to be the input token type -- | One token satisfying a predicate. satisfy :: PolyParse p => (t->Bool) -> p t t satisfy p = do{ x <- next ; if p x then return x else fail "Parse.satisfy: failed" } -- note: must be re-defined for each implementation because -- its type cannot be expressed otherwise. -} -- | When a simple fail is not strong enough, use failBad for emphasis. -- An emphasised (severe) error cannot be overridden by choice -- operators. failBad :: PolyParse p => String -> p a failBad e = commit (Fail.fail e) -- | @adjustErrBad@ is just like @adjustErr@ except it also raises the -- severity of the error. adjustErrBad :: PolyParse p => p a -> (String->String) -> p a p `adjustErrBad` f = commit (p `adjustErr` f) -- | Parse the first alternative in the list that succeeds. oneOf :: PolyParse p => [p a] -> p a oneOf [] = Fail.fail ("failed to parse any of the possible choices") oneOf (p:ps) = p <|> oneOf ps --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 -- | Helper for formatting error messages: indents all lines by a fixed amount. indent :: Int -> String -> String indent n = unlines . map (replicate n ' ' ++) . lines -- | 'exactly n p' parses precisely n items, using the parser p, in sequence. exactly :: PolyParse p => Int -> p a -> p [a] exactly 0 p = return [] exactly n p = return (:) `apply` (p `adjustErr` (("When expecting exactly " ++show n++" more items")++)) `apply` exactly (n-1) p -- | 'upto n p' parses n or fewer items, using the parser p, in sequence. upto :: PolyParse p => Int -> p a -> p [a] upto 0 p = return [] upto n p = do x <- p; return (x:) `apply` upto (n-1) p <|> return [] {- is in Control.Applicative -- | 'optional' indicates whether the parser succeeded through the Maybe type. optional :: PolyParse p => p a -> p (Maybe a) optional p = fmap Just p `onFail` return Nothing -} {- is in Control.Applicative -- | 'many p' parses a list of elements with individual parser p. -- Cannot fail, since an empty list is a valid return value. many :: PolyParse p => p a -> p [a] many p = many1 p `onFail` return [] -} -- | Parse a non-empty list of items. many1 :: PolyParse p => p a -> p [a] many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) ; return (x:) `apply` many p } -- `adjustErr` ("When looking for a non-empty sequence:\n\t"++) -- | Parse a list of items separated by discarded junk. sepBy :: PolyParse p => p a -> p sep -> p [a] sepBy p sep = do sepBy1 p sep <|> return [] -- | Parse a non-empty list of items separated by discarded junk. sepBy1 :: PolyParse p => p a -> p sep -> p [a] sepBy1 p sep = do { x <- p ; return (x:) `apply` many (do {sep; p}) } `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 :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a] bracketSep open sep close p = do { open; close; return [] } <|> do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++) ; return (x:) `apply` manyFinally (do {sep; p}) (close `adjustErrBad` ("When looking for closing bracket:\n\t"++)) } -- | Parse a bracketed item, discarding the brackets. -- If everything matches /except/ the closing bracket, the whole -- parse fails soft, which can give less-than-satisfying error messages. -- If you want better error messages, try calling with e.g. -- @bracket open (commit close) item@ bracket :: PolyParse p => p bra -> p ket -> p a -> p a bracket open close p = do do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; p `discard` (close `adjustErr` ("Missing closing bracket:\n\t"++)) } -- | @manyFinally e t@ parses a possibly-empty sequence of @e@'s, -- terminated by a @t@. The final @t@ is discarded. Any parse failures -- could be due either to a badly-formed terminator or a badly-formed -- element, so it raises both possible errors. manyFinally :: PolyParse p => p a -> p z -> p [a] {- -- This implementation is incorrect. If at least one item has been -- parsed, but the terminator is missing, then this erroneously succeeds -- returning the empty list. manyFinally p t = (many p `discard` t) <|> oneOf' [ ("sequence terminator", do { t; return [] } ) , ("item in a sequence", do { p; return [] } ) ] -} manyFinally p t = do { xs <- many p ; oneOf' [ ("sequence terminator", do { t; return () } ) , ("item in a sequence", do { p; return () } ) ] ; return xs } -- | @manyFinally'@ is like @manyFinally@, except when the terminator -- parser overlaps with the element parser. In @manyFinally e t@, -- the parser @t@ is tried only when parser @e@ fails, whereas in -- @manyFinally' e t@, the parser @t@ is always tried first, then -- parser @e@ only if the terminator is not found. For instance, -- @manyFinally (accept "01") (accept "0")@ on input @"0101010"@ returns -- @["01","01","01"]@, whereas @manyFinally'@ with the same arguments -- and input returns @[]@. manyFinally' :: (PolyParse p, Show a) => p a -> p z -> p [a] manyFinally' p t = fmap reverse $ go [] where go acc = ( do t; return acc ) <|> ( do { x <- p <|> oneOf' [ ( "terminator in a manyFinally' sequence" , do { t; return undefined } ) , ( "item in a manyFinally' sequence", p) ] `adjustErr` (("After successful partial sequence " ++show (reverse acc)++",\n")++) ; go (x: acc) } ) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/ByteString.hs0000644000000000000000000001241207346545000022366 0ustar0000000000000000module Text.ParserCombinators.Poly.ByteString ( -- * The Parser datatype Parser(P) , Result(..) , runParser -- ** Basic parsers , next , eof , satisfy , onFail -- ** Derived parsers (but implemented more efficiently) , manySatisfy , many1Satisfy -- ** Re-parsing , reparse -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import qualified Data.ByteString.Lazy as BS import Data.ByteString.Lazy (ByteString) import Control.Applicative import qualified Control.Monad.Fail as Fail import Data.Word -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. Whereas the standard version can be used for arbitrary -- token types, this version is specialised to ByteString input only. newtype Parser a = P (ByteString -> Result ByteString a) -- | Apply a parser to an input token sequence. runParser :: Parser a -> ByteString -> (Either String a, ByteString) runParser (P p) = resultToEither . p instance Functor Parser where fmap f (P p) = P (fmap f . p) instance Monad Parser where return = pure (P f) >>= g = P (continue . f) where continue (Success ts x) = let (P g') = g x in g' ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail Parser where fail e = P (\ts-> Failure ts e) instance Commitment Parser where commit (P p) = P (Committed . squash . p) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (adjust . p) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\ts-> case p ts of Failure _ err -> let (P p') = accum ((e,err):errs) ps in p' ts r@(Success _ _) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err instance Applicative Parser where pure x = P (\ts-> Success ts x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative Parser where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse Parser ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser Word8 next = P (\bs-> case BS.uncons bs of Nothing -> Failure bs "Ran out of input (EOF)" Just (h, t) -> Success t h ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser () eof = P (\bs -> if BS.null bs then Success bs () else Failure bs "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } -- | @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 a -> Parser a -> Parser a (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) where continue ts (Failure _ _) = q ts -- continue _ (Committed r) = r -- no, remain Committed continue _ r = r ------------------------------------------------------------------------ -- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ manySatisfy :: (Word8->Bool) -> Parser ByteString manySatisfy f = P (\bs-> let (pre,suf) = BS.span f bs in Success suf pre) -- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ many1Satisfy :: (Word8->Bool) -> Parser ByteString many1Satisfy f = do x <- manySatisfy f if BS.null x then fail "Parse.many1Satisfy: failed" else return x ------------------------------------------------------------------------ -- | 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 :: ByteString -> Parser () reparse ts = P (\inp-> Success (ts `BS.append` inp) ()) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/ByteStringChar.hs0000644000000000000000000001240407346545000023165 0ustar0000000000000000module Text.ParserCombinators.Poly.ByteStringChar ( -- * The Parser datatype Parser(P) , Result(..) , runParser -- ** Basic parsers , next , eof , satisfy , onFail -- ** Derived parsers (but implemented more efficiently) , manySatisfy , many1Satisfy -- ** Re-parsing , reparse -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) import Control.Applicative import qualified Control.Monad.Fail as Fail -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. Whereas the standard version can be used for arbitrary -- token types, this version is specialised to ByteString input only. newtype Parser a = P (ByteString -> Result ByteString a) -- | Apply a parser to an input token sequence. runParser :: Parser a -> ByteString -> (Either String a, ByteString) runParser (P p) = resultToEither . p instance Functor Parser where fmap f (P p) = P (fmap f . p) instance Monad Parser where return = pure (P f) >>= g = P (continue . f) where continue (Success ts x) = let (P g') = g x in g' ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail Parser where fail e = P (\ts-> Failure ts e) instance Commitment Parser where commit (P p) = P (Committed . squash . p) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (adjust . p) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\ts-> case p ts of Failure _ err -> let (P p') = accum ((e,err):errs) ps in p' ts r@(Success _ _) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err instance Applicative Parser where pure x = P (\ts-> Success ts x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative Parser where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse Parser ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser Char next = P (\bs-> case BS.uncons bs of Nothing -> Failure bs "Ran out of input (EOF)" Just (h, t) -> Success t h ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser () eof = P (\bs -> if BS.null bs then Success bs () else Failure bs "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (Char -> Bool) -> Parser Char satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } -- | @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 a -> Parser a -> Parser a (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) where continue ts (Failure _ _) = q ts -- continue _ (Committed r) = r -- no, remain Committed continue _ r = r ------------------------------------------------------------------------ -- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ manySatisfy :: (Char->Bool) -> Parser ByteString manySatisfy f = P (\bs-> let (pre,suf) = BS.span f bs in Success suf pre) -- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ many1Satisfy :: (Char->Bool) -> Parser ByteString many1Satisfy f = do x <- manySatisfy f if BS.null x then fail "Parse.many1Satisfy: failed" else return x ------------------------------------------------------------------------ -- | 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 :: ByteString -> Parser () reparse ts = P (\inp-> Success (ts `BS.append` inp) ()) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Lazy.hs0000644000000000000000000001077007346545000021220 0ustar0000000000000000{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} module Text.ParserCombinators.Poly.Lazy ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the parser monad , runParser -- :: Parser t a -> [t] -> (Either String a, [t]) -- ** Basic parsers , next -- :: Parser t t , eof -- :: Parser t () , satisfy -- :: (t->Bool) -> Parser t t , satisfyMsg -- :: (t->Bool) -> String -> Parser t t , onFail -- :: Parser t a -> Parser t a -> Parser t a -- ** Re-parsing , reparse -- :: [t] -> Parser t () -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import qualified Text.ParserCombinators.Poly.Parser as P import Control.Applicative import qualified Control.Monad.Fail as Fail #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 -- | The only differences between a Plain and a Lazy parser are the instance -- of Applicative, and the type (and implementation) of runParser. -- We therefore need to /newtype/ the original Parser type, to allow it -- to have a different instance. newtype Parser t a = P (P.Parser t a) #ifdef __GLASGOW_HASKELL__ deriving (Functor,Monad,Fail.MonadFail,Commitment) #else instance Functor (Parser t) where fmap f (P p) = P (fmap f p) instance Monad (Parser t) where return x = P (return x) fail = Fail.fail (P f) >>= g = P (f >>= (\(P g')->g') . g) instance Fail.MonadFail (Parser t) where fail e = P (fail e) instance Commitment (Parser t) where commit (P p) = P (commit p) (P p) `adjustErr` f = P (p `adjustErr` f) #endif -- | Apply a parser to an input token sequence. runParser :: Parser t a -> [t] -> (a, [t]) runParser (P (P.P p)) = fromResult . p where fromResult :: Result z a -> (a, z) fromResult (Success z a) = (a, z) fromResult (Failure z e) = throwE e fromResult (Committed r) = fromResult r instance Applicative (Parser t) where pure f = return f -- Apply a parsed function to a parsed value. This version -- is strict in the result of the function parser, but -- lazy in the result of the argument parser. (Argument laziness is -- the distinctive feature over other implementations.) (P (P.P pf)) <*> px = P (P.P (continue . pf)) where continue (Success z f) = let (x,z') = runParser px z in Success z' (f x) continue (Committed r) = Committed (continue r) continue (Failure z e) = Failure z e #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative (Parser t) where empty = fail "no parse" (P p) <|> (P q) = P (p `P.onFail` q) instance PolyParse (Parser t) ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser t t next = P P.next -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser t () eof = P P.eof -- | Return the next token if it satisfies the given predicate. satisfy :: (t->Bool) -> Parser t t satisfy = P . P.satisfy -- | Return the next token if it satisfies the given predicate. The String -- argument describes the predicate for better error messages. satisfyMsg :: Show t => (t->Bool) -> String -> Parser t t satisfyMsg p s = P (P.satisfyMsg p s) -- | @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 onFail (P a) (P b) = P (a `P.onFail` b) -- | 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 = P . P.reparse ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Lex.hs0000644000000000000000000001331007346545000021022 0ustar0000000000000000-- Author: Malcolm Wallace -- | In a strict language, where creating the entire input list of tokens -- in one shot may be infeasible, we can use a lazy "callback" kind of -- architecture instead. The lexer returns a single token at a time, -- together with a continuation. -- -- This module defines a Parser type (capable of use with the Poly -- combinators), specialised to the callback-lexer style of input stream. module Text.ParserCombinators.Poly.Lex ( -- * The Parser datatype LexReturn(..) , Parser(P) , Result(..) , runParser -- ** Basic parsers , next , eof , satisfy , onFail -- ** Re-parsing , reparse -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import Control.Applicative import qualified Control.Monad.Fail as Fail -- | In a strict language, where creating the entire input list of tokens -- in one shot may be infeasible, we can use a lazy "callback" kind of -- architecture instead. The lexer returns a single token at a time, -- together with a continuation. The @next@ parser is responsible for -- pulling on the token stream, applying the continuation where necessary. data LexReturn t = LexReturn t String (String->LexReturn t) | LexFinish -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. This version is specialised to pre-lexed String input, -- where the lexer has been written to yield a @LexReturn@. newtype Parser t a = P (LexReturn t -> Result (LexReturn t) a) -- | Apply a parser to an input token sequence. runParser :: Parser t a -> LexReturn t -> (Either String a, String) runParser (P p) = (\ (a,b)->(a,stripLex b)) . resultToEither . p where stripLex LexFinish = "" stripLex (LexReturn _ s _) = s instance Functor (Parser t) where fmap f (P p) = P (fmap f . p) instance Monad (Parser t) where return = pure (P f) >>= g = P (continue . f) where continue (Success ts x) = let (P g') = g x in g' ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (Parser t) where fail e = P (\ts-> Failure ts e) instance Commitment (Parser t) where commit (P p) = P (Committed . squash . p) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (adjust . p) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++(indent 2 . unlines . map showErr . reverse $ errs)) accum errs ((e,P p):ps) = P (\ts-> case p ts of Failure _ err -> let (P p') = accum ((e,err):errs) ps in p' ts r@(Success _ _) -> r r@(Committed _) -> r ) showErr (name,err) = name ++ "\n" ++ indent 2 err 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. (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) where continue ts (Failure _ _) = q ts -- continue _ (Committed r) = r -- no, remain Committed continue _ r = r instance Applicative (Parser t) where pure x = P (\ts-> Success ts x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative (Parser t) where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse (Parser t) ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser t t next = P (\ts-> case ts of LexFinish -> Failure ts "Ran out of input (EOF)" LexReturn t s k -> Success (k s) t) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser t () eof = P (\ts -> case ts of LexFinish -> Success ts () LexReturn _ _ _ -> Failure ts "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (t -> Bool) -> Parser t t satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } ------------------------------------------------------------------------ -- | 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-> Success (ts `prefix` inp) ()) where (t:ts) `prefix` k = LexReturn t "" (const (ts `prefix` k)) [] `prefix` k = k ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Parser.hs0000644000000000000000000001251307346545000021532 0ustar0000000000000000-- | This module contains the definitions for a generic parser, without -- running state. These are the parts that are shared between the Plain -- and Lazy variations. Do not import this module directly, but only -- via T.P.Poly.Plain or T.P.Poly.Lazy. module Text.ParserCombinators.Poly.Parser ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the Parser Monad. -- ** Basic parsers , next -- :: Parser t t , eof -- :: Parser t () , satisfy -- :: (t->Bool) -> Parser t t , satisfyMsg -- :: Show t => (t->Bool) -> String -> Parser t t , onFail -- :: Parser t a -> Parser t a -> Parser t a -- ** Re-parsing , reparse -- :: [t] -> Parser t () ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import Control.Applicative import qualified Control.Monad.Fail as Fail -- | This @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 Poly.State -- instead) newtype Parser t a = P ([t] -> Result [t] a) instance Functor (Parser t) where fmap f (P p) = P (fmap f . p) instance Applicative (Parser t) where pure x = P (\ts-> Success ts x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Monad (Parser t) where return = pure (P f) >>= g = P (continue . f) where continue (Success ts x) = let (P g') = g x in g' ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (Parser t) where fail e = P (\ts-> Failure ts e) instance Alternative (Parser t) where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse (Parser t) instance Commitment (Parser t) where commit (P p) = P (Committed . squash . p) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (adjust . p) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\ts-> case p ts of Failure _ err -> let (P p) = accum ((e,err):errs) ps in p ts r@(Success z a) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err 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-> continue ts $ p ts) where continue ts (Failure z e) = q ts -- continue _ (Committed r) = r -- no, remain Committed continue _ r = r ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser t t next = P (\ts-> case ts of [] -> Failure [] "Ran out of input (EOF)" (t:ts') -> Success ts' t ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser t () eof = P (\ts-> case ts of [] -> Success [] () (t:ts') -> Failure ts "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (t->Bool) -> Parser t t satisfy pred = do { x <- next ; if pred x then return x else fail "Parse.satisfy: failed" } -- | Return the next token if it satisfies the given predicate. The -- String argument describes the function, for better error messages. satisfyMsg :: Show t => (t->Bool) -> String -> Parser t t satisfyMsg pred s = do { x <- next ; if pred x then return x else fail $ "Parse.satisfy ("++s++") (" ++show x++"): failed" } ------------------------------------------------------------------------ -- | 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-> Success (ts++inp) ()) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Plain.hs0000644000000000000000000000223607346545000021342 0ustar0000000000000000module Text.ParserCombinators.Poly.Plain ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the Parser Monad. , runParser -- :: Parser t a -> [t] -> (Either String a, [t]) -- ** Basic parsers , next -- :: Parser t t , eof -- :: Parser t () , satisfy -- :: (t->Bool) -> Parser t t , satisfyMsg -- :: (t->Bool) -> String -> Parser t t , onFail -- :: Parser t a -> Parser t a -> Parser t a -- ** Re-parsing , reparse -- :: [t] -> Parser t () -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import Text.ParserCombinators.Poly.Parser import Control.Applicative -- The only differences between a Plain and a Lazy parser are the instance -- of Applicative, and the type (and implementation) of runParser. -- | Apply a parser to an input token sequence. runParser :: Parser t a -> [t] -> (Either String a, [t]) runParser (P p) = resultToEither . p ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Result.hs0000644000000000000000000000216507346545000021556 0ustar0000000000000000module Text.ParserCombinators.Poly.Result ( -- * The parsing result type Result(..) -- A parsing result type, with Success, Failure, and Commitment. , resultToEither ) where -- | A return type like Either, that distinguishes not only between -- right and wrong answers, but also has commitment, so that a failure -- cannot be undone. This should only be used for writing very primitive -- parsers - really it is an internal detail of the library. -- The z type is the remaining unconsumed input. data Result z a = Success z a | Failure z String | Committed (Result z a) instance Functor (Result z) where fmap f (Success z a) = Success z (f a) fmap f (Failure z e) = Failure z e fmap f (Committed r) = Committed (fmap f r) -- | Convert a Result to an Either, paired with the remaining unconsumed input. resultToEither :: Result z a -> (Either String a, z) resultToEither (Success z a) = (Right a, z) resultToEither (Failure z e) = (Left e, z) resultToEither (Committed r) = resultToEither r ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/State.hs0000644000000000000000000000255707346545000021365 0ustar0000000000000000module Text.ParserCombinators.Poly.State ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the parser monad , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) -- ** Basic parsers , next -- :: Parser s t t , eof -- :: Parser s t () , satisfy -- :: (t->Bool) -> Parser s t t , onFail -- :: Parser s t a -> Parser s t a -> 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 () -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import Text.ParserCombinators.Poly.StateParser import Control.Applicative -- The only differences between a State and a StateLazy parser are the instance -- of Applicative, and the type (and implementation) of runParser. -- | Apply a parser to an input token sequence. runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) runParser (P p) = \s-> reTuple . resultToEither . p s where reTuple (either, (z,s)) = (either, s, z) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/StateLazy.hs0000644000000000000000000001373407346545000022224 0ustar0000000000000000{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} module Text.ParserCombinators.Poly.StateLazy ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the parser monad , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) -- ** Basic parsers , next -- :: Parser s t t , eof -- :: Parser s t () , satisfy -- :: (t->Bool) -> Parser s t t , onFail -- :: Parser s t a -> 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 () -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base hiding (manyFinally) import Text.ParserCombinators.Poly.Result import qualified Text.ParserCombinators.Poly.StateParser as P import Control.Applicative import qualified Control.Monad.Fail as Fail #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 -- | The only differences between a State and a StateLazy parser are the -- instance of Applicative, and the type (and implementation) of runParser. -- We therefore need to /newtype/ the original Parser type, to allow it -- to have a different instance. newtype Parser s t a = P (P.Parser s t a) #ifdef __GLASGOW_HASKELL__ deriving (Functor,Monad,Fail.MonadFail,Commitment) #else instance Functor (Parser s t) where fmap f (P p) = P (fmap f p) instance Monad (Parser s t) where return x = P (return x) fail = Fail.fail (P f) >>= g = P (f >>= (\(P g')->g') . g) instance Fail.MonadFail (Parser s t) where fail e = P (fail e) instance Commitment (Parser s t) where commit (P p) = P (commit p) (P p) `adjustErr` f = P (p `adjustErr` f) #endif -- | Apply a parser to an input token sequence. runParser :: Parser s t a -> s -> [t] -> (a, s, [t]) runParser (P (P.P p)) = \s -> fromResult . p s where fromResult :: Result (z,s) a -> (a, s, z) fromResult (Success (z,s) a) = (a, s, z) fromResult (Failure _ e) = throwE e fromResult (Committed r) = fromResult r instance Applicative (Parser s t) where pure f = return f -- Apply a parsed function to a parsed value. This version -- is strict in the result of the function parser, but -- lazy in the result of the argument parser. (Argument laziness is -- the distinctive feature over other implementations.) (P (P.P pf)) <*> px = P (P.P (\s-> continue . pf s)) where continue (Success (z,s) f) = let (x,s',z') = runParser px s z in Success (z',s') (f x) continue (Failure zs e) = Failure zs e continue (Committed r) = Committed (continue r) #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative (Parser s t) where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse (Parser s t) ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser s t t next = P P.next -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser s t () eof = P P.eof -- | Return the next token if it satisfies the given predicate. satisfy :: (t->Bool) -> Parser s t t satisfy = P . P.satisfy -- | @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 onFail (P a) (P b) = P (a `P.onFail` b) -- | 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 = P . P.reparse ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s t () stUpdate f = P (P.stUpdate f) -- | Query the internal state. stQuery :: (s->a) -> Parser s t a stQuery f = P (P.stQuery f) -- | Deliver the entire internal state. stGet :: Parser s t s stGet = P (P.stGet) ------------------------------------------------------------------------ manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a] {- manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts)) where item _ _ (Success ts s x) = success ts s x item s ts (Failure _ _ e) = terminate (t s ts) item s ts (Committed r) = Committed (within r) success ts s x = let (tail,s',ts') = runParser (manyFinally pp pt) s ts in Success ts' s' (x:tail) terminate (Success ts s _) = Success ts s [] terminate (Failure ts s e) = Failure ts s e terminate (Committed r) = Committed (terminate r) within (Success ts s x) = success ts s x within (Failure ts s e) = Failure ts s e within (Committed r) = within r -} manyFinally p z = (do x <- p; return (x:) `apply` manyFinally p z) `onFail` (do z; return []) `onFail` oneOf' [ ("item in sequence", (do p; return [])) , ("sequence terminator", (do z; return [])) ] ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/StateParser.hs0000644000000000000000000001311107346545000022526 0ustar0000000000000000-- | This module contains the definitions for a generic parser, with -- running state. These are the parts that are shared between the State -- and StateLazy variations. Do not import this module directly, but only -- via T.P.Poly.State or T.P.Poly.StateLazy. module Text.ParserCombinators.Poly.StateParser ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the parser monad -- ** basic parsers , next -- :: Parser s t t , eof -- :: Parser s t () , satisfy -- :: (t->Bool) -> Parser s t t , onFail -- :: Parser s t a -> Parser s t a -> 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 import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import Control.Applicative import qualified Control.Monad.Fail as Fail -- | This @Parser@ datatype is a fairly generic parsing monad with error -- reporting, and running state. -- It can be used for arbitrary token types, not just String input. -- (If you do not require a running state, use module Poly.Plain instead) newtype Parser s t a = P (s -> [t] -> Result ([t],s) a) instance Functor (Parser s t) where fmap f (P p) = P (\s-> fmap f . p s) instance Applicative (Parser s t) where pure x = P (\s ts-> Success (ts,s) x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Monad (Parser s t) where return = pure (P f) >>= g = P (\s-> continue . f s) where continue (Success (ts,s) x) = let (P g') = g x in g' s ts continue (Committed r) = Committed (continue r) continue (Failure tss e) = Failure tss e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (Parser s t) where fail e = P (\s ts-> Failure (ts,s) e) instance Alternative (Parser s t) where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse (Parser s t) instance Commitment (Parser s t) where commit (P p) = P (\s-> Committed . squash . p s) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (\s-> adjust . p s) where adjust (Failure zs e) = Failure zs (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\s ts-> case p s ts of Failure _ err -> let (P p) = accum ((e,err):errs) ps in p s ts r@(Success _ a) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err 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-> continue s ts $ p s ts) where continue s ts (Failure _ _) = q s ts -- continue _ _ (Committed r) = r -- no, remain Committed continue _ _ r = r ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser s t t next = P (\s ts-> case ts of [] -> Failure ([],s) "Ran out of input (EOF)" (t:ts') -> Success (ts',s) t ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser s t () eof = P (\s ts-> case ts of [] -> Success ([],s) () (t:ts') -> Failure (ts,s) "Expected end of input (eof)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (t->Bool) -> Parser s t t satisfy pred = do { x <- next ; if pred x then return x else fail "Parse.satisfy: failed" } ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s t () stUpdate f = P (\s ts-> Success (ts, f s) ()) -- | Query the internal state. stQuery :: (s->a) -> Parser s t a stQuery f = P (\s ts-> Success (ts,s) (f s)) -- | Deliver the entire internal state. stGet :: Parser s t s stGet = P (\s ts-> Success (ts,s) s) ------------------------------------------------------------------------ -- | 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-> Success ((ts++inp),s) ()) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/StateText.hs0000644000000000000000000001400307346545000022217 0ustar0000000000000000module Text.ParserCombinators.Poly.StateText ( -- * The Parser datatype Parser(P) , Result(..) , runParser -- ** Basic parsers , next , eof , satisfy , onFail -- ** Derived parsers (but implemented more efficiently) , manySatisfy , many1Satisfy -- ** State-handling , stUpdate -- :: (s->s) -> Parser s t () , stQuery -- :: (s->a) -> Parser s t a , stGet -- :: Parser s t s -- ** Re-parsing , reparse -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import qualified Data.Text.Lazy as T import Data.Text.Lazy (Text) import Control.Applicative import qualified Control.Monad.Fail as Fail -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. Whereas the standard version can be used for arbitrary -- token types, this version is specialised to Text input only. newtype Parser s a = P (s -> Text -> Result (Text,s) a) -- | Apply a parser to an input token sequence. runParser :: Parser s a -> s -> Text -> (Either String a, s, Text) runParser (P p) = \s -> reTuple . resultToEither . p s where reTuple (either, (z,s)) = (either, s, z) instance Functor (Parser s) where fmap f (P p) = P (\s-> fmap f . p s) instance Monad (Parser s) where return = pure (P f) >>= g = P (\s-> continue . f s) where continue (Success (ts,s) x) = let (P g') = g x in g' s ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (Parser s) where fail e = P (\s ts-> Failure (ts,s) e) instance Commitment (Parser s) where commit (P p) = P (\s-> Committed . squash . p s) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (\s-> adjust . p s) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\s ts-> case p s ts of Failure _ err -> let (P p') = accum ((e,err):errs) ps in p' s ts r@(Success _ _) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err instance Applicative (Parser s) where pure x = P (\s ts-> Success (ts,s) x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative (Parser s) where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse (Parser s) ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser s Char next = P (\s bs-> case T.uncons bs of Nothing -> Failure (bs,s) "Ran out of input (EOF)" Just (c, bs') -> Success (bs',s) c ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser s () eof = P (\s bs -> if T.null bs then Success (bs,s) () else Failure (bs,s) "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (Char -> Bool) -> Parser s Char satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } -- | @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 a -> Parser s a -> Parser s a (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts) where continue s ts (Failure _ _) = q s ts -- continue _ _ (Committed r) = r -- no, remain Committed continue _ _ r = r ------------------------------------------------------------------------ -- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ manySatisfy :: (Char->Bool) -> Parser s Text manySatisfy f = P (\s bs-> let (pre,suf) = T.span f bs in Success (suf,s) pre) -- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ many1Satisfy :: (Char->Bool) -> Parser s Text many1Satisfy f = do x <- manySatisfy f if T.null x then fail "Parse.many1Satisfy: failed" else return x ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s () stUpdate f = P (\s bs-> Success (bs, f s) ()) -- | Query the internal state. stQuery :: (s->a) -> Parser s a stQuery f = P (\s bs-> Success (bs,s) (f s)) -- | Deliver the entire internal state. stGet :: Parser s s stGet = P (\s bs-> Success (bs,s) s) ------------------------------------------------------------------------ -- | 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 :: Text -> Parser s () reparse ts = P (\s inp-> Success (ts `T.append` inp,s) ()) ------------------------------------------------------------------------ polyparse-1.13/src/Text/ParserCombinators/Poly/Text.hs0000644000000000000000000001231207346545000021217 0ustar0000000000000000module Text.ParserCombinators.Poly.Text ( -- * The Parser datatype Parser(P) , Result(..) , runParser -- ** Basic parsers , next , eof , satisfy , onFail -- ** Derived parsers (but implemented more efficiently) , manySatisfy , many1Satisfy -- ** Re-parsing , reparse -- * Re-export all more general combinators , module Text.ParserCombinators.Poly.Base , module Control.Applicative ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result import qualified Data.Text.Lazy as T import Data.Text.Lazy (Text) import Control.Applicative import qualified Control.Monad.Fail as Fail -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. Whereas the standard version can be used for arbitrary -- token types, this version is specialised to Text input only. newtype Parser a = P (Text -> Result Text a) -- | Apply a parser to an input token sequence. runParser :: Parser a -> Text -> (Either String a, Text) runParser (P p) = resultToEither . p instance Functor Parser where fmap f (P p) = P (fmap f . p) instance Monad Parser where return = pure (P f) >>= g = P (continue . f) where continue (Success ts x) = let (P g') = g x in g' ts continue (Committed r) = Committed (continue r) continue (Failure ts e) = Failure ts e #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail Parser where fail e = P (\ts-> Failure ts e) instance Commitment Parser where commit (P p) = P (Committed . squash . p) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (adjust . p) where adjust (Failure z e) = Failure z (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\ts-> case p ts of Failure _ err -> let (P p') = accum ((e,err):errs) ps in p' ts r@(Success _ _) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err instance Applicative Parser where pure x = P (\ts-> Success ts x) pf <*> px = do { f <- pf; x <- px; return (f x) } #if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 p <* q = p `discard` q #endif instance Alternative Parser where empty = fail "no parse" p <|> q = p `onFail` q instance PolyParse Parser ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser Char next = P (\bs-> case T.uncons bs of Nothing -> Failure bs "Ran out of input (EOF)" Just (c, bs') -> Success bs' c ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser () eof = P (\bs -> if T.null bs then Success bs () else Failure bs "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (Char -> Bool) -> Parser Char satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } -- | @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 a -> Parser a -> Parser a (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) where continue ts (Failure _ _) = q ts -- continue _ (Committed r) = r -- no, remain Committed continue _ r = r ------------------------------------------------------------------------ -- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ manySatisfy :: (Char->Bool) -> Parser Text manySatisfy f = P (\bs-> let (pre,suf) = T.span f bs in Success suf pre) -- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ many1Satisfy :: (Char->Bool) -> Parser Text many1Satisfy f = do x <- manySatisfy f if T.null x then fail "Parse.many1Satisfy: failed" else return x ------------------------------------------------------------------------ -- | 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 :: Text -> Parser () reparse ts = P (\inp-> Success (ts `T.append` inp) ()) ------------------------------------------------------------------------