ListLike 2.0.1 → 4.7.8.4
raw patch · 29 files changed
Files
- CHANGELOG.md +68/−0
- COPYING +0/−510
- COPYRIGHT +14/−25
- ListLike.cabal +112/−27
- README +0/−10
- README.md +13/−0
- src/Data/ListLike.hs +40/−56
- src/Data/ListLike/Base.hs +134/−81
- src/Data/ListLike/CharString.hs +306/−0
- src/Data/ListLike/Chars.hs +99/−0
- src/Data/ListLike/DList.hs +76/−0
- src/Data/ListLike/FMList.hs +74/−0
- src/Data/ListLike/FoldableLL.hs +24/−10
- src/Data/ListLike/IO.hs +7/−7
- src/Data/ListLike/Instances.hs +245/−168
- src/Data/ListLike/String.hs +28/−9
- src/Data/ListLike/Text.hs +7/−0
- src/Data/ListLike/Text/Builder.hs +51/−0
- src/Data/ListLike/Text/Text.hs +107/−0
- src/Data/ListLike/Text/TextLazy.hs +104/−0
- src/Data/ListLike/UTF8.hs +288/−0
- src/Data/ListLike/Utils.hs +15/−10
- src/Data/ListLike/Vector.hs +11/−0
- src/Data/ListLike/Vector/Generic.hs +119/−0
- src/Data/ListLike/Vector/Storable.hs +106/−0
- src/Data/ListLike/Vector/Unboxed.hs +104/−0
- src/Data/ListLike/Vector/Vector.hs +103/−0
- testsrc/TestInfrastructure.hs +395/−0
- testsrc/runtests.hs +115/−80
+ CHANGELOG.md view
@@ -0,0 +1,68 @@+CHANGES+=======++#### 4.7.8.4 (2025-08-26)++ - fix build with `-Werror=incomplete-patterns`+ - tested with GHC 8.0 - 9.14 alpha1++#### 4.7.8.3 (2025-03-13)++ - drop support for GHC 7+ - allow `containers-0.8` and up+ - tested with GHC 8.0 - 9.12.1++#### 4.7.8.2 (2023-10-10)++ - pacify GHC 9.8's new `x-partial` warning+ - tested with GHC 7.10 - 9.8++#### 4.7.8.1 (2023-07-12)++ - allow `bytestring-0.12` and fix its deprecation warnings+ - tested with GHC 7.10 - 9.6++### 4.7.8 (2022-11-15)++ - change default `insertBy` implementation to work better with dlists+ ([#18](https://github.com/ddssff/listlike/pull/18))+ - allow `vector-0.13`+ - tested with GHC 7.10 - 9.4++### 4.7.7 (2022-05-26)++ - methods `sequence` and `mapM`: relax `Monad` constraint to `Applicative`+ - `LANGUAGE TypeOperators` to fix GHC 9.4 warning+ - allow `text-2.0`+ - tested with GHC 7.10 - 9.4++### 4.7.6 (2021-09-01)++ - new implementation of `tail` in `DList` instance+ - warning-free for `-Wall` and `-Wcompat`++### 4.7.4 (2021-01-07)++ - support utf8-string-1.0.2 ([#10](https://github.com/ddssff/listlike/issues/10))++### 4.7.3 (2020-12-31)++ - support bytestring-0.10.12 ([#7](https://github.com/ddssff/listlike/pull/7)) for ghc 8.10.3+ - removed support for ghc 7.6 and 7.8 ([#6](https://github.com/ddssff/listlike/issues/6))++### 4.7.2 (2020-08-21)++ - support dlist-1.0 ([#4](https://github.com/ddssff/listlike/issues/4))++### 4.7.1 (2020-07-03)++ - support QuickCheck-2.14++## 4.7++ - make `GHC.Exts.IsList` a superclass of `ListLike` and use its `fromList` and `toList` methods+ - make `Data.String.IsString` a superclass of `Stringlike` and use its `fromString` method+ - add methods to `StringLike`: `show`, `fromText`, `fromLazyText`+ - add a class `ListOps`, alternative to `ListLike`, that uses the `GHC.Exts.Item` instead of+ the `item` type parameter+ - supply `instance IsString Seq` for old versions of container
− COPYING
@@ -1,510 +0,0 @@-- GNU LESSER GENERAL PUBLIC LICENSE- Version 2.1, February 1999-- Copyright (C) 1991, 1999 Free Software Foundation, Inc.- 51 Franklin St, 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.--- <one line to give the library's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 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.-- <signature of Ty Coon>, 1 April 1990- Ty Coon, President of Vice--That's all there is to it!--
COPYRIGHT view
@@ -1,25 +1,14 @@-listlike-Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>--All code is under the following license unless otherwise noted:- This program 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 program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU Lesser General Public License for more details.-- You should have received a copy of the GNU General Public License- along with this program; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--The GNU Lesser General Public License is available in the file COPYING in the-source distribution. Debian GNU/Linux users may find this in-/usr/share/common-licenses/LGPL-2.1.--If the LGPL is unacceptable for your uses, please e-mail me; alternative-terms can be negotiated for your project.-+Copyright (c) 2007-2010 John Goerzon and John Lato. +Copyright (c) 2018 David Fox +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY 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 THE AUTHORS OR 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. +
ListLike.cabal view
@@ -1,16 +1,17 @@+Cabal-Version: 1.18 Name: ListLike-Version: 2.0.1-License: LGPL-Maintainer: John Lato <jwlato@gmail.com>+Version: 4.7.8.4++License: BSD3+Maintainer: David Fox <dsf@seereason.com>, Andreas Abel Author: John Goerzen Copyright: Copyright (c) 2007-2008 John Goerzen license-file: COPYRIGHT-extra-source-files: COPYING, README-Category: Generics+Category: list, string, text, bytestring, vector Build-Type: Simple-homepage: http://software.complete.org/listlike-synopsis: Generic support for list-like structures-Description: Generic support for list-like structures in Haskell.+homepage: http://github.com/ddssff/listlike+synopsis: Generalized support for list-like structures+Description: Generalized support for list-like structures in Haskell. . The ListLike module provides a common interface to the various Haskell types that are list-like. Predefined interfaces include standard@@ -21,23 +22,107 @@ ByteString, for types that support input and output, and for types that can handle infinite lists. Stability: Stable-Hs-Source-Dirs: src-Exposed-Modules: Data.ListLike,- Data.ListLike.Base,- Data.ListLike.FoldableLL,- Data.ListLike.IO,- Data.ListLike.Instances,- Data.ListLike.String,- Data.ListLike.Utils--- Other-Modules: Data.ConfigFile.Lexer-Build-Depends: base >= 3 && < 5- ,containers >= 0.3 && < 0.5- ,bytestring >= 0.9.1 && < 0.10- ,array >= 0.3 && < 0.4 -Executable: runtests-Buildable: False-Main-Is: runtests.hs-HS-Source-Dirs: testsrc, .-Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP+Tested-With:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2++extra-doc-files:+ README.md+ CHANGELOG.md++Library+ default-language: Haskell2010+ Hs-Source-Dirs: src+ Exposed-Modules: Data.ListLike+ Data.ListLike.Base+ Data.ListLike.Chars+ Data.ListLike.CharString+ Data.ListLike.FoldableLL+ Data.ListLike.IO+ Data.ListLike.Instances+ Data.ListLike.String+ Data.ListLike.Text+ Data.ListLike.Text.Builder+ Data.ListLike.Text.Text+ Data.ListLike.Text.TextLazy+ Data.ListLike.UTF8+ Data.ListLike.Utils+ Data.ListLike.Vector+ Data.ListLike.Vector.Generic+ Data.ListLike.Vector.Storable+ Data.ListLike.Vector.Unboxed+ Data.ListLike.Vector.Vector+ Data.ListLike.DList+ Data.ListLike.FMList+ -- Other-Modules: Data.ConfigFile.Lexer+ Build-Depends:+ base >= 4.9 && < 5+ , containers >= 0.5.7 && < 1+ , bytestring >= 0.10.8 && < 0.13+ , array >= 0.5 && < 0.6+ , text >= 1.2 && < 1.3 || >= 2.0 && < 2.2+ , vector >= 0.12 && < 0.14+ , dlist >= 0.8 && < 1.1+ , fmlist >= 0.9 && < 0.10+ , utf8-string >= 1.0 && < 1.1+ , deepseq++ -- Remark: Atm, we don't comply with the Haskell Package Versioning Policy+ -- https://pvp.haskell.org/+ -- > §6. Client defines orphan instance.+ -- > If a package defines an orphan instance, it MUST depend on the+ -- > minor version of the packages that define the data type and the+ -- > type class to be backwards compatible. For example,+ -- > build-depends: mypkg >= 2.1.1 && < 2.1.2.+ --+ -- Since ListLike defines orphan instances, we would need to include+ -- the minor version number in the upper bounds.+ -- (See issues #7 and #10.)+ -- However, this could involve a maintenance marathon to relax upper bounds.++ If !impl(ghc >= 8.4)+ Build-Depends: semigroups >= 0.16 && < 0.20++ ghc-options:+ -Wall+ -Wcompat++Test-suite listlike-tests+ default-language: Haskell2010+ Hs-source-dirs: testsrc+ Main-is: runtests.hs+ Type: exitcode-stdio-1.0++ Other-modules: TestInfrastructure+ Build-depends:+ base+ , ListLike+ , HUnit >= 1.5 && < 2+ , QuickCheck >= 2.9 && < 3+ , array+ , bytestring+ , containers+ , dlist+ , fmlist+ , text+ , vector+ , utf8-string+ If !impl(ghc >= 8.4)+ Build-Depends: semigroups >= 0.16 && < 0.20++source-repository head+ type: git+ location: https://github.com/ddssff/listlike.git
− README
@@ -1,10 +0,0 @@-The ListLike package provides typeclasses and instances to allow-polymorphism over many common datatypes.--The package can be built/installed with Cabal. If you have cabal-install,-simply run "cabal install ListLike" to install the package. Without-cabal-install, execute the following commands:--$ runghc Setup.hs configure-$ runghc Setup.hs build-$ runghc Setup.hs install
+ README.md view
@@ -0,0 +1,13 @@+[](https://github.com/ddssff/listlike/actions/workflows/haskell-ci.yml)+[](https://hackage.haskell.org/package/ListLike)+[](http://stackage.org/nightly/package/ListLike)+[](http://stackage.org/lts/package/ListLike)++ListLike+========++The `ListLike` package provides typeclasses and instances that+polymorphically generalize list operations to many list-like types+such as vectors, text, bytestrings, or difference lists.++Read the [introduction](https://hackage.haskell.org/package/ListLike/docs/Data-ListLike.html).
src/Data/ListLike.hs view
@@ -10,10 +10,10 @@ {- | Module : Data.ListLike Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable Generic operations over list-like structures@@ -23,13 +23,13 @@ Please start with the introduction at "Data.ListLike#intro". -} -module Data.ListLike +module Data.ListLike (-- * Introduction -- $intro- + -- * Creation & Basic Functions- empty, singleton, - cons, snoc, append, head, last, tail, init, null, length,+ empty, singleton,+ cons, snoc, append, uncons, head, last, tail, init, null, length, -- * List transformations map, rigidMap, reverse, intersperse, -- ** Conversions@@ -51,10 +51,12 @@ -- ** Unfolding -- * Sublists -- ** Extracting sublists- take, drop, splitAt, takeWhile, dropWhile, span, break,- group, inits, tails, + take, drop, splitAt, takeWhile, dropWhile, dropWhileEnd, span, break,+ group, inits, tails, -- ** Predicates isPrefixOf, isSuffixOf, isInfixOf,+ -- ** Modify based on predicate+ stripPrefix, stripSuffix, -- * Searching lists -- ** Searching by equality elem, notElem,@@ -70,7 +72,8 @@ ListLikeIO(..), -- * Special lists -- ** Strings- toString, fromString, lines, words,+ toString, fromString, lines, words, show,+ fromStringLike, fromText, fromLazyText, -- ** \"Set\" operations nub, delete, deleteFirsts, union, intersect, -- ** Ordered lists@@ -93,15 +96,15 @@ -- ** Arrays -- $notesarray - -- ** Maps- -- $notesmap- -- ** ByteStrings -- $notesbytestring- + Chars(..),+ CharString (..),+ CharStringLazy (..),+ -- * Base Typeclasses -- ** The ListLike class- ListLike,+ ListLike, ListOps, -- ** The FoldableLL class FoldableLL, -- ** The StringLike class@@ -110,17 +113,21 @@ InfiniteListLike ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, - any, lookup, init, all, foldl, foldr, foldl1, foldr1,- maximum, minimum, iterate, span, break, takeWhile,- dropWhile, reverse, zip, zipWith, sequence,- sequence_, mapM, mapM_, concatMap, and, or, sum,- product, repeat, replicate, cycle, take, drop,- splitAt, elem, notElem, unzip, lines, words,- unlines, unwords)+import Prelude hiding (Foldable(..), head, last, tail, map, filter, concat,+ any, lookup, init, all,+ iterate, span, break, takeWhile,+ dropWhile, {-dropWhileEnd,-} reverse, zip, zipWith, sequence,+ sequence_, mapM, mapM_, concatMap, and, or,+ repeat, replicate, cycle, take, drop,+ splitAt, notElem, unzip, lines, words,+ unlines, unwords, show) import Data.ListLike.Base+import Data.ListLike.Chars+import Data.ListLike.CharString import Data.ListLike.FoldableLL-import Data.ListLike.Instances()+import Data.ListLike.Instances ()+import Data.ListLike.DList ()+import Data.ListLike.FMList () import Data.ListLike.String import Data.ListLike.Utils import Data.ListLike.IO@@ -140,14 +147,14 @@ same names, too. Therefore, you'll want to be careful how you import the module. I suggest using: ->import qualified ListLike as LL+>import qualified Data.ListLike as LL Then, you can use LL.fold, LL.map, etc. to get the generic version of the functions you want. Alternatively, you can hide the other versions from Prelude and import specific generic functions from here, such as: >import Prelude hiding (map)->import ListLike (map)+>import Data.ListLike (map) The module "Data.ListLike" actually simply re-exports the items found in a number of its sub-modules. If you want a smaller subset of@@ -157,7 +164,7 @@ In most cases, functions here can act as drop-in replacements for their list-specific counterparts. They will use the same underlying implementations for lists, so there should be no performance difference.- + You can make your own types instances of 'ListLike' as well. For more details, see the notes for the 'ListLike' typeclass. -}@@ -205,45 +212,22 @@ not assigned a value to every slot in the array. -} -{- $notesmap--'Data.Map.Map' is an instance of 'ListLike' and is a rather interesting one at-that. The \"item\" for the Map instance is a @(key, value)@ pair. This-permits you to do folds, maps, etc. over a Map just like you would on a list.--The nature of a Map -- that every key is unique, and that it is internally-sorted -- means that there are some special things to take note of:--* 'cons' may or may not actually increase the size of the Map. If the given- key is already in the map, its value will simply be updated. Since- a Map has a set internal ordering, it is also not guaranteed that cons- will add something to the beginning of the Map.--* 'snoc' is the same operation as 'cons'.--* 'append' is 'Data.Map.union'--* 'nub', 'nubBy',- 'reverse', 'sort', 'sortBy', etc. are the identity function and don\'t- actually perform any computation--* 'insert' is the same as 'cons'.--* 'replicate' and 'genericReplicate' ignore the count and return a Map- with a single element.--}- {- $notesbytestring Both strict and lazy ByteStreams can be used with 'ListLike'. +ByteString ListLike instances operate on 'Word8' elements. This is because+both Data.ByteString.ByteString and Data.ByteString.Char8.ByteString have+the same underlying type. If you wish to use the Char8 representation,+the newtype wrappers 'CharString' and 'CharStringLazy' are available.+ Most 'ListLike' operations map directly to ByteStream options. Notable exceptions: * 'map' uses the 'ListLike' implementation. 'rigidMap' is more efficient. The same goes for 'concatMap' vs. 'rigidConcatMap'. -* 'isInfixOf', 'sequence', 'mapM' and similar monad operations, 'insert', +* 'isInfixOf', 'sequence', 'mapM' and similar monad operations, 'insert', 'union', 'intersect', 'sortBy', and similar functions are not implemented in 'ByteStream' and use a naive default implementation.
src/Data/ListLike/Base.hs view
@@ -1,8 +1,13 @@ {-# LANGUAGE ScopedTypeVariables+ ,TypeFamilies ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances- ,FlexibleContexts #-}+ ,BangPatterns+ ,FlexibleContexts+ ,ConstraintKinds+ ,CPP #-}+{-# LANGUAGE TypeOperators #-} -- for GHC >= 9.4 {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>@@ -16,10 +21,10 @@ {- | Module : Data.ListLike.Base Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable Generic operations over list-like structures@@ -27,25 +32,32 @@ Written by John Goerzen, jgoerzen\@complete.org -} -module Data.ListLike.Base +module Data.ListLike.Base (- ListLike(..),+ ListLike(..), ListOps,+ toList, fromList, InfiniteListLike(..), zip, zipWith, sequence_ ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, - any, lookup, init, all, foldl, foldr, foldl1, foldr1,- maximum, minimum, iterate, span, break, takeWhile,- dropWhile, reverse, zip, zipWith, sequence,- sequence_, mapM, mapM_, concatMap, and, or, sum,- product, repeat, replicate, cycle, take, drop,- splitAt, elem, notElem, unzip, lines, words,- unlines, unwords)++import Prelude+ ( Applicative(..), Bool(..), Eq(..), Int, Integer, Integral+ , Maybe(..), Monad, Monoid(..), Num(..), Ord(..), Ordering(..)+ , ($), (.), (&&), (||), (++), asTypeOf, error, flip, fst, snd+ , id, maybe, max, min, not, otherwise+ , sequenceA+ )+#if MIN_VERSION_base(4,17,0)+import Data.Type.Equality -- GHC 9.4: type equality ~ is just an operator now+#endif+ import qualified Data.List as L import Data.ListLike.FoldableLL-import qualified Control.Monad as M-import Data.Monoid-import Data.Maybe+ ( FoldableLL(foldr, foldr1, foldl), fold, foldMap, sequence_ )+import qualified Control.Applicative as A+import Data.Monoid ( All(All, getAll), Any(Any, getAny) )+import Data.Maybe ( listToMaybe )+import GHC.Exts (IsList(Item, fromList, {-fromListN,-} toList)) {- | The class implementing list-like functions. @@ -65,7 +77,7 @@ * null or genericLength -}-class (FoldableLL full item, Monoid full) =>+class (IsList full, item ~ Item full, FoldableLL full item, Monoid full) => ListLike full item | full -> item where ------------------------------ Creation@@ -87,12 +99,17 @@ snoc l item = append l (singleton item) {- | Combines two lists. Like (++). -}- append :: full -> full -> full + append :: full -> full -> full append = mappend {- | Extracts the first element of a 'ListLike'. -} head :: full -> item+ head = maybe (error "head") fst . uncons + {- | Extract head and tail, return Nothing if empty -}+ uncons :: full -> Maybe (item, full)+ uncons x = if null x then Nothing else Just (head x, tail x) -- please don't+ {- | Extracts the last element of a 'ListLike'. -} last :: full -> item last l = case genericLength l of@@ -101,7 +118,8 @@ _ -> last (tail l) {- | Gives all elements after the head. -}- tail :: full -> full + tail :: full -> full+ tail = maybe (error "tail") snd . uncons {- | All elements of the list except the last one. See also 'inits'. -} init :: full -> full@@ -126,7 +144,7 @@ as fast, if not faster, than this function and is recommended if it will work for your purposes. See also 'mapM'. -} map :: ListLike full' item' => (item -> item') -> full -> full'- map func inp + map func inp | null inp = empty | otherwise = cons (func (head inp)) (map func (tail inp)) @@ -138,7 +156,7 @@ rigidMap = map {- | Reverse the elements in a list. -}- reverse :: full -> full + reverse :: full -> full reverse l = rev l empty where rev rl a | null rl = a@@ -157,7 +175,7 @@ ------------------------------ Special folds {- | Flatten the structure. -}- concat :: (ListLike full' full, Monoid full) => full' -> full+ concat :: (ListLike full' full{-, Monoid full-}) => full' -> full concat = fold {- | Map a function over the items and concatenate the results.@@ -209,13 +227,13 @@ {- | Returns all elements at start of list that satisfy the function. -} takeWhile :: (item -> Bool) -> full -> full- takeWhile func l + takeWhile func l | null l = empty | func x = cons x (takeWhile func (tail l)) | otherwise = empty where x = head l - {- | Drops all elements form the start of the list that satisfy the+ {- | Drops all elements from the start of the list that satisfy the function. -} dropWhile :: (item -> Bool) -> full -> full dropWhile func l@@ -223,11 +241,16 @@ | func (head l) = dropWhile func (tail l) | otherwise = l + {- | Drops all elements from the end of the list that satisfy the+ function. -}+ dropWhileEnd :: (item -> Bool) -> full -> full+ dropWhileEnd func = foldr (\x xs -> if func x && null xs then empty else cons x xs) empty+ {- | The equivalent of @('takeWhile' f xs, 'dropWhile' f xs)@ -} span :: (item -> Bool) -> full -> (full, full) span func l | null l = (empty, empty)- | func x = (cons x ys, zs) + | func x = (cons x ys, zs) | otherwise = (empty, l) where (ys, zs) = span func (tail l) x = head l@@ -262,7 +285,7 @@ isPrefixOf needle haystack | null needle = True | null haystack = False- | otherwise = (head needle) == (head haystack) && + | otherwise = (head needle) == (head haystack) && isPrefixOf (tail needle) (tail haystack) {- | True when the first list is at the beginning of the second. -}@@ -271,10 +294,23 @@ {- | True when the first list is wholly containted within the second -} isInfixOf :: Eq item => full -> full -> Bool- isInfixOf needle haystack = + isInfixOf needle haystack = any (isPrefixOf needle) thetails where thetails = asTypeOf (tails haystack) [haystack] + ------------------------------ Conditionally modify based on predicates+ {- | Remove a prefix from a listlike if possible -}+ stripPrefix :: Eq item => full -> full -> Maybe full+ stripPrefix xs ys = if xs `isPrefixOf` ys+ then Just $ drop (length xs) ys+ else Nothing++ {- | Remove a suffix from a listlike if possible -}+ stripSuffix :: Eq item => full -> full -> Maybe full+ stripSuffix xs ys = if xs `isSuffixOf` ys+ then Just $ take (length ys - length xs) ys+ else Nothing+ ------------------------------ Searching {- | True if the item occurs in the list -} elem :: Eq item => item -> full -> Bool@@ -292,8 +328,8 @@ Just x -> Just (index l x) {- | Returns only the elements that satisfy the function. -}- filter :: (item -> Bool) -> full -> full - filter func l + filter :: (item -> Bool) -> full -> full+ filter func l | null l = empty | func (head l) = cons (head l) (filter func (tail l)) | otherwise = filter func (tail l)@@ -307,7 +343,7 @@ {- | The element at 0-based index i. Raises an exception if i is out of bounds. Like (!!) for lists. -} index :: full -> Int -> item- index l i + index l i | null l = error "index: index not found" | i < 0 = error "index: index must be >= 0" | i == 0 = head l@@ -317,7 +353,7 @@ elemIndex :: Eq item => item -> full -> Maybe Int elemIndex e l = findIndex (== e) l - {- | Returns the indices of the matching elements. See also + {- | Returns the indices of the matching elements. See also 'findIndices' -} elemIndices :: (Eq item, ListLike result Int) => item -> full -> result elemIndices i l = findIndices (== i) l@@ -334,18 +370,14 @@ ------------------------------ Monadic operations {- | Evaluate each action in the sequence and collect the results -}- sequence :: (Monad m, ListLike fullinp (m item)) =>+ sequence :: (Applicative m, ListLike fullinp (m item)) => fullinp -> m full- sequence l = foldr func (return empty) l- where func litem results = - do x <- litem- xs <- results- return (cons x xs)+ sequence = foldr (A.liftA2 cons) (pure empty) - {- | A map in monad space. Same as @'sequence' . 'map'@ - + {- | A map in monad space. Same as @'sequence' . 'map'@+ See also 'rigidMapM' -}- mapM :: (Monad m, ListLike full' item') => + mapM :: (Applicative m, ListLike full' item') => (item -> m item') -> full -> m full' mapM func l = sequence mapresult where mapresult = asTypeOf (map func l) []@@ -354,12 +386,6 @@ of the item. This can have performance benefits with some types. -} rigidMapM :: Monad m => (item -> m item) -> full -> m full rigidMapM = mapM- - {- | A map in monad space, discarding results. Same as- @'sequence_' . 'map'@ -}- mapM_ :: (Monad m) => (item -> m b) -> full -> m ()- mapM_ func l = sequence_ mapresult- where mapresult = asTypeOf (map func l) [] ------------------------------ "Set" operations@@ -396,37 +422,57 @@ sort = sortBy compare {- | Inserts the element at the last place where it is still less than or- equal to the next element. On data types that do not preserve + equal to the next element. On data types that do not preserve ordering, or enforce their own ordering, the result may not be what you expect. On types such as maps, this may result in changing an existing item. See also 'insertBy'. -}- insert :: Ord item => item -> full -> full + insert :: Ord item => item -> full -> full insert = insertBy compare ------------------------------ Conversions {- | Converts the structure to a list. This is logically equivolent- to 'fromListLike', but may have a more optimized implementation. -}- toList :: full -> [item]- toList = fromListLike+ to 'fromListLike', but may have a more optimized implementation.+ These two functions are now retired in favor of the methods of+ IsList, but they are retained here because some instances still+ use this implementation. -}+ toList' :: full -> [item]+ toList' = fromListLike {- | Generates the structure from a list. -}- fromList :: [item] -> full - fromList [] = empty- fromList (x:xs) = cons x (fromList xs)+ fromList' :: [item] -> full+ fromList' [] = empty+ fromList' (x:xs) = cons x (fromList xs) - {- | Converts one ListLike to another. See also 'toList'.+ {- | Converts one ListLike to another. See also 'toList''. Default implementation is @fromListLike = map id@ -} fromListLike :: ListLike full' item => full -> full' fromListLike = map id+ {-# INLINE fromListLike #-} ------------------------------ Generalized functions {- | Generic version of 'nub' -}+ -- This code is adapted from Data.List in base. nubBy :: (item -> item -> Bool) -> full -> full+ nubBy eq l = nubBy' l mempty+ where+ nubBy' ys xs =+ case uncons ys of+ Nothing -> mempty+ Just (y, ys')+ | elem_by y xs -> nubBy' ys' xs+ | otherwise -> cons y (nubBy' ys' (cons y xs))+ elem_by :: item -> full -> Bool+ elem_by y xs =+ case uncons xs of+ Nothing -> False+ Just (x, xs') -> x `eq` y || elem_by y xs'+{- nubBy f l | null l = empty | otherwise = cons (head l) (nubBy f (filter (\y -> not (f (head l) y)) (tail l)))+-} {- | Generic version of 'deleteBy' -} deleteBy :: (item -> item -> Bool) -> item -> full -> full@@ -451,7 +497,7 @@ intersectBy func xs ys = filter (\x -> any (func x) ys) xs {- | Generic version of 'group'. -}- groupBy :: (ListLike full' full, Eq item) => + groupBy :: (ListLike full' full, Eq item) => (item -> item -> Bool) -> full -> full' groupBy eq l | null l = empty@@ -461,23 +507,24 @@ xs = tail l {- | Sort function taking a custom comparison function -}- sortBy :: Ord item => (item -> item -> Ordering) -> full -> full + sortBy :: (item -> item -> Ordering) -> full -> full sortBy cmp = foldr (insertBy cmp) empty {- | Like 'insert', but with a custom comparison function -}- insertBy :: Ord item => (item -> item -> Ordering) -> item ->- full -> full - insertBy cmp x ys- | null ys = singleton x- | otherwise = case cmp x (head ys) of- GT -> cons (head ys) (insertBy cmp x (tail ys))+ insertBy :: (item -> item -> Ordering) -> item ->+ full -> full+ insertBy cmp x ys =+ case uncons ys of+ Nothing -> singleton x+ Just (ys_head,ys_tail) -> case cmp x ys_head of+ GT -> cons ys_head (insertBy cmp x ys_tail) _ -> cons x ys ------------------------------ Generic Operations {- | Length of the list -} genericLength :: Num a => full -> a genericLength l = calclen 0 l- where calclen accum cl =+ where calclen !accum cl = if null cl then accum else calclen (accum + 1) (tail cl)@@ -491,7 +538,7 @@ {- | Generic version of 'drop' -} genericDrop :: Integral a => a -> full -> full- genericDrop n l + genericDrop n l | n <= 0 = l | null l = l | otherwise = genericDrop (n - 1) (tail l)@@ -502,10 +549,21 @@ {- | Generic version of 'replicate' -} genericReplicate :: Integral a => a -> item -> full- genericReplicate count x + genericReplicate count x | count <= 0 = empty | otherwise = map (\_ -> x) [1..count] ++ {-# MINIMAL (singleton, uncons, null) |+ (singleton, uncons, genericLength) |+ (singleton, head, tail, null) |+ (singleton, head, tail, genericLength) #-}+++-- | A version of 'ListLike' with a single type parameter, the item+-- type is obtained using the 'Item' type function from 'IsList'.+type ListOps full = (ListLike full (Item full))+ {- instance (ListLike full item) => Monad full where m >>= k = foldr (append . k) empty m@@ -534,7 +592,7 @@ {- | Converts a finite list into a circular one -} cycle :: full -> full- cycle xs + cycle xs | null xs = error "ListLike.cycle: empty list" | otherwise = xs' where xs' = append xs xs' @@ -547,9 +605,11 @@ cons x l = x : l snoc l x = l ++ [x] append = (++)- head = L.head+ -- Andreas Abel, 2023-10-10, issue #32:+ -- Use implementation of 'head' and 'tail' in terms of 'uncons' to avoid the x-partial warning under GHC 9.8+ uncons [] = Nothing+ uncons (x : xs) = Just (x, xs) last = L.last- tail = L.tail init = L.init null = L.null length = L.length@@ -557,8 +617,6 @@ rigidMap = L.map reverse = L.reverse intersperse = L.intersperse- toList = id- fromList = id -- fromListLike = toList concat = L.concat . toList -- concatMap func = fromList . L.concatMap func@@ -583,6 +641,7 @@ isPrefixOf = L.isPrefixOf isSuffixOf = L.isSuffixOf isInfixOf = L.isInfixOf+ stripPrefix = L.stripPrefix elem = L.elem notElem = L.notElem find = L.find@@ -592,9 +651,8 @@ elemIndex = L.elemIndex elemIndices item = fromList . L.elemIndices item findIndex = L.findIndex- sequence = M.sequence . toList+ sequence = sequenceA . toList -- mapM = M.mapM- mapM_ = M.mapM_ nub = L.nub delete = L.delete deleteFirsts = (L.\\)@@ -606,6 +664,7 @@ intersectBy = L.intersectBy sortBy = L.sortBy insert = L.insert+ genericLength = L.genericLength --------------------------------------------------@@ -617,7 +676,7 @@ ListLike fullb itemb, ListLike result (item, itemb)) => full -> fullb -> result-zip = zipWith (\a b -> (a, b))+zip = zipWith (,) {- | Takes two lists and combines them with a custom combining function -} zipWith :: (ListLike full item,@@ -628,9 +687,3 @@ | null a = empty | null b = empty | otherwise = cons (f (head a) (head b)) (zipWith f (tail a) (tail b))--{- | Evaluate each action, ignoring the results -}-sequence_ :: (Monad m, ListLike mfull (m item)) => mfull -> m ()-sequence_ l = foldr (>>) (return ()) l--
+ src/Data/ListLike/CharString.hs view
@@ -0,0 +1,306 @@+{-# LANGUAGE CPP+ ,MultiParamTypeClasses+ ,FlexibleInstances+ ,TypeFamilies+ ,TypeSynonymInstances+ ,GeneralizedNewtypeDeriving #-}+++{-+Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>++All rights reserved.++For license and copyright information, see the file COPYRIGHT++-}++{- |+ Module : Data.ListLike.CharString+ Copyright : Copyright (C) 2007 John Goerzen+ License : BSD3++ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable+ Portability: portable++Newtype wrapper for ByteString to enable a Char-based interface+Re-exported by "Data.ListLike".++Written by John Lato, jwlato\@gmail.com+-}++module Data.ListLike.CharString (+ CharString (..)+ ,CharStringLazy (..)+)++where++import Prelude hiding (length, head, last, null, tail, map, filter, concat,+ any, lookup, init, all, foldl, foldr, foldl1, foldr1,+ maximum, minimum, iterate, span, break, takeWhile,+ dropWhile, reverse, zip, zipWith, sequence,+ sequence_, mapM, mapM_, concatMap, and, or, sum,+ product, repeat, replicate, cycle, take, drop,+ splitAt, elem, notElem, unzip, lines, words,+ unlines, unwords)+--import qualified Data.Foldable as F+import Data.ListLike.Base+import Data.ListLike.String+import Data.ListLike.IO+import Data.ListLike.FoldableLL+import Data.Int+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+import Data.String (IsString(..))+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+--import qualified System.IO as IO+--import Data.Word+import Control.Arrow+import GHC.Exts (IsList(..))++--------------------------------------------------+-- ByteString++-- | Newtype wrapper around Data.ByteString.Char8.ByteString,+-- this allows for ListLike instances with Char elements.+newtype CharString = CS { unCS :: BS.ByteString }+ deriving (Read, Show, Eq, Ord, Semigroup, Monoid)++instance FoldableLL CharString Char where+ foldl f i0 ls = BS.foldl f i0 (unCS ls)+ foldl' f i0 ls = BS.foldl' f i0 (unCS ls)+ foldl1 f ls = BS.foldl1 f (unCS ls)+ foldr f i0 ls = BS.foldr f i0 (unCS ls)+ foldr1 f ls = BS.foldr1 f (unCS ls)++instance IsList CharString where+ type Item CharString = Char+ toList = BS.unpack . unCS+ fromList = CS . BS.pack++instance ListLike CharString Char where+ empty = CS BS.empty+ singleton = CS . BS.singleton+ cons x l = CS (BS.cons x (unCS l))+ snoc l x = CS (BS.snoc (unCS l) x)+ append l r = CS $ BS.append (unCS l) (unCS r)+ head = BS.head . unCS+ last = BS.last . unCS+ tail = CS . BS.tail . unCS+ init = CS . BS.init . unCS+ null = BS.null . unCS+ length = fromIntegral . BS.length . unCS+ -- map = BS.map+ rigidMap f = CS . BS.map f . unCS+ reverse = CS . BS.reverse . unCS+ --intersperse = BS.intersperse+ concat = CS . BS.concat . map unCS . toList+ --concatMap = BS.concatMap+ rigidConcatMap f = CS . BS.concatMap (unCS . f) . unCS+ any p = BS.any p . unCS+ all p = BS.all p . unCS+ maximum = BS.maximum . unCS+ minimum = BS.minimum . unCS+ replicate i = CS . BS.replicate (fromIntegral i)+ take i = CS . BS.take (fromIntegral i) . unCS+ drop i = CS . BS.drop (fromIntegral i) . unCS+ splitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS+ takeWhile p = CS . BS.takeWhile p . unCS+ dropWhile p = CS . BS.dropWhile p . unCS+ span p = (CS *** CS) . BS.span p . unCS+ break p = (CS *** CS) . BS.break p . unCS+ group = fromList . map CS . BS.group . unCS+ inits = fromList . map CS . BS.inits . unCS+ tails = fromList . map CS . BS.tails . unCS+ isPrefixOf p f = BS.isPrefixOf (unCS p) (unCS f)+ --isSuffixOf = BS.isSuffixOf+ --isInfixOf = BS.isInfixOf+ elem x = BS.elem x . unCS+ notElem x = BS.notElem x . unCS+ find p = BS.find p . unCS+ filter p = CS . BS.filter p . unCS+ --partition = BS.partition+ index l i = BS.index (unCS l) (fromIntegral i)+ elemIndex i = BS.elemIndex i . unCS+ --elemIndices x = fromList . L.map fromIntegral . BS.elemIndices x+ findIndex f = BS.findIndex f . unCS+ --findIndices x = fromList . L.map fromIntegral . BS.findIndices x+ --sequence = BS.sequence+ --mapM = BS.mapM+ --mapM_ = BS.mapM_+ --nub = BS.nub+ --delete = BS.delete+ --deleteFirsts = BS.deleteFirsts+ --union = BS.union+ --intersect = BS.intersect+ --sort = BS.sort+ --insert = BS.insert+ --toList = BS.unpack . unCS+ --fromList = CS . BS.pack+ --fromListLike = fromList . toList+ --nubBy = BS.nubBy+ --deleteBy = BS.deleteBy+ --deleteFirstsBy = BS.deleteFirstsBy+ --unionBy = BS.unionBy+ --intersectBy = BS.intersectBy+ -- BS.groupBy is broken. groupBy f = fromList . BS.groupBy f+ -- the below works on ghc but generates a type error on hugs+ -- groupBy func = map fromList . L.groupBy func . toList+ --sortBy = BS.sortBy+ --insertBy = BS.insertBy+ genericLength = fromInteger . fromIntegral . BS.length . unCS+ genericTake i = CS . BS.take (fromIntegral i) . unCS+ genericDrop i = CS . BS.drop (fromIntegral i) . unCS+ genericSplitAt i = (CS *** CS) . BS.splitAt (fromIntegral i) . unCS+ genericReplicate i = CS . BS.replicate (fromIntegral i)++instance ListLikeIO CharString Char where+ hGetLine h = fmap CS $ BS.hGetLine h+ hGetContents = fmap CS . BS.hGetContents+ hGet h n = fmap CS $ BS.hGet h n+ hGetNonBlocking h n = fmap CS $ BS.hGetNonBlocking h n+ hPutStr h = BS.hPut h . unCS+ --hPutStrLn = BS.hPutStrLn+ getLine = fmap CS BS.getLine+ getContents = fmap CS BS.getContents+ putStr = BS.putStr . unCS+ putStrLn = BS.putStrLn . unCS+ interact f = BS.interact (unCS . f . CS)+ readFile = fmap CS . BS.readFile+ writeFile fp = BS.writeFile fp . unCS+ appendFile fp = BS.appendFile fp . unCS++instance IsString CharString where+ fromString = CS . BS.pack++instance StringLike CharString where+ toString = BS.unpack . unCS++--------------------------------------------------+-- ByteString.Lazy++-- | Newtype wrapper around Data.ByteString.Lazy.Char8.ByteString,+-- this allows for ListLike instances with Char elements.+newtype CharStringLazy = CSL { unCSL :: BSL.ByteString }+ deriving (Read, Show, Eq, Ord, Semigroup, Monoid)++instance FoldableLL CharStringLazy Char where+ foldl f i0 ls = BSL.foldl f i0 (unCSL ls)+ foldl' f i0 ls = BSL.foldl' f i0 (unCSL ls)+ foldl1 f ls = BSL.foldl1 f (unCSL ls)+ foldr f i0 ls = BSL.foldr f i0 (unCSL ls)+ foldr1 f ls = BSL.foldr1 f (unCSL ls)++mi64toi :: Maybe Int64 -> Maybe Int+mi64toi Nothing = Nothing+mi64toi (Just x) = Just (fromIntegral x)++instance IsList CharStringLazy where+ type Item CharStringLazy = Char+ toList = BSL.unpack . unCSL+ fromList = CSL . BSL.pack++instance ListLike CharStringLazy Char where+ empty = CSL BSL.empty+ singleton = CSL . BSL.singleton+ cons x l = CSL (BSL.cons x (unCSL l))+ snoc l x = CSL (BSL.snoc (unCSL l) x)+ append l r = CSL $ BSL.append (unCSL l) (unCSL r)+ head = BSL.head . unCSL+ last = BSL.last . unCSL+ tail = CSL . BSL.tail . unCSL+ init = CSL . BSL.init . unCSL+ null = BSL.null . unCSL+ length = fromIntegral . BSL.length . unCSL+ -- map = BSL.map+ rigidMap f = CSL . BSL.map f . unCSL+ reverse = CSL . BSL.reverse . unCSL+ --intersperse = BSL.intersperse+ concat = CSL . BSL.concat . map unCSL . toList+ --concatMap = BSL.concatMap+ rigidConcatMap f = CSL . BSL.concatMap (unCSL . f) . unCSL+ any p = BSL.any p . unCSL+ all p = BSL.all p . unCSL+ maximum = BSL.maximum . unCSL+ minimum = BSL.minimum . unCSL+ replicate i = CSL . BSL.replicate (fromIntegral i)+ take i = CSL . BSL.take (fromIntegral i) . unCSL+ drop i = CSL . BSL.drop (fromIntegral i) . unCSL+ splitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL+ takeWhile p = CSL . BSL.takeWhile p . unCSL+ dropWhile p = CSL . BSL.dropWhile p . unCSL+ span p = (CSL *** CSL) . BSL.span p . unCSL+ break p = (CSL *** CSL) . BSL.break p . unCSL+ group = fromList . map CSL . BSL.group . unCSL+ inits = fromList . map CSL . BSL.inits . unCSL+ tails = fromList . map CSL . BSL.tails . unCSL+ isPrefixOf p f = BSL.isPrefixOf (unCSL p) (unCSL f)+ --isSuffixOf = BSL.isSuffixOf+ --isInfixOf = BSL.isInfixOf+ elem x = BSL.elem x . unCSL+ notElem x = BSL.notElem x . unCSL+ find p = BSL.find p . unCSL+ filter p = CSL . BSL.filter p . unCSL+ --partition = BSL.partition+ index l i = BSL.index (unCSL l) (fromIntegral i)+ elemIndex i = mi64toi . BSL.elemIndex i . unCSL+ --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x+ findIndex f = mi64toi . BSL.findIndex f . unCSL+ --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x+ --sequence = BSL.sequence+ --mapM = BSL.mapM+ --mapM_ = BSL.mapM_+ --nub = BSL.nub+ --delete = BSL.delete+ --deleteFirsts = BSL.deleteFirsts+ --union = BSL.union+ --intersect = BSL.intersect+ --sort = BSL.sort+ --insert = BSL.insert+ --toList = BSL.unpack . unCSL+ --fromList = CSL . BSL.pack+ --fromListLike = fromList . toList+ --nubBy = BSL.nubBy+ --deleteBy = BSL.deleteBy+ --deleteFirstsBy = BSL.deleteFirstsBy+ --unionBy = BSL.unionBy+ --intersectBy = BSL.intersectBy+ -- BSL.groupBy is broken. groupBy f = fromList . BSL.groupBy f+ -- the below works on ghc but generates a type error on hugs+ -- groupBy func = map fromList . L.groupBy func . toList+ --sortBy = BSL.sortBy+ --insertBy = BSL.insertBy+ genericLength = fromInteger . fromIntegral . BSL.length . unCSL+ genericTake i = CSL . BSL.take (fromIntegral i) . unCSL+ genericDrop i = CSL . BSL.drop (fromIntegral i) . unCSL+ genericSplitAt i = (CSL *** CSL) . BSL.splitAt (fromIntegral i) . unCSL+ genericReplicate i = CSL . BSL.replicate (fromIntegral i)++strict2lazy :: BS.ByteString -> CharStringLazy+strict2lazy b = CSL $ BSL.fromChunks [b]++instance ListLikeIO CharStringLazy Char where+ hGetLine h = fmap strict2lazy $ BS.hGetLine h+ hGetContents = fmap CSL . BSL.hGetContents+ hGet h n = fmap CSL $ BSL.hGet h n+ hGetNonBlocking h n = fmap CSL $ BSL.hGetNonBlocking h n+ hPutStr h = BSL.hPut h . unCSL+ --hPutStrLn = BSL.hPutStrLn+ getLine = fmap strict2lazy BS.getLine+ getContents = fmap CSL BSL.getContents+ putStr = BSL.putStr . unCSL+ putStrLn = BSL.putStrLn . unCSL+ interact f = BSL.interact (unCSL . f . CSL)+ readFile = fmap CSL . BSL.readFile+ writeFile fp = BSL.writeFile fp . unCSL+ appendFile fp = BSL.appendFile fp . unCSL++instance IsString CharStringLazy where+ fromString = CSL . BSL.pack++instance StringLike CharStringLazy where+ toString = BSL.unpack . unCSL
+ src/Data/ListLike/Chars.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE CPP+ ,MultiParamTypeClasses+ ,TypeFamilies+ ,FlexibleInstances #-}++module Data.ListLike.Chars++where++import Control.DeepSeq+--import Control.Monad+import Data.String as String (IsString)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+import qualified Data.Text.Lazy as T+--import qualified Data.Text.Lazy.IO as TI+import qualified Data.Text.Lazy.Builder as Builder+--import Data.Text.Encoding (decodeUtf8)+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL as LL+import Data.ListLike.IO+import Data.ListLike.String as LL+import Data.ListLike.Text ()+import GHC.Exts (IsList(..))++data Chars+ = B Builder.Builder+ | T T.Text+ deriving (Show, Eq, Ord)++builder :: Chars -> Builder.Builder+builder (B x) = x+builder (T s) = Builder.fromLazyText s+{-# INLINE builder #-}++instance Semigroup Chars where+ a <> b = B $ builder a <> builder b++instance Monoid Chars where+ mempty = B mempty+ mappend = (<>)++instance String.IsString Chars where+ -- Builder already has an IsString instance, do we want to use it?+ -- fromString = B . String.fromString+ -- or do we want the implementation that used to be in the StringLike instance?+ fromString = B . Builder.fromLazyText . LL.fromString++instance FoldableLL Chars Char where+ foldl f r0 (B b) = LL.foldl f r0 . Builder.toLazyText $ b+ foldl f r0 (T s) = LL.foldl f r0 $ s+ foldr f r0 (B b) = LL.foldr f r0 . Builder.toLazyText $ b+ foldr f r0 (T s) = LL.foldr f r0 $ s+ --+ foldl' f r0 (B b) = LL.foldl' f r0 . Builder.toLazyText $ b+ foldl' f r0 (T s) = LL.foldl' f r0 $ s+ foldl1 f (B b) = LL.foldl1 f . Builder.toLazyText $ b+ foldl1 f (T s) = LL.foldl1 f $ s+ foldr' f r0 (B b) = LL.foldr' f r0 . Builder.toLazyText $ b+ foldr' f r0 (T s) = LL.foldr' f r0 $ s+ foldr1 f (B b) = LL.foldr1 f . Builder.toLazyText $ b+ foldr1 f (T s) = LL.foldr1 f $ s++instance IsList Chars where+ type Item Chars = Char+ toList = LL.toList'+ fromList = LL.fromList'++instance ListLike Chars Char where+ singleton = B . Builder.singleton+ uncons (B b) =+ case LL.uncons (Builder.toLazyText b) of+ Nothing -> Nothing+ Just (c, s) -> Just (c, T s)+ uncons (T s) =+ case LL.uncons s of+ Nothing -> Nothing+ Just (c, s') -> Just (c, T s')+ null (B b) = LL.null . Builder.toLazyText $ b+ null (T t) = LL.null t++instance ListLikeIO Chars Char where+ hGetLine h = T <$> hGetLine h+ hGetContents h = T <$> hGetContents h+ hGet h n = T <$> hGet h n+ hGetNonBlocking h n = T <$> hGetNonBlocking h n+ hPutStr h (B b) = hPutStr h . Builder.toLazyText $ b+ hPutStr h (T s) = hPutStr h $ s++instance StringLike Chars where+ toString (B b) = toString . Builder.toLazyText $ b+ toString (T s) = toString $ s+ fromLazyText = B . Builder.fromLazyText+ fromText = B . Builder.fromText++instance NFData Chars where+ rnf (B b) = rnf . Builder.toLazyText $ b+ rnf (T s) = rnf s
+ src/Data/ListLike/DList.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE NoImplicitPrelude, MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}+{-# LANGUAGE CPP #-}++-- | 'Data.ListLike.ListLike' instances for 'Data.DList.DList'++module Data.ListLike.DList () where++import qualified Prelude++import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String+#if MIN_VERSION_dlist(1,0,0)+import Data.DList.Unsafe (DList(UnsafeDList), unsafeApplyDList)+#else+import Data.DList (DList)+#endif+import qualified Data.DList as D+import qualified Data.Foldable as F+import qualified Data.List as List+import qualified Data.String as S+import Control.Category+import Data.Char (Char)+++instance FoldableLL (DList a) a where+ foldl = F.foldl+ foldr = D.foldr+ foldl1 = F.foldl1+ foldr1 = F.foldr1+ foldl' = F.foldl'+ foldr' = F.foldr'++instance ListLike (DList a) a where+ empty = D.empty+ singleton = D.singleton+ cons = D.cons+ snoc = D.snoc+ append = D.append+ head = D.head+#if MIN_VERSION_dlist(1,0,0)+ -- Andreas Abel, 2021-09-01, issue #14,+ -- work around https://github.com/spl/dlist/issues/98:+ --+ -- dlist-1.0 changed @tail@ so that it is not an operation+ -- on difference lists anymore, but collapses the difference list+ -- into a plain list.+ --+ -- The following tail function restores the spirit of difference+ -- lists, at the cost of breaking data abstraction, i.e.,+ -- using the constructor and destructor of the newtype DList.+ -- Andreas Abel, 2023-10-10, issue #32:+ -- Use @drop 1@ instead of @tail@ as the latter triggers the x-partial warning in GHC 9.8.+ tail = UnsafeDList . (List.drop 1 .) . unsafeApplyDList+#else+ tail = D.tail+#endif+ rigidMap = D.map+ null = null . D.toList+ --toList = D.toList+ --fromList = D.fromList+ replicate = D.replicate+ uncons xs = case xs of+ D.Nil -> Prelude.Nothing+ D.Cons d_head l_tail -> Prelude.Just (d_head,fromList l_tail)+ _ -> Prelude.error "Workaround for missing COMPLETE pragma on dlist patterns"+++instance StringLike (DList Char) where+ toString = D.toList+ -- fromString = D.fromList+ lines = map D.fromList . S.lines . D.toList+ words = map D.fromList . S.words . D.toList+ unlines = D.fromList . S.unlines . map D.toList+ unwords = D.fromList . S.unwords . map D.toList
+ src/Data/ListLike/FMList.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}+{-# OPTIONS -Wno-orphans #-}+-- | 'Data.ListLike.ListLike' instances for 'Data.FMList.FMList'+module Data.ListLike.FMList () where+import Prelude hiding (cycle, map)+import Data.ListLike.Base+import Data.ListLike.FoldableLL+--import Data.ListLike.IO+import Data.ListLike.String+import Data.FMList (FMList(..))+import qualified Data.FMList as FM+--import Data.Foldable (Foldable)+import qualified Data.Foldable as F+--import Data.Traversable (Traversable)+--import qualified Data.Traversable as T+import Data.String (IsString)+import qualified Data.String as S+import Control.Monad.Zip (MonadZip)+import qualified Control.Monad.Zip as Z+--import Data.Function+import GHC.Exts (IsList(..))++instance FoldableLL (FMList a) a where+ foldl = F.foldl+ foldr = F.foldr+ foldl1 = F.foldl1+ foldr1 = F.foldr1+ foldl' = F.foldl'+ foldr' = F.foldr'++instance IsList (FMList a) where+ type Item (FMList a) = a+ fromList = FM.fromList+ toList = FM.toList++instance ListLike (FMList a) a where+ empty = FM.empty+ singleton = FM.singleton+ cons = FM.cons+ snoc = FM.snoc+ append = FM.append+ head = FM.head+ tail = FM.tail+ last = FM.last+ init = FM.init+ --fromList = FM.fromList+ --toList = FM.toList+ null = FM.null+ genericLength = FM.genericLength+ length = FM.length+ reverse = FM.reverse+ filter = FM.filter+ take = FM.take+ takeWhile = FM.takeWhile+ drop = FM.drop+ dropWhile = FM.dropWhile++instance InfiniteListLike (FMList a) a where+ iterate = FM.iterate+ repeat = FM.repeat+ cycle a = (a `FM.append` cycle a) `FM.append` a++instance IsString (FMList Char) where+ fromString = FM.fromList++instance StringLike (FMList Char) where+ toString = FM.toList+ lines = map FM.fromList . S.lines . FM.toList+ words = map FM.fromList . S.words . FM.toList+ unlines = FM.fromList . S.unlines . map FM.toList+ unwords = FM.fromList . S.unwords . map FM.toList++instance MonadZip FMList where+ mzipWith = FM.zipWith
src/Data/ListLike/FoldableLL.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses+{-# LANGUAGE CPP+ ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances #-} @@ -13,10 +14,10 @@ {- | Module : Data.ListLike.FoldableLL Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable Generic tools for data structures that can be folded.@@ -24,19 +25,18 @@ Written by John Goerzen, jgoerzen\@complete.org -}-module Data.ListLike.FoldableLL +module Data.ListLike.FoldableLL (-- * FoldableLL Class FoldableLL(..), -- * Utilities- fold, foldMap- ) where -import Prelude hiding (foldl, foldr, foldr1)+ fold, foldMap, foldM, sequence_, mapM_+ ) where+import Prelude hiding (foldl, foldr, foldr1, sequence_, mapM_, foldMap) import qualified Data.Foldable as F-import Data.Monoid import Data.Maybe import qualified Data.List as L -{- | This is the primary class for structures that are to be considered +{- | This is the primary class for structures that are to be considered foldable. A minimum complete definition provides 'foldl' and 'foldr'. Instances of 'FoldableLL' can be folded, and can be many and varied.@@ -102,3 +102,17 @@ foldr1 = F.foldr1 foldr' = F.foldr' -}++-- Based on http://stackoverflow.com/a/12881193/1333025+{- | Monadic version of left fold, similar to 'Control.Monad.foldM'. -}+foldM :: (Monad m, FoldableLL full item) => (a -> item -> m a) -> a -> full -> m a+foldM f z xs = foldr (\x rest a -> f a x >>= rest) return xs z++{- | A map in monad space, discarding results. -}+mapM_ :: (Monad m, FoldableLL full item) => (item -> m b) -> full -> m ()+mapM_ func = foldr ((>>) . func) (return ())++{- | Evaluate each action, ignoring the results.+ Same as @'mapM_' 'id'@. -}+sequence_ :: (Monad m, FoldableLL full (m item)) => full -> m ()+sequence_ = mapM_ id
src/Data/ListLike/IO.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses +{-# LANGUAGE MultiParamTypeClasses ,FunctionalDependencies #-} @@ -14,10 +14,10 @@ {- | Module : Data.ListLike.IO Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable String-like functions@@ -29,7 +29,7 @@ ( ListLikeIO(..) ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, reverse, zip, zipWith, sequence,@@ -48,7 +48,7 @@ Note that some types may not be capable of lazy reading or writing. Therefore, the usual semantics of "System.IO" functions regarding laziness may or may not be available from a particular implementation.- + Minimal complete definition: * hGetLine@@ -104,7 +104,7 @@ -- | Interact with stdin and stdout by using a function to transform -- input to output. May be lazy. See 'System.IO.interact' for more. interact :: (full -> full) -> IO ()- interact func = + interact func = do c <- getContents putStr (func c)
src/Data/ListLike/Instances.hs view
@@ -1,7 +1,12 @@-{-# LANGUAGE MultiParamTypeClasses +{-# LANGUAGE CPP+ ,MultiParamTypeClasses ,FlexibleInstances+ ,TypeFamilies ,TypeSynonymInstances #-}-+{-# OPTIONS -Wno-orphans #-}+#if __GLASGOW_HASKELL__ >= 900+{-# OPTIONS -Wno-incomplete-uni-patterns #-}+#endif {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>@@ -15,10 +20,10 @@ {- | Module : Data.ListLike.Instances Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable Instances of 'Data.ListLike.ListLike' and related classes.@@ -28,7 +33,7 @@ -} module Data.ListLike.Instances () where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, reverse, zip, zipWith, sequence,@@ -36,21 +41,36 @@ product, repeat, replicate, cycle, take, drop, splitAt, elem, notElem, unzip, lines, words, unlines, unwords)+import qualified Prelude as P import qualified Data.List as L-import Data.ListLike.Base-import Data.ListLike.String-import Data.ListLike.IO-import Data.ListLike.FoldableLL-import Data.Int-import Data.Monoid-import qualified Data.ByteString as BS+import qualified Data.Sequence as S+import Data.Sequence ((><), (|>), (<|)) import qualified Data.Foldable as F+import Data.ListLike.Base+import Data.ListLike.String+import Data.ListLike.IO+import Data.ListLike.FoldableLL+import Data.ListLike.Text ()+import Data.ListLike.UTF8 ()+import Data.ListLike.Vector ()+import Data.Int+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+--import qualified Data.Foldable as F+--import qualified Data.Traversable as T import qualified Data.Array.IArray as A-import Data.Array.IArray((!), (//), Ix(..))+import Data.Array.IArray((!), (//), Ix(..)) import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.String (IsString)+--import Data.String.UTF8 (UTF8)+--import qualified Data.String.UTF8 as UTF8 import qualified System.IO as IO-import Data.Word-import qualified Data.Map as Map+import Data.Word+import GHC.Exts (IsList(..)) -------------------------------------------------- -- []@@ -61,8 +81,10 @@ instance ListLikeIO String Char where hGetLine = IO.hGetLine hGetContents = IO.hGetContents- hGet h c = BSL.hGet h c >>= (return . toString)- hGetNonBlocking h i = BSL.hGetNonBlocking h i >>= (return . toString)+ hGet _ c | c <= 0 = return mempty+ hGet h c = cons <$> IO.hGetChar h <*> hGet h (pred c)+ -- hGetNonBlocking h i >>= (return . toString)+ hGetNonBlocking _h _i = error "Unimplemented: hGetNonBlocking in instance ListLikeIO String Char" hPutStr = IO.hPutStr hPutStrLn = IO.hPutStrLn getLine = IO.getLine@@ -73,9 +95,27 @@ readFile = IO.readFile writeFile = IO.writeFile +{-+import Data.ByteString.Internal (createAndTrim)+import qualified System.IO.Error as IO++hGetNonBlocking :: IO.Handle -> Int -> IO BS.ByteString+hGetNonBlocking h i+ | i > 0 = createAndTrim i $ \p -> IO.hGetBufNonBlocking h p i+ | i == 0 = return empty+ | otherwise = illegalBufferSize h "hGetNonBlocking'" i++illegalBufferSize :: IO.Handle -> String -> Int -> IO a+illegalBufferSize handle fn sz =+ ioError (IO.mkIOError IO.illegalOperationErrorType msg (Just handle) Nothing)+ --TODO: System.IO uses InvalidArgument here, but it's not exported :-(+ where+ msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []+-}+ instance StringLike String where toString = id- fromString = id+ --fromString = id instance InfiniteListLike [a] a where iterate = L.iterate@@ -93,24 +133,32 @@ foldr' = BS.foldr' foldr1 = BS.foldr1 +#if !MIN_VERSION_bytestring(0,10,12)+instance IsList BS.ByteString where+ type Item BS.ByteString = Word8+ toList = BS.unpack+ fromList = BS.pack+#endif+ instance ListLike BS.ByteString Word8 where empty = BS.empty singleton = BS.singleton cons = BS.cons snoc = BS.snoc append = BS.append+ uncons = BS.uncons head = BS.head last = BS.last tail = BS.tail init = BS.init null = BS.null length = BS.length- -- map = BS.map+ -- map = rigidMap = BS.map reverse = BS.reverse intersperse = BS.intersperse concat = BS.concat . toList- --concatMap = BS.concatMap+ --concatMap = rigidConcatMap = BS.concatMap any = BS.any all = BS.all@@ -140,9 +188,10 @@ elemIndices x = fromList . BS.elemIndices x findIndex = BS.findIndex findIndices x = fromList . BS.findIndices x- --sequence = BS.sequence- --mapM = BS.mapM- --mapM_ = BS.mapM_+ -- the default definitions don't work well for array-like things, so+ -- do monadic stuff via a list instead+ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList --nub = BS.nub --delete = BS.delete --deleteFirsts = BS.deleteFirsts@@ -150,9 +199,7 @@ --intersect = BS.intersect sort = BS.sort --insert = BS.insert- toList = BS.unpack- fromList = BS.pack- fromListLike = fromList . toList+ --fromListLike = fromList . toList --nubBy = BS.nubBy --deleteBy = BS.deleteBy --deleteFirstsBy = BS.deleteFirstsBy@@ -168,24 +215,33 @@ genericReplicate i = BS.replicate (fromIntegral i) instance ListLikeIO BS.ByteString Word8 where- hGetLine = BS.hGetLine+ hGetLine = BSC.hGetLine hGetContents = BS.hGetContents hGet = BS.hGet hGetNonBlocking = BS.hGetNonBlocking hPutStr = BS.hPutStr- hPutStrLn = BS.hPutStrLn- getLine = BS.getLine+ hPutStrLn = BSC.hPutStrLn+ getLine = BSC.getLine getContents = BS.getContents putStr = BS.putStr- putStrLn = BS.putStrLn+ putStrLn = BSC.putStrLn interact = BS.interact readFile = BS.readFile writeFile = BS.writeFile appendFile = BS.appendFile +-- There is no bijection between Strings and ByteStrings that I know+-- of. The elements of a String are Unicode code points, and while+-- every String can be UTF8-encoded into a ByteString, there are+-- ByteStrings that can not be decoded into valid Strings - notably+-- "\128". So should ByteString be an instance of StringLike?+-- Probably not. Unfortunately, this instance is used to implement+-- the ListLikeIO instance for String! This must not stand.+#if 0 instance StringLike BS.ByteString where- toString = map (toEnum . fromIntegral) . BS.unpack- fromString = BS.pack . map (fromIntegral . fromEnum)+ toString = BSU.toString+ --fromString = BSU.fromString+#endif -------------------------------------------------- -- ByteString.Lazy@@ -202,12 +258,20 @@ mi64toi Nothing = Nothing mi64toi (Just x) = Just (fromIntegral x) +#if !MIN_VERSION_bytestring(0,10,12)+instance IsList BSL.ByteString where+ type Item BSL.ByteString = Word8+ toList = BSL.unpack+ fromList = BSL.pack+#endif+ instance ListLike BSL.ByteString Word8 where empty = BSL.empty singleton = BSL.singleton cons = BSL.cons snoc = BSL.snoc append = BSL.append+ uncons = BSL.uncons head = BSL.head last = BSL.last tail = BSL.tail@@ -245,10 +309,12 @@ filter = BSL.filter --partition = BSL.partition index l i = BSL.index l (fromIntegral i)- elemIndex i = mi64toi . BSL.elemIndex i + elemIndex i = mi64toi . BSL.elemIndex i --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x findIndex f = mi64toi . BSL.findIndex f --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x+ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList --sequence = BSL.sequence --mapM = BSL.mapM --mapM_ = BSL.mapM_@@ -259,9 +325,7 @@ --intersect = BSL.intersect --sort = BSL.sort --insert = BSL.insert- toList = BSL.unpack- fromList = BSL.pack- fromListLike = fromList . toList+ --fromListLike = fromList . toList --nubBy = BSL.nubBy --deleteBy = BSL.deleteBy --deleteFirstsBy = BSL.deleteFirstsBy@@ -281,138 +345,42 @@ strict2lazy :: BS.ByteString -> IO BSL.ByteString strict2lazy b = return (BSL.fromChunks [b]) instance ListLikeIO BSL.ByteString Word8 where- hGetLine h = BS.hGetLine h >>= strict2lazy+ hGetLine h = BSC.hGetLine h >>= strict2lazy hGetContents = BSL.hGetContents hGet = BSL.hGet hGetNonBlocking = BSL.hGetNonBlocking hPutStr = BSL.hPut- --hPutStrLn = BSL.hPutStrLn- getLine = BS.getLine >>= strict2lazy+ -- hPutStrLn = BSLC.hPutStrLn+ getLine = BSC.getLine >>= strict2lazy getContents = BSL.getContents putStr = BSL.putStr- putStrLn = BSL.putStrLn+ putStrLn = BSLC.putStrLn interact = BSL.interact readFile = BSL.readFile writeFile = BSL.writeFile appendFile = BSL.appendFile +#if 0 instance StringLike BSL.ByteString where- toString = map (toEnum . fromIntegral) . BSL.unpack- fromString = BSL.pack . map (fromIntegral . fromEnum)+ toString = BSLU.toString+ --fromString = BSLU.fromString+#endif -------------------------------------------------- -- Map+-- N.B. the Map instance is broken because it treats the key as part of the+-- element. Consider:+-- let m = fromList [(False,0)] :: Map Bool Int+-- let m' = cons (False, 1) m+-- m' == fromList [(False,1)] =/= [(False,1), (False,0)]+-- Map isn't a suitable candidate for ListLike... -instance (Ord key) => FoldableLL (Map.Map key val) (key, val) where- foldr f start m = Map.foldrWithKey func start m- where func k v accum = f (k, v) accum- foldl f start m = L.foldl f start (Map.toList m) -l2m :: (Ord k, Ord k2) => ([(k, v)], [(k2, v2)]) -> (Map.Map k v, Map.Map k2 v2)-l2m (l1, l2) = (Map.fromList l1, Map.fromList l2)-instance (Ord key, Eq val) => ListLike (Map.Map key val) (key, val) where- empty = Map.empty- singleton (k, v) = Map.singleton k v- cons (k, v) m = Map.insert k v m- snoc = flip cons- append = Map.union- head = Map.elemAt 0- last m = Map.elemAt (Map.size m - 1) m- -- was deleteAt 0, but that is broken in GHC 6.6- tail = drop 1- -- broken in GHC 6.6: init m = Map.deleteAt (Map.size m - 1) m- init = Map.fromAscList . L.init . Map.toAscList- null = Map.null- length = Map.size- map f = fromList . map f . Map.toList- rigidMap f = Map.fromList . L.map f . Map.toList- reverse = id- intersperse i f- | Map.size f <= 1 = f- | otherwise = cons i f- -- concat- -- concatMap- -- rigidConcatMap- -- any- -- all- -- maximum- -- minimum- replicate = genericReplicate- take n = Map.fromAscList . L.take n . Map.toAscList- drop n = Map.fromAscList . L.drop n . Map.toAscList- splitAt n = l2m . L.splitAt n . Map.toList- takeWhile f = Map.fromAscList . L.takeWhile f . Map.toAscList- dropWhile f = Map.fromAscList . L.dropWhile f . Map.toAscList- span f = l2m . L.span f . Map.toList- break f = span (not . f)- group m- | null m = empty- | otherwise = cons (singleton (head m)) (group (tail m))- -- group- -- inits- -- tails- isPrefixOf f1 f2 = L.isPrefixOf (Map.toList f1) (Map.toList f2)- isSuffixOf f1 f2 = L.isSuffixOf (Map.toList f1) (Map.toList f2)- isInfixOf = Map.isSubmapOf- --elem = Map.member- --notElem = Map.notMember- -- find- filter f m = Map.filterWithKey func m- where func k v = f (k, v)- index = flip Map.elemAt- elemIndex (k, v) m =- case Map.lookupIndex k m of- Nothing -> fail "elemIndex: no matching key"- Just i -> if snd (Map.elemAt i m) == v- then Just i- else fail "elemIndex on Map: matched key but not value"- elemIndices i m = - case elemIndex i m of- Nothing -> empty- Just x -> singleton x- -- findIndex- -- findIndices- -- sequence- -- mapM- -- rigidMapM- -- mapM_- nub = id- delete (k, v) m =- case Map.lookup k m of- Nothing -> m- Just x -> if x == v- then Map.delete k m- else m- union = Map.union- -- intersect- sort = id- insert = cons- toList = Map.toList- fromList = Map.fromList- nubBy func = Map.fromAscList . L.nubBy func . Map.toAscList- --deleteBy- deleteFirstsBy func m1 m2 = Map.fromAscList $ - L.deleteFirstsBy func (Map.toAscList m1)- (Map.toAscList m2)- --deleteFirstsBy- unionBy func m1 m2 = Map.fromList $ - L.unionBy func (Map.toList m1) (Map.toList m2)- --intersectBy- --groupBy- sortBy _ = id- insertBy _ = insert- genericLength = fromIntegral . Map.size- genericTake n = Map.fromAscList . L.genericTake n . Map.toAscList- genericDrop n = Map.fromAscList . L.genericDrop n . Map.toAscList- genericSplitAt n = l2m . L.genericSplitAt n . Map.toList- genericReplicate count item- | count <= 0 = empty- | otherwise = singleton item- -------------------------------------------------- -- Arrays -instance (Ix i) => FoldableLL (A.Array i e) e where+-- This constraint is required for ghc < 8+instance Ix i => FoldableLL (A.Array i e) e where foldl = F.foldl foldl1 = F.foldl1 foldl' = F.foldl'@@ -420,25 +388,33 @@ foldr1 = F.foldr1 foldr' = F.foldr' +instance (Integral i, Ix i) => Semigroup (A.Array i e) where+ l1 <> l2 = A.array (blow, newbhigh) $+ A.assocs l1 ++ zip [bhigh + 1 .. newbhigh] (A.elems l2)+ where+ newlen = genericLength newelems+ newelems = A.elems l2+ newbhigh = bhigh + newlen+ (blow, bhigh) = A.bounds l1+ instance (Integral i, Ix i) => Monoid (A.Array i e) where- mempty = A.listArray (0, -1) []- mappend l1 l2 =- A.array (blow, newbhigh)- (A.assocs l1 ++ zip [(bhigh + 1)..newbhigh] (A.elems l2))- where newlen = genericLength newelems- newelems = A.elems l2- newbhigh = bhigh + newlen- (blow, bhigh) = A.bounds l1+ mempty = A.listArray (0, -1) []+ mappend = (<>) +instance (Integral i, Ix i) => IsList (A.Array i e) where+ type Item (A.Array i e) = e+ toList = A.elems+ fromList l = A.listArray (0, genericLength l - 1) l+ instance (Integral i, Ix i) => ListLike (A.Array i e) e where empty = mempty singleton i = A.listArray (0, 0) [i]- cons i l = + cons i l = -- To add something to the beginning of an array, we must -- change the bounds and set the first element. (A.ixmap (blow - 1, bhigh) id l) // [(blow - 1, i)] where (blow, bhigh) = A.bounds l- snoc l i = + snoc l i = -- Here we must change the bounds and set the last element (A.ixmap (blow, bhigh + 1) id l) // [(bhigh + 1, i)] where (blow, bhigh) = A.bounds l@@ -453,7 +429,7 @@ length = genericLength -- map rigidMap = A.amap- reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l)) + reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l)) -- intersperse -- concat -- concatMap@@ -486,10 +462,9 @@ elemIndices i = fromList . L.elemIndices i . toList findIndex f = L.findIndex f . toList findIndices f = fromList . L.findIndices f . toList- -- sequence = M.sequence . toList- -- mapM f = M.mapM f . toList+ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList -- rigidMapM = mapM- -- mapM_ f = M.mapM_ f . toList nub = fromList . L.nub . toList -- delete -- deleteFirsts@@ -497,8 +472,6 @@ -- intersect sort l = A.listArray (A.bounds l) (L.sort (A.elems l)) -- insert- toList = A.elems- fromList l = A.listArray (0, genericLength l - 1) l -- fromListLike nubBy f = fromList . L.nubBy f . toList -- deleteBy@@ -510,7 +483,7 @@ -- insertBy genericLength l = fromIntegral (bhigh - blow + 1) where (blow, bhigh) = A.bounds l- genericTake count l + genericTake count l | count > genericLength l = l | count <= 0 = empty | otherwise = A.listArray (blow, blow + (fromIntegral count) - 1)@@ -520,13 +493,15 @@ (L.genericDrop count (A.elems l)) where (blow, bhigh) = A.bounds l -- geneicSplitAt- genericReplicate count i = A.listArray (0, (fromIntegral count) - 1) + genericReplicate count i = A.listArray (0, (fromIntegral count) - 1) (L.genericReplicate count i) +instance (Integral i, Ix i) => IsString (A.Array i Char) where+ fromString = fromList+ instance (Integral i, Ix i) => StringLike (A.Array i Char) where toString = toList- fromString = fromList -- lines -- words @@ -545,3 +520,105 @@ -- readFile -- writeFile -- appendFile++-- ---------------------------+-- Data.Sequence instances++instance ListLikeIO (S.Seq Char) Char where+ hGetLine h = IO.hGetLine h >>= (return . fromList)+ hGetContents h = IO.hGetContents h >>= (return . fromList)+ hGet h i = ((hGet h i)::IO String) >>= (return . fromList)+ hGetNonBlocking h i = ((hGetNonBlocking h i):: IO String) >>= (return . fromList)+ hPutStr h = hPutStr h . toString+ hPutStrLn h = hPutStrLn h . toString+ getLine = IO.getLine >>= (return . fromString)+ getContents = IO.getContents >>= (return . fromString)+ putStr = IO.putStr . toString+ putStrLn = IO.putStrLn . toString+ -- interact+ -- readFile+ -- writeFile+ -- appendFile++instance StringLike (S.Seq Char) where+ toString = toList+ --fromString = fromList++instance FoldableLL (S.Seq a) a where+ foldl = F.foldl+ foldl' = F.foldl'+ foldl1 = F.foldl1+ foldr = F.foldr+ foldr' = F.foldr'+ foldr1 = F.foldr1++instance ListLike (S.Seq a) a where+ empty = S.empty+ singleton = S.singleton+ cons = (<|)+ snoc = (|>)+ append = (><)+ head s = let (a S.:< _) = S.viewl s in a+ last s = let (_ S.:> a) = S.viewr s in a+ tail s = S.index (S.tails s) 1+ init s = S.index (S.inits s) (S.length s - 1)+ null = S.null+ length = S.length+ map f = fromList . toList . fmap f+ --rigidMap =+ reverse = S.reverse+ --intersperse =+ --concat =+ --concatMap =+ --rigidConcatMap =+ any = F.any+ all = F.all+ maximum = F.maximum+ minimum = F.minimum+ replicate n = S.replicate (if n >= 0 then n else 0)+ take = S.take+ drop = S.drop+ splitAt = S.splitAt+ --takeWhile =+ --dropWhile =+ span = S.spanl+ -- break =+ --group =+ inits = fromList . toList . S.inits+ tails = fromList . toList . S.tails+ --isPrefixOf =+ --isSuffixOf =+ --isInfixOf =+ --elem =+ --notElem =+ --find =+ filter = S.filter+ partition = S.partition+ index = S.index+ elemIndex = S.elemIndexL+ elemIndices p = fromList . S.elemIndicesL p+ findIndex = S.findIndexL+ findIndices p = fromList . S.findIndicesL p+ --sequence =+ --mapM f =+ --nub =+ --delete =+ --deleteFirsts =+ --union =+ --intersect =+ sort = S.sort+ --insert = S.insert+ --fromListLike = fromList . toList+ --nubBy =+ --deleteBy =+ --deleteFirstsBy =+ --unionBy =+ --intersectBy =+ --groupBy f =+ sortBy = S.sortBy+ --insertBy =+ genericLength = fromInteger . fromIntegral . S.length+ genericTake i = S.take (fromIntegral i)+ genericDrop i = S.drop (fromIntegral i)+ genericSplitAt i = S.splitAt (fromIntegral i)+ genericReplicate i = S.replicate (fromIntegral i)
src/Data/ListLike/String.hs view
@@ -10,10 +10,10 @@ {- | Module : Data.ListLike.String Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable String-like functions@@ -21,11 +21,14 @@ Written by John Goerzen, jgoerzen\@complete.org -} +{-# LANGUAGE FlexibleContexts #-}+ module Data.ListLike.String ( StringLike(..)+ , fromString ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, reverse, zip, zipWith, sequence,@@ -35,20 +38,20 @@ unlines, unwords) import qualified Data.List as L import Data.ListLike.Base+import Data.String+import Data.Text (Text)+import qualified Data.Text.Lazy as Lazy (Text) {- | An extension to 'ListLike' for those data types that are similar to a 'String'. Minimal complete definition is 'toString' and 'fromString'. -}-class StringLike s where+class IsString s => StringLike s where {- | Converts the structure to a 'String' -} toString :: s -> String- - {- | Converts a 'String' to a list -}- fromString :: String -> s {- | Breaks a string into a list of strings -} lines :: (ListLike full s) => s -> full- --lines = map fromString . L.lines . toString + --lines = map fromString . L.lines . toString lines = myLines {- | Breaks a string into a list of words -}@@ -62,6 +65,22 @@ {- | Joins words -} unwords :: ListLike full s => full -> s unwords = myUnwords++ {- | Generalize the 'Show' method t return any 'StringLike'. -}+ show :: Show a => a -> s+ show = fromString . Prelude.show++ fromStringLike :: StringLike s' => s -> s'+ fromStringLike = fromString . toString++ {- | Override this to avoid extra 'String' conversions. -}+ fromText :: StringLike Text => Text -> s+ fromText = fromString . toString+ {- | Override this to avoid extra 'String' conversions. -}+ fromLazyText :: StringLike Lazy.Text => Lazy.Text -> s+ fromLazyText = fromString . toString++{-# DEPRECATED fromStringLike "Use fromString . toString or something more efficient using local knowledge" #-} -- For some reason, Hugs required splitting these out into -- separate functions.
+ src/Data/ListLike/Text.hs view
@@ -0,0 +1,7 @@+module Data.ListLike.Text ()++where++import Data.ListLike.Text.Builder ()+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()
+ src/Data/ListLike/Text/Builder.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE CPP+ ,MultiParamTypeClasses+ ,TypeFamilies+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Text.Builder++where++import Control.DeepSeq (NFData(rnf))+import qualified Data.Text.Lazy.Builder as Builder+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL as LL+import Data.ListLike.IO+import Data.ListLike.String as LL+import Data.ListLike.Text.TextLazy ()+--import Data.String (IsString(fromString))+import GHC.Exts (IsList(..))++instance FoldableLL Builder.Builder Char where+ foldl f r0 = LL.foldl f r0 . Builder.toLazyText+ foldr f r0 = LL.foldr f r0 . Builder.toLazyText++instance IsList Builder.Builder where+ type Item Builder.Builder = Char+ -- Can we do better?+ toList = LL.toList'+ fromList = LL.fromList'++instance ListLike Builder.Builder Char where+ singleton = Builder.singleton+ uncons b = case LL.uncons (Builder.toLazyText b) of+ Nothing -> Nothing+ Just (c, s) -> Just (c, Builder.fromLazyText s)+ null = LL.null . Builder.toLazyText++instance ListLikeIO Builder.Builder Char where+ hGetLine h = Builder.fromLazyText <$> hGetLine h+ hGetContents h = Builder.fromLazyText <$> hGetContents h+ hGet h n = Builder.fromLazyText <$> hGet h n+ hGetNonBlocking h n = Builder.fromLazyText <$> hGetNonBlocking h n+ hPutStr h = hPutStr h . Builder.toLazyText++instance StringLike Builder.Builder where+ toString = toString . Builder.toLazyText+ fromText = Builder.fromText+ fromLazyText = Builder.fromLazyText++instance NFData Builder.Builder where+ rnf = rnf . Builder.toLazyText
+ src/Data/ListLike/Text/Text.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Text.Text++where++import Prelude as P+import qualified Data.Text as T+import qualified Data.Text.IO as TI+import qualified Data.Text.Lazy as Lazy (toStrict)+import Data.Text.Encoding (decodeUtf8)+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String++import qualified Data.ByteString as BS++instance FoldableLL T.Text Char where+ foldl = T.foldl+ foldl' = T.foldl'+ foldl1 = T.foldl1+ foldr = T.foldr+ --foldr' = T.foldr'+ foldr1 = T.foldr1++instance ListLike T.Text Char where+ empty = T.empty+ singleton = T.singleton+ cons = T.cons+ snoc = T.snoc+ append = T.append+ head = T.head+ last = T.last+ tail = T.tail+ init = T.init+ null = T.null+ length = T.length+ rigidMap = T.map+ reverse = T.reverse+ intersperse = T.intersperse+ concat = T.concat . toList+ rigidConcatMap = T.concatMap+ any = T.any+ all = T.all+ maximum = T.maximum+ minimum = T.minimum+ replicate n = T.replicate n . T.singleton+ take = T.take+ drop = T.drop+ splitAt = T.splitAt+ takeWhile = T.takeWhile+ dropWhile = T.dropWhile+ span = T.span+ break = T.break+ group = fromList . T.group+ inits = fromList . T.inits+ tails = fromList . T.tails+ isPrefixOf = T.isPrefixOf+ isSuffixOf = T.isSuffixOf+ stripPrefix = T.stripPrefix+ stripSuffix = T.stripSuffix+ elem = T.isInfixOf . T.singleton+ find = T.find+ filter = T.filter+ index = T.index+ findIndex = T.findIndex+ --toList = T.unpack+ --fromList = T.pack+ --fromListLike = fromList . toList+ groupBy f = fromList . T.groupBy f+ genericLength = fromInteger . fromIntegral . T.length+ genericTake i = T.take (fromIntegral i)+ genericDrop i = T.drop (fromIntegral i)+ genericSplitAt i = T.splitAt (fromIntegral i)+ genericReplicate i = LL.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance ListLikeIO T.Text Char where+ hGetLine = TI.hGetLine+ hGetContents = TI.hGetContents+ hGet h c = BS.hGet h c >>= return . decodeUtf8+ hGetNonBlocking h i = BS.hGetNonBlocking h i >>= return . decodeUtf8+ hPutStr = TI.hPutStr+ hPutStrLn = TI.hPutStrLn+ getLine = TI.getLine+ getContents = TI.getContents+ putStr = TI.putStr+ putStrLn = TI.putStrLn+ interact = TI.interact+ readFile = TI.readFile+ writeFile = TI.writeFile+ appendFile = TI.appendFile++instance StringLike T.Text where+ toString = T.unpack+ words = fromList . T.words+ lines = fromList . T.lines+ unwords = T.unwords . toList+ unlines = T.unlines . toList++ fromText = id+ fromLazyText = Lazy.toStrict
+ src/Data/ListLike/Text/TextLazy.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Text.TextLazy++where++import Prelude as P+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as TI+import Data.Text.Encoding (decodeUtf8)+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String++import qualified Data.ByteString as BS++instance FoldableLL T.Text Char where+ foldl = T.foldl+ foldl' = T.foldl'+ foldl1 = T.foldl1+ foldr = T.foldr+ foldr1 = T.foldr1++instance ListLike T.Text Char where+ empty = T.empty+ singleton = T.singleton+ cons = T.cons+ snoc = T.snoc+ append = T.append+ head = T.head+ last = T.last+ tail = T.tail+ init = T.init+ null = T.null+ length = fromIntegral . T.length+ rigidMap = T.map+ reverse = T.reverse+ intersperse = T.intersperse+ concat = T.concat . toList+ rigidConcatMap = T.concatMap+ any = T.any+ all = T.all+ maximum = T.maximum+ minimum = T.minimum+ replicate n = T.replicate (fromIntegral n) . T.singleton+ take = T.take . fromIntegral+ drop = T.drop . fromIntegral+ splitAt = T.splitAt . fromIntegral+ takeWhile = T.takeWhile+ dropWhile = T.dropWhile+ span = T.span+ break = T.break+ group = fromList . T.group+ inits = fromList . T.inits+ tails = fromList . T.tails+ isPrefixOf = T.isPrefixOf+ isSuffixOf = T.isSuffixOf+ stripPrefix = T.stripPrefix+ stripSuffix = T.stripSuffix+ elem = T.isInfixOf . T.singleton+ find = T.find+ filter = T.filter+ index t = T.index t . fromIntegral+ --toList = T.unpack+ --fromList = T.pack+ --fromListLike = fromList . toList+ groupBy f = fromList . T.groupBy f+ genericLength = fromInteger . fromIntegral . T.length+ genericTake i = T.take (fromIntegral i)+ genericDrop i = T.drop (fromIntegral i)+ genericSplitAt i = T.splitAt (fromIntegral i)+ genericReplicate i = LL.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance ListLikeIO T.Text Char where+ hGetLine = TI.hGetLine+ hGetContents = TI.hGetContents+ hGet h = fmap (T.fromStrict . decodeUtf8) . BS.hGet h+ hGetNonBlocking h = fmap (T.fromStrict . decodeUtf8) . BS.hGetNonBlocking h+ hPutStr = TI.hPutStr+ hPutStrLn = TI.hPutStrLn+ getLine = TI.getLine+ getContents = TI.getContents+ putStr = TI.putStr+ putStrLn = TI.putStrLn+ interact = TI.interact+ readFile = TI.readFile+ writeFile = TI.writeFile+ appendFile = TI.appendFile++instance StringLike T.Text where+ toString = T.unpack+ words = fromList . T.words+ lines = fromList . T.lines+ unwords = T.unwords . toList+ unlines = T.unlines . toList++ fromText = T.fromStrict+ fromLazyText = id
+ src/Data/ListLike/UTF8.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE CPP+ ,MultiParamTypeClasses+ ,FlexibleInstances+ ,TypeFamilies+ ,TypeSynonymInstances+ ,UndecidableInstances #-}+{-# OPTIONS -Wno-orphans #-}++{- |+Instances of 'Data.ListLike.ListLike' and related classes.+Re-exported by "Data.ListLike".+-}++--------------------------------------------------+-- UTF8 ByteString++module Data.ListLike.UTF8 () where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+--import Control.DeepSeq (NFData(rnf))+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String (StringLike(..))+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif+#if !MIN_VERSION_utf8_string(1,0,2)+import Data.String (IsString(fromString))+#endif+import Data.String.UTF8 (UTF8{-, UTF8Bytes-})+import qualified Data.String.UTF8 as UTF8+import GHC.Exts (IsList(..))+--import GHC.Generics++#if 0+utf8rnf :: NFData a => UTF8 a -> ()+utf8rnf = rnf . UTF8.toRep+#endif++instance FoldableLL (UTF8 BS.ByteString) Char where+ foldl = UTF8.foldl+ -- foldl' = UTF8.foldl'+ -- foldl1 = UTF8.foldl1+ foldr = UTF8.foldr+ -- foldr' = UTF8.foldr'+ -- foldr1 = UTF8.foldr1++instance IsList (UTF8 BS.ByteString) where+ type Item (UTF8 BS.ByteString) = Char+ toList = UTF8.toString+ fromList = LL.fromList' -- LL.map id++instance ListLike (UTF8 BS.ByteString) Char where+ empty = mempty+ singleton c = UTF8.fromString [c]+ -- cons = UTF8.cons+ -- snoc = UTF8.snoc+ -- append = UTF8.append+ uncons = UTF8.uncons+ head = fst . fromMaybe (error "head") . uncons+ -- last = UTF8.last+ tail = snd . fromMaybe (error "tail") . uncons+ -- init = UTF8.init+ null s = UTF8.length s == 0+ length = UTF8.length+ -- -- map =+ -- rigidMap = UTF8.map+ -- reverse = UTF8.reverse+ -- intersperse = UTF8.intersperse+ -- concat = UTF8.concat . toList+ -- --concatMap =+ -- rigidConcatMap = UTF8.concatMap+ -- any = UTF8.any+ -- all = UTF8.all+ -- maximum = UTF8.maximum+ -- minimum = UTF8.minimum+ -- replicate = UTF8.replicate+ take = UTF8.take+ drop = UTF8.drop+ splitAt = UTF8.splitAt+ -- takeWhile = UTF8.takeWhile+ -- dropWhile = UTF8.dropWhile+ span = UTF8.span+ break = UTF8.break+ -- group = fromList . UTF8.group+ -- inits = fromList . UTF8.inits+ -- tails = fromList . UTF8.tails+ -- isPrefixOf = UTF8.isPrefixOf+ -- isSuffixOf = UTF8.isSuffixOf+ -- --isInfixOf = UTF8.isInfixOf+ -- elem = UTF8.elem+ -- notElem = UTF8.notElem+ -- find = UTF8.find+ -- filter = UTF8.filter+ -- --partition = UTF8.partition+ -- index = UTF8.index+ -- elemIndex = UTF8.elemIndex+ -- elemIndices x = fromList . UTF8.elemIndices x+ -- findIndex = UTF8.findIndex+ -- findIndices x = fromList . UTF8.findIndices x+ -- -- the default definitions don't work well for array-like things, so+ -- -- do monadic stuff via a list instead+ -- sequence = fmap fromList . P.sequenceA . toList+ -- mapM func = fmap fromList . P.traverse func . toList+ -- --nub = UTF8.nub+ -- --delete = UTF8.delete+ -- --deleteFirsts = UTF8.deleteFirsts+ -- --union = UTF8.union+ -- --intersect = UTF8.intersect+ -- sort = UTF8.sort+ -- --insert = UTF8.insert+ --toList = UTF8.toString+ -- fromList = UTF8.pack+ -- fromListLike = fromList . toList+ -- --nubBy = UTF8.nubBy+ -- --deleteBy = UTF8.deleteBy+ -- --deleteFirstsBy = UTF8.deleteFirstsBy+ -- --unionBy = UTF8.unionBy+ -- --intersectBy = UTF8.intersectBy+ -- groupBy f = fromList . UTF8.groupBy f+ -- --sortBy = UTF8.sortBy+ -- --insertBy = UTF8.insertBy+ -- genericLength = fromInteger . fromIntegral . UTF8.length+ -- genericTake i = UTF8.take (fromIntegral i)+ -- genericDrop i = UTF8.drop (fromIntegral i)+ -- genericSplitAt i = UTF8.splitAt (fromIntegral i)+ -- genericReplicate i = UTF8.replicate (fromIntegral i)++instance ListLikeIO (UTF8 BS.ByteString) Char where+ hGetLine h = UTF8.fromRep <$> BSC.hGetLine h+ hGetContents h = UTF8.fromRep <$> BS.hGetContents h+ hGet h n = UTF8.fromRep <$> BS.hGet h n+ hGetNonBlocking h n = UTF8.fromRep <$> BS.hGetNonBlocking h n+ hPutStr h s = BS.hPutStr h (UTF8.toRep s)+ hPutStrLn h s = BSC.hPutStrLn h (UTF8.toRep s)+ -- getLine = BS.getLine+ -- getContents = BS.getContents+ -- putStr = BS.putStr+ -- putStrLn = BSC.putStrLn+ -- interact = BS.interact+ -- readFile = BS.readFile+ -- writeFile = BS.writeFile+ -- appendFile = BS.appendFile++#if !MIN_VERSION_utf8_string(1,0,2)+instance IsString (UTF8 BS.ByteString) where+ fromString = UTF8.fromString+#endif++instance StringLike (UTF8 BS.ByteString) where+ toString = UTF8.toString++instance Semigroup (UTF8 BS.ByteString) where+ a <> b = UTF8.fromRep $ UTF8.toRep a <> UTF8.toRep b++instance Monoid (UTF8 BS.ByteString) where+ mempty = UTF8.fromString []+ mappend = (<>)++--------------------------------------------------+-- UTF8 Lazy.ByteString++instance FoldableLL (UTF8 BSL.ByteString) Char where+ foldl = UTF8.foldl+ -- foldl' = UTF8.foldl'+ -- foldl1 = UTF8.foldl1+ foldr = UTF8.foldr+ -- foldr' = UTF8.foldr'+ -- foldr1 = UTF8.foldr1++instance IsList (UTF8 BSL.ByteString) where+ type Item (UTF8 BSL.ByteString) = Char+ toList = UTF8.toString+ fromList = LL.fromList' -- LL.map id++instance ListLike (UTF8 BSL.ByteString) Char where+ empty = mempty+ singleton c = UTF8.fromString [c]+ -- cons = UTF8.cons+ -- snoc = UTF8.snoc+ -- append = UTF8.append+ uncons = UTF8.uncons+ head = fst . fromMaybe (error "head") . uncons+ -- last = UTF8.last+ tail = snd . fromMaybe (error "tail") . uncons+ -- init = UTF8.init+ null s = UTF8.length s == 0+ length = fromInteger . toInteger . UTF8.length+ -- -- map =+ -- rigidMap = UTF8.map+ -- reverse = UTF8.reverse+ -- intersperse = UTF8.intersperse+ -- concat = UTF8.concat . toList+ -- --concatMap =+ -- rigidConcatMap = UTF8.concatMap+ -- any = UTF8.any+ -- all = UTF8.all+ -- maximum = UTF8.maximum+ -- minimum = UTF8.minimum+ -- replicate = UTF8.replicate+ take = UTF8.take . fromInteger . toInteger+ drop = UTF8.drop . fromInteger . toInteger+ splitAt = UTF8.splitAt . fromInteger . toInteger+ -- takeWhile = UTF8.takeWhile+ -- dropWhile = UTF8.dropWhile+ span = UTF8.span+ break = UTF8.break+ -- group = fromList . UTF8.group+ -- inits = fromList . UTF8.inits+ -- tails = fromList . UTF8.tails+ -- isPrefixOf = UTF8.isPrefixOf+ -- isSuffixOf = UTF8.isSuffixOf+ -- --isInfixOf = UTF8.isInfixOf+ -- elem = UTF8.elem+ -- notElem = UTF8.notElem+ -- find = UTF8.find+ -- filter = UTF8.filter+ -- --partition = UTF8.partition+ -- index = UTF8.index+ -- elemIndex = UTF8.elemIndex+ -- elemIndices x = fromList . UTF8.elemIndices x+ -- findIndex = UTF8.findIndex+ -- findIndices x = fromList . UTF8.findIndices x+ -- -- the default definitions don't work well for array-like things, so+ -- -- do monadic stuff via a list instead+ -- sequence = fmap fromList . P.sequenceA . toList+ -- mapM func = fmap fromList . P.traverse func . toList+ -- --nub = UTF8.nub+ -- --delete = UTF8.delete+ -- --deleteFirsts = UTF8.deleteFirsts+ -- --union = UTF8.union+ -- --intersect = UTF8.intersect+ -- sort = UTF8.sort+ -- --insert = UTF8.insert+ -- toList = UTF8.toString+ -- fromList = UTF8.pack+ -- fromListLike = fromList . toList+ -- --nubBy = UTF8.nubBy+ -- --deleteBy = UTF8.deleteBy+ -- --deleteFirstsBy = UTF8.deleteFirstsBy+ -- --unionBy = UTF8.unionBy+ -- --intersectBy = UTF8.intersectBy+ -- groupBy f = fromList . UTF8.groupBy f+ -- --sortBy = UTF8.sortBy+ -- --insertBy = UTF8.insertBy+ -- genericLength = fromInteger . fromIntegral . UTF8.length+ -- genericTake i = UTF8.take (fromIntegral i)+ -- genericDrop i = UTF8.drop (fromIntegral i)+ -- genericSplitAt i = UTF8.splitAt (fromIntegral i)+ -- genericReplicate i = UTF8.replicate (fromIntegral i)++instance ListLikeIO (UTF8 BSL.ByteString) Char where+ hGetLine h = (UTF8.fromRep . BSL.fromStrict) <$> BSC.hGetLine h+ hGetContents h = (UTF8.fromRep) <$> BSL.hGetContents h+ hGet h n = UTF8.fromRep <$> BSL.hGet h n+ hGetNonBlocking h n = UTF8.fromRep <$> BSL.hGetNonBlocking h n+ hPutStr h s = BSL.hPutStr h (UTF8.toRep s)+ hPutStrLn h s = BSLC.hPutStrLn h (UTF8.toRep s)+ -- getLine = BSL.getLine+ -- getContents = BSL.getContents+ -- putStr = BSL.putStr+ -- putStrLn = BSLC.putStrLn+ -- interact = BSL.interact+ -- readFile = BSL.readFile+ -- writeFile = BSL.writeFile+ -- appendFile = BSL.appendFile++#if !MIN_VERSION_utf8_string(1,0,2)+instance IsString (UTF8 BSL.ByteString) where+ fromString = UTF8.fromString+#endif++instance StringLike (UTF8 BSL.ByteString) where+ toString = UTF8.toString++instance Semigroup (UTF8 BSL.ByteString) where+ a <> b = UTF8.fromRep $ UTF8.toRep a <> UTF8.toRep b++instance Monoid (UTF8 BSL.ByteString) where+ mempty = UTF8.fromString []+ mappend = (<>)++{-# RULES "fromListLike/a" fromListLike = id :: a -> a #-}
src/Data/ListLike/Utils.hs view
@@ -13,10 +13,10 @@ {- | Module : Data.ListLike.Utils Copyright : Copyright (C) 2007 John Goerzen- License : LGPL+ License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional+ Maintainer : David Fox <dsf@seereason.com>, Andreas Abel+ Stability : stable Portability: portable Utilities for 'Data.ListLike.ListLike' and friends. More functions@@ -26,20 +26,20 @@ -} module Data.ListLike.Utils- (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list+ (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list,+ intercalate ) where-import Prelude hiding (length, head, last, null, tail, map, filter, concat, +import Prelude hiding (length, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, reverse, zip, zipWith, sequence, sequence_, mapM, mapM_, concatMap, and, or, sum, product, repeat, replicate, cycle, take, drop, splitAt, elem, notElem, unzip, lines, words,- unlines, unwords)+ unlines, unwords, foldMap) import Control.Monad (MonadPlus(..)) import Data.ListLike.Base import Data.ListLike.FoldableLL-import Data.Maybe (maybe) import Data.Monoid -- | Returns True if all elements are True@@ -69,10 +69,15 @@ -- | Converts to a MonadPlus instance toMonadPlus :: (MonadPlus m, ListLike full a) => full -> m (a, full)-toMonadPlus c- | null c = mzero- | otherwise = return (head c, tail c)+toMonadPlus = maybe mzero return . uncons -- | List-like destructor (like Data.Maybe.maybe) list :: ListLike full a => b -> (a -> full -> b) -> full -> b list d f = maybe d (uncurry f) . toMonadPlus++-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse'+-- xs xss))@. It inserts the list @xs@ in between the lists in @xss@+-- and concatenates the result.+intercalate :: (ListLike a item, ListLike b a)+ => a -> b -> a+intercalate x = concat . intersperse x
+ src/Data/ListLike/Vector.hs view
@@ -0,0 +1,11 @@+-- | 'Data.ListLike.ListLike' instances for several @Data.Vector@ types.+-- The @Data.ListLike.Vector.Generic@ instances are not exported from this+-- module in order to prevent collisions.+--+module Data.ListLike.Vector ()++where++import Data.ListLike.Vector.Storable ()+import Data.ListLike.Vector.Unboxed ()+import Data.ListLike.Vector.Vector ()
+ src/Data/ListLike/Vector/Generic.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-} -- for GHC >= 9.4++{-# OPTIONS -Wno-orphans #-}++-- | ListLike instance for any type supporting the @Data.Vector.Generic@+-- interface. To avoid collisions with other Vector instances, this module+-- must be imported directly.+module Data.ListLike.Vector.Generic ()++where++import Prelude as P+import qualified Data.Vector.Generic as V+import Data.Vector.Generic ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String+import Data.String (IsString)+import GHC.Exts (IsList(..))++instance {-# OVERLAPPABLE #-} V.Vector v a => FoldableLL (v a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++#if 0+instance {-# OVERLAPPABLE #-} (Monoid (v a), Eq (v a), V.Vector v a) => IsList (v a) where+ type Item (v a) = a+ toList = V.toList+ fromList = V.fromList+#endif++instance {-# OVERLAPPABLE #-} (IsList (v a), Item (v a) ~ a, Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ --toList = V.toList+ --fromList = V.fromList+ --fromListLike = fromList . toList+ --groupBy f =+ genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i =+ genericReplicate i = V.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance (Eq (v Char), V.Vector v Char) => IsString (v Char) where+ fromString = V.fromList++instance (Eq (v Char), V.Vector v Char) => StringLike (v Char) where+ toString = V.toList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' :: (V.Vector v a, Eq (v a)) => v a -> v a -> Bool+isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' :: (V.Vector v a, Eq (v a)) => v a -> v a -> Bool+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ src/Data/ListLike/Vector/Storable.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE MultiParamTypeClasses+ ,TypeFamilies+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Vector.Storable ()++where++import Prelude as P+import qualified Data.Vector.Storable as V+import Data.Vector.Storable ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String+import Data.String (IsString)++import Foreign.Storable (Storable)+++instance Storable a => FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance Storable a => ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ --toList = V.toList+ --fromList = V.fromList+ --fromListLike = fromList . toList+ --groupBy f =+ genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i =+ genericReplicate i = V.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance IsString (V.Vector Char) where+ fromString = fromList++instance StringLike (V.Vector Char) where+ toString = toList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' :: (Storable a, Eq a) => V.Vector a -> V.Vector a -> Bool+isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' :: (Storable a, Eq a) => V.Vector a -> V.Vector a -> Bool+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ src/Data/ListLike/Vector/Unboxed.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE MultiParamTypeClasses+ ,TypeFamilies+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Vector.Unboxed ()++where++import Prelude as P+import qualified Data.Vector.Unboxed as V+import Data.Vector.Unboxed (Unbox, (!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String+import Data.String (IsString)+++instance Unbox a => FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance Unbox a => ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ --toList = V.toList+ --fromList = V.fromList+ --fromListLike = fromList . toList+ --groupBy f =+ genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i =+ genericReplicate i = V.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance IsString (V.Vector Char) where+ fromString = fromList++instance StringLike (V.Vector Char) where+ toString = toList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' :: (Unbox a, Eq a) => V.Vector a -> V.Vector a -> Bool+isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' :: (Unbox a, Eq a) => V.Vector a -> V.Vector a -> Bool+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ src/Data/ListLike/Vector/Vector.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE MultiParamTypeClasses+ ,TypeFamilies+ ,FlexibleInstances #-}+{-# OPTIONS -Wno-orphans #-}++module Data.ListLike.Vector.Vector ()++where++import Prelude as P+import qualified Data.Vector as V+import Data.Vector ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String+import Data.String (IsString)++instance FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ --toList = V.toList+ --fromList = V.fromList+ --fromListLike = fromList . toList+ --groupBy f =+ genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i =+ genericReplicate i = V.replicate (fromIntegral i)++ sequence = fmap fromList . P.sequenceA . toList+ mapM func = fmap fromList . P.traverse func . toList++instance IsString (V.Vector Char) where+ fromString = fromList++instance StringLike (V.Vector Char) where+ toString = toList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' :: Eq a => V.Vector a -> V.Vector a -> Bool+isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' :: Eq a => V.Vector a -> V.Vector a -> Bool+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ testsrc/TestInfrastructure.hs view
@@ -0,0 +1,395 @@+{-# LANGUAGE CPP+ ,ScopedTypeVariables+ ,RankNTypes+ ,ExistentialQuantification+ ,MultiParamTypeClasses+ ,FunctionalDependencies+ ,FlexibleInstances+ ,UndecidableInstances+ ,TypeFamilies+ ,FlexibleContexts #-}+{-# OPTIONS -Wno-orphans #-}++{-+Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>++All rights reserved.++For license and copyright information, see the file COPYRIGHT++-}++-- FIXME -- better code is in offlineimap v7 branch+module TestInfrastructure where++import Test.QuickCheck+import Test.QuickCheck.Test+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ListLike as LL+import qualified Data.ListLike.Chars as Chars+import qualified Data.Array as A+import qualified Data.DList as DL+import qualified Data.FMList as FM+import qualified Data.Semigroup as Sem+import qualified Data.Sequence as S+--import qualified Data.Foldable as F+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.String.UTF8 as UTF8+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+--import System.Random+import System.IO+import qualified Test.HUnit as HU+import Text.Printf+import Data.Function (on)+import Data.String (IsString(fromString))+import Data.Word+import Data.List+import Data.Monoid (Monoid(..))+import GHC.Exts (IsList(Item))++simpleArb :: (LL.ListLike f i, Arbitrary i) => Gen f+simpleArb = sized (\n -> choose (0, n) >>= myVector)+ where myVector n = do+ arblist <- vector n+ return (LL.fromList arblist)++instance (Arbitrary i) => Arbitrary (MyList i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink (MyList l) = map MyList $ shrink l++instance (CoArbitrary i) => CoArbitrary (MyList i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i) => Arbitrary (DL.DList i) where+ arbitrary = simpleArb+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (DL.DList i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i) => Arbitrary (FM.FMList i) where+ arbitrary = simpleArb+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (FM.FMList i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (BSL.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (BSL.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (BS.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (BS.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary Chars.Chars where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary Chars.Chars where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary i => Arbitrary (A.Array Int i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (A.Array Int i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (T.Text) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (T.Text) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (TL.Text) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (TL.Text) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (TB.Builder) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (TB.Builder) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (UTF8.UTF8 BS.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (UTF8.UTF8 BS.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (UTF8.UTF8 BSL.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (UTF8.UTF8 BSL.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary i => Arbitrary (V.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (V.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i, VS.Storable i) => Arbitrary (VS.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i, VS.Storable i) => CoArbitrary (VS.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i, VU.Unbox i) => Arbitrary (VU.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i, VU.Unbox i) => CoArbitrary (VU.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++class (Show b, Arbitrary a, Show a, Eq a, Eq b, LL.ListLike a b) => TestLL a b where+ llcmp :: a -> [b] -> Property+ llcmp f l = (putStrLn ("Expected: " ++ show l ++ "\nGot: " ++ show f))+ `whenFail` (l == (LL.toList f))+ checkLengths :: a -> [b] -> Bool+ checkLengths f l = (LL.length f) == length l++instance (Arbitrary a, Show a, Eq a) => TestLL [a] a where++instance (Arbitrary a, Show a, Eq a) => TestLL (MyList a) a++instance (Arbitrary a, Show a, Eq a) => TestLL (DL.DList a) a++instance (Arbitrary a, Show a, Eq a) => TestLL (FM.FMList a) a++instance TestLL BS.ByteString Word8 where++instance TestLL BSL.ByteString Word8 where++instance TestLL Chars.Chars Char where++instance (Arbitrary a, Show a, Eq a) => TestLL (S.Seq a) a where++instance (Arbitrary a, Show a, Eq a) => TestLL (A.Array Int a) a where++instance TestLL T.Text Char where++instance TestLL TL.Text Char where++instance TestLL TB.Builder Char where++instance TestLL (UTF8.UTF8 BS.ByteString) Char where++instance TestLL (UTF8.UTF8 BSL.ByteString) Char where++instance (Arbitrary a, Show a, Eq a) => TestLL (V.Vector a) a where++instance (Arbitrary a, Show a, Eq a, VS.Storable a) => TestLL (VS.Vector a) a where++instance (Arbitrary a, Show a, Eq a, VU.Unbox a) => TestLL (VU.Vector a) a where++instance Eq a => Eq (FM.FMList a) where+ (==) = (==) `on` FM.toList++mapRemoveDups :: (Eq k1) => [(k1, v1)] -> [(k1, v1)]+mapRemoveDups = nubBy (\(k1, _) (k2, _) -> k1 == k2)++data MyList a = MyList [a]+ deriving (Ord, Eq, Show)++instance LL.FoldableLL (MyList a) a where+ foldr f i (MyList x) = foldr f i x+ foldl f i (MyList x) = foldl f i x+ foldr1 f (MyList x) = foldr1 f x+ foldl1 f (MyList x) = foldl1 f x++instance Sem.Semigroup (MyList a) where+ MyList x <> MyList y = MyList (x ++ y)++instance Monoid (MyList a) where+ mempty = MyList []+ mappend = (Sem.<>)++instance IsList (MyList a) where+ type Item (MyList a) = a+ toList (MyList xs) = xs+ fromList = MyList++instance LL.ListLike (MyList a) a where+ singleton x = MyList [x]+ -- Andreas Abel, 2023-10-10, issue #32:+ -- Avoid 'head' and 'tail' from 'Prelude' and thus the x-partial warning of GHC 9.8.+ head (MyList (x:xs)) = x+ head (MyList []) = undefined+ tail (MyList (x:xs)) = MyList xs+ tail (MyList [] ) = undefined+ null (MyList x) = null x++instance IsString (MyList Char) where+ fromString = MyList++instance LL.StringLike (MyList Char) where+ toString (MyList x) = x++mkTest :: Testable prop => String -> prop -> HU.Test+mkTest msg test = HU.TestLabel msg $ HU.TestCase (quickCheckResult test >>= HU.assertBool msg . isSuccess)++-- Modified from HUnit+runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)+runVerbTestText (HU.PutText put us) test = do+ (counts, us') <- HU.performTest reportStart reportError reportFailure us test+ us'' <- put (HU.showCounts counts) True us'+ return (counts, us'')+ where+ reportStart ss us' = do+ hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))+ put (HU.showCounts (HU.counts ss)) False us'+ reportError = reportProblem "Error:" "Error in: "+ reportFailure = reportProblem "Failure:" "Failure in: "+ reportProblem p0 p1 _mloc msg ss us' = put line True us'+ where line = "### " ++ kind ++ path' ++ '\n' : msg+ kind = if null path' then p0 else p1+ path' = HU.showPath (HU.path ss)+++-- | So we can test map and friends+instance Show (a -> b) where+ show _ = "(a -> b)"++data LLTest f i =+ forall t. Testable t => LLTest (f -> t)++data LLWrap f' f i =+ forall t. Testable t => LLWrap (f' -> t)++w :: TestLL f i => String -> LLTest f i -> HU.Test+w msg (LLTest theTest) = mkTest msg theTest++ws :: (LL.StringLike f, TestLL f i) => String -> LLTest f i -> HU.Test+ws = w++wwrap :: (TestLL f i, TestLL f' f) => String -> LLWrap f' f i -> HU.Test+wwrap msg f = case f of+ LLWrap theTest -> mkTest msg theTest++t :: forall f t i. (TestLL f i, Arbitrary f, Arbitrary i, Show f, Eq f, Testable t) => (f -> t) -> LLTest f i+t = LLTest++-- | all props, wrapped list+apw :: String -> (forall f' f i. (TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, LL.ListLike f' f, Show f', TestLL f' f, Arbitrary f', Eq f') => LLWrap f' f i) -> HU.Test+apw msg x = HU.TestLabel msg $ HU.TestList $+ [wwrap "wrap [[Int]]" (x::LLWrap [[Int]] [Int] Int),+ wwrap "wrap MyList (MyList Int)" (x::LLWrap (MyList (MyList Int)) (MyList Int) Int),+ wwrap "wrap S.Seq (S.Seq Int)" (x::LLWrap (S.Seq (S.Seq Int)) (S.Seq Int) Int),+ wwrap "wrap Array (Array Int)" (x::LLWrap (A.Array Int (A.Array Int Int)) (A.Array Int Int) Int),+ wwrap "wrap Array [Int]" (x::LLWrap (A.Array Int [Int]) [Int] Int)+ ,wwrap "wrap (Vector (Vector Int))" (x::LLWrap (V.Vector (V.Vector Int)) (V.Vector Int) Int)+ ]++-- | all props, 1 args: full+apf :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, CoArbitrary f, CoArbitrary i) => LLTest f i) -> HU.Test+apf msg x = HU.TestLabel msg $ HU.TestList $+ [w "[Int]" (x::LLTest [Int] Int),+ w "MyList Int" (x::LLTest (MyList Int) Int),+ w "String" (x::LLTest String Char),+ w "[Bool]" (x::LLTest [Bool] Bool),+ w "MyList Bool" (x::LLTest (MyList Bool) Bool),+ w "ByteString" (x::LLTest BS.ByteString Word8),+ w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8),+ w "Chars" (x::LLTest Chars.Chars Char),+ w "Sequence Int" (x::LLTest (S.Seq Int) Int),+ w "Sequence Bool" (x::LLTest (S.Seq Bool) Bool),+ w "Sequence Char" (x::LLTest (S.Seq Char) Char),+ w "Array Int Int" (x::LLTest (A.Array Int Int) Int),+ w "Array Int Bool" (x::LLTest (A.Array Int Bool) Bool),+ w "Array (Just Int)" (x::LLTest (A.Array Int (Maybe Int)) (Maybe Int)),+ w "DList Int" (x::LLTest (DL.DList Int) Int),+ -- w "FMList Int" (x::LLTest (FM.FMList Int) Int),+ w "Vector Int" (x::LLTest (V.Vector Int) Int),+ w "StorableVector Int" (x::LLTest (VS.Vector Int) Int),+ w "UnboxVector Int" (x::LLTest (VU.Vector Int) Int),+ w "Vector Bool" (x::LLTest (V.Vector Bool) Bool),+ w "StorableVector Bool" (x::LLTest (VS.Vector Bool) Bool),+ w "UnboxVector Bool" (x::LLTest (VU.Vector Bool) Bool),+ w "Text" (x::LLTest T.Text Char),+ w "Text.Lazy" (x::LLTest TL.Text Char),+ w "Text.Builder" (x::LLTest TB.Builder Char),+ w "UTF8 ByteString" (x::LLTest (UTF8.UTF8 BS.ByteString) Char),+ w "UTF8 ByteString.Lazy" (x::LLTest (UTF8.UTF8 BSL.ByteString) Char)+ ]++-- | all props, 1 args: full+aps :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.StringLike f, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i) => LLTest f i) -> HU.Test+aps msg x = HU.TestLabel msg $ HU.TestList $+ [w "String" (x::LLTest String Char),+ w "MyList Char" (x::LLTest (MyList Char) Char),+ w "Sequence Char" (x::LLTest (S.Seq Char) Char),+ w "DList Char" (x::LLTest (DL.DList Char) Char),+ -- w "FMList Char" (x::LLTest (FM.FMList Char) Char),+ -- w "ByteString" (x::LLTest BS.ByteString Word8),+ -- w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8),+ w "Chars" (x::LLTest Chars.Chars Char),+ w "Array Int Char" (x::LLTest (A.Array Int Char) Char),+ w "Text" (x::LLTest T.Text Char),+ w "Text.Lazy" (x::LLTest TL.Text Char),+ w "Text.Builder" (x::LLTest TB.Builder Char),+ w "UTF8 ByteString" (x::LLTest (UTF8.UTF8 BS.ByteString) Char),+ w "UTF8 ByteString.Lazy" (x::LLTest (UTF8.UTF8 BSL.ByteString) Char),+ w "Vector Char" (x::LLTest (V.Vector Char) Char),+ w "Vector.Unbox Char" (x::LLTest (VU.Vector Char) Char)+ ]
testsrc/runtests.hs view
@@ -1,3 +1,18 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}++{-# OPTIONS -Wno-missing-signatures #-}++ {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org> @@ -6,25 +21,22 @@ For license and copyright information, see the file COPYRIGHT -}+module Main where +import Control.Applicative ((<$>), (<*>)) import Test.QuickCheck-import Test.QuickCheck.Batch-import qualified Data.ByteString as BS-import qualified Data.Array as A-import qualified Data.ByteString.Lazy as BSL import qualified Data.ListLike as LL-import qualified Data.Map as Map-import qualified Data.Array as A-import qualified Data.Foldable as F-import System.Random+--import qualified Data.Foldable as F+--import System.Random import qualified Test.HUnit as HU import System.IO-import Text.Printf-import Data.Word+--import Text.Printf+--import Data.Word import Data.List import Data.Monoid import TestInfrastructure import Data.Foldable(foldr', fold, foldMap)+import System.Exit import System.Info @@ -35,8 +47,8 @@ prop_empty f = (LL.toList l == []) && (LL.null l) && (LL.length l == 0) where l = asTypeOf LL.empty f -prop_tofromlist f = - LL.toList f == l && +prop_tofromlist f =+ LL.toList f == l && LL.length f == length l && f == (LL.fromList . LL.toList $ f) where l = LL.toList f@@ -45,14 +57,22 @@ prop_cons f i = llcmp (LL.cons i f) (i : (LL.toList f)) prop_append f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2) prop_head f = not (LL.null f) ==> LL.head f == head (LL.toList f)-prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f)+ where+ head (x:xs) = x+ head [] = undefined+ -- Andreas Abel, 2023-10-10, issue #32:+ -- Redefine 'head' and 'tail' to avoid the x-partial warning of GHC 9.8. prop_tail f = not (LL.null f) ==> llcmp (LL.tail f) (tail (LL.toList f))+ where+ tail (x:xs) = xs+ tail [] = undefined prop_init f = not (LL.null f) ==> llcmp (LL.init f) (init (LL.toList f))+prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f) prop_null f = LL.null f == null (LL.toList f) prop_length2 f = checkLengths f (LL.toList f) prop_length3 f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2) -prop_map :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> item) -> Result+prop_map :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> item) -> Property prop_map f func = llcmp llmap (map func (LL.toList f)) where llmap = asTypeOf (LL.map func f) (LL.toList f) @@ -60,10 +80,10 @@ prop_reverse f = llcmp (LL.reverse f) (reverse (LL.toList f)) prop_intersperse f i = llcmp (LL.intersperse i f) (intersperse i (LL.toList f)) -prop_concat f = +prop_concat f = llcmp (LL.concat f) (concat $ map LL.toList (LL.toList f)) -prop_concatmap :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> [item]) -> Result+prop_concatmap :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> [item]) -> Property prop_concatmap f func = llcmp (LL.concatMap func f) (concatMap func (LL.toList f))@@ -72,53 +92,59 @@ llcmp (LL.rigidConcatMap func f) (concatMap (LL.toList . func) (LL.toList f)) -prop_any f func = (LL.any func f) @?= (any func (LL.toList f))-prop_all f func = (LL.all func f) @?= (all func (LL.toList f))-prop_maximum f = not (LL.null f) ==> LL.maximum f @=? maximum (LL.toList f)-prop_minimum f = not (LL.null f) ==> LL.minimum f @=? minimum (LL.toList f)-prop_replicate f count i = - llcmp res (replicate count i)+prop_any f func = (LL.any func f) == (any func (LL.toList f))+prop_all f func = (LL.all func f) == (all func (LL.toList f))+prop_maximum f = not (LL.null f) ==> LL.maximum f == maximum (LL.toList f)+prop_minimum f = not (LL.null f) ==> LL.minimum f == minimum (LL.toList f)+prop_replicate f count i = count <= 1000 ==> llcmp res (replicate count i) where res = asTypeOf (LL.replicate count i) f prop_take f count = llcmp (LL.take count f) (take count (LL.toList f)) prop_drop f count = count >= 0 ==> llcmp (LL.drop count f) (drop count (LL.toList f)) prop_splitAt f count = count >= 0 ==>- llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f] + llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f] [LL.splitAt count (LL.toList f)]-prop_takeWhile f func = llcmp (LL.takeWhile func f) +prop_takeWhile f func = llcmp (LL.takeWhile func f) (takeWhile func (LL.toList f))-prop_dropWhile f func = llcmp (LL.dropWhile func f) +prop_dropWhile f func = llcmp (LL.dropWhile func f) (dropWhile func (LL.toList f))-prop_span f func = +prop_dropWhileEnd f func = llcmp (LL.dropWhileEnd func f)+ (dropWhileEnd func (LL.toList f))+prop_span f func = llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.span func $ f] [span func (LL.toList f)]-prop_break f func = +prop_break f func = llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.break func $ f] [break func (LL.toList f)] prop_group f = -- llcmp (map LL.toList (LL.group f)) (group (LL.toList f))- (map LL.toList (LL.group f)) @?= (group (LL.toList f))-prop_inits f = (map LL.toList (LL.inits f)) @?= (inits (LL.toList f))-prop_tails f = (map LL.toList (LL.tails f)) @?= (tails (LL.toList f))-prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 @?= + (map LL.toList (LL.group f)) == (group (LL.toList f))+prop_inits f = (map LL.toList (LL.inits f)) == (inits (LL.toList f))+prop_tails f = (map LL.toList (LL.tails f)) == (tails (LL.toList f))+prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 == (isPrefixOf (LL.toList f1) (LL.toList f2))-prop_isSuffixOf f1 f2 = LL.isSuffixOf f1 f2 @?=+prop_isSuffixOf f1 f2 = LL.isSuffixOf f1 f2 == (isSuffixOf (LL.toList f1) (LL.toList f2))-prop_isInfixOf f1 f2 = LL.isInfixOf f1 f2 @?=+prop_isInfixOf f1 f2 = LL.isInfixOf f1 f2 == (isInfixOf (LL.toList f1) (LL.toList f2))-prop_elem f i = LL.elem i f @?= elem i (LL.toList f)-prop_notElem f i = LL.notElem i f @?= notElem i (LL.toList f)-prop_find f func = LL.find func f @?= find func (LL.toList f)+prop_stripPrefix f1 f2 = (LL.toList <$> LL.stripPrefix f1 f2) ==+ (stripPrefix (LL.toList f1) (LL.toList f2))+prop_stripPrefix2 f1 f2 = (LL.toList <$> LL.stripPrefix f1 (f1 <> f2)) ==+ (stripPrefix (LL.toList f1) (LL.toList $ f1 <> f2))+prop_stripSuffix f1 f2 = LL.stripSuffix f1 (f2 <> f1) == Just f2+prop_elem f i = LL.elem i f == elem i (LL.toList f)+prop_notElem f i = LL.notElem i f == notElem i (LL.toList f)+prop_find f func = LL.find func f == find func (LL.toList f) prop_filter f func = llcmp (LL.filter func f) (filter func (LL.toList f))-prop_partition f func = - (LL.toList f1, LL.toList f2) @?= partition func (LL.toList f)+prop_partition f func =+ (LL.toList f1, LL.toList f2) == partition func (LL.toList f) where (f1, f2) = LL.partition func f prop_index f i = (i >= 0 && i < LL.length f) ==>- (LL.index f i @?= ((LL.toList f) !! i))-prop_elemIndex f i = LL.elemIndex i f @?= elemIndex i (LL.toList f)-prop_elemIndices f i = LL.elemIndices i f @?= elemIndices i (LL.toList f)-prop_findIndex f func = LL.findIndex func f @?= findIndex func (LL.toList f)+ (LL.index f i == ((LL.toList f) !! i))+prop_elemIndex f i = LL.elemIndex i f == elemIndex i (LL.toList f)+prop_elemIndices f i = LL.elemIndices i f == elemIndices i (LL.toList f)+prop_findIndex f func = LL.findIndex func f == findIndex func (LL.toList f) prop_findIndices f func =- LL.findIndices func f @?= findIndices func (LL.toList f)+ LL.findIndices func f == findIndices func (LL.toList f) prop_sequence f = case (llres, sequence testit) of@@ -127,30 +153,31 @@ where testit = map Just (LL.toList f) llres = asTypeOf (LL.sequence testit) (Just f) -prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Result-prop_mapM f func = llmapM @?= (mapM func (LL.toList f))+prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Bool+prop_mapM f func = llmapM == (mapM func (LL.toList f)) where llmapM = asTypeOf (LL.mapM func f) (Just (LL.toList f)) -prop_rigidMapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Result-prop_rigidMapM f func = +prop_rigidMapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Property+prop_rigidMapM f func = case (LL.rigidMapM func f, mapM func (LL.toList f)) of- (Just ll, Just l) -> llcmp ll l- _ -> error "error in prop_rigidMapM"+ (Just ll, Just l) -> llcmp ll l+ (Nothing, Nothing) -> property True+ e -> error $ "error in prop_rigidMapM: " ++ show e -- FIXME: can we test mapM_? prop_nub f = llcmp (LL.nub f) (nub (LL.toList f)) prop_delete f i = llcmp (LL.delete i f) (delete i (LL.toList f))-prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2) +prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2) ((LL.toList f1) \\ (LL.toList f2))-prop_union f1 f2 = llcmp (LL.union f1 f2) +prop_union f1 f2 = llcmp (LL.union f1 f2) (union (LL.toList f1) (LL.toList f2))-prop_intersect f1 f2 = llcmp (LL.intersect f1 f2) +prop_intersect f1 f2 = llcmp (LL.intersect f1 f2) (intersect (LL.toList f1) (LL.toList f2)) prop_sort f1 = llcmp (LL.sort f1) (sort (LL.toList f1)) prop_insert f i = llcmp (LL.insert i f) (insert i (LL.toList f)) prop_nubBy f func = llcmp (LL.nubBy func f) (nubBy func (LL.toList f))-prop_deleteBy f func i = llcmp (LL.deleteBy func i f) +prop_deleteBy f func i = llcmp (LL.deleteBy func i f) (deleteBy func i (LL.toList f)) prop_deleteFirstsBy f1 f2 func = llcmp (LL.deleteFirstsBy func f1 f2) (deleteFirstsBy func (LL.toList f1) (LL.toList f2))@@ -159,7 +186,7 @@ prop_intersectBy f1 f2 func = llcmp (LL.intersectBy func f1 f2) (intersectBy func (LL.toList f1) (LL.toList f2)) prop_groupBy f func =- (map LL.toList (LL.groupBy func f)) @?= (groupBy func (LL.toList f))+ (map LL.toList (LL.groupBy func f)) == (groupBy func (LL.toList f)) prop_sortBy1 f = llcmp (LL.sortBy compare f) (sortBy compare (LL.toList f)) prop_sortBy2 f = llcmp (LL.sortBy func f) (sortBy func (LL.toList f)) where func x y = compare y x@@ -170,7 +197,7 @@ (insertBy func i (LL.toList f)) where func x y = compare y x prop_genericLength f =- LL.genericLength f @?= genericLength (LL.toList f)+ LL.genericLength f == genericLength (LL.toList f) prop_genericTake f (i::Integer) = (i >= 0) ==> llcmp (LL.genericTake i f) (genericTake i (LL.toList f)) prop_genericDrop f (i::Integer) = (i >= 0) ==>@@ -184,44 +211,44 @@ --prop_zip :: (LL.ListLike full item, LL.ListLike result (item, Int)) => -- full -> Result-prop_zip f = LL.zip f f2 @?= zip (LL.toList f) f2+prop_zip f = LL.zip f f2 == zip (LL.toList f) f2 where f2 = [(-5::Int)..]-prop_zipWith f = - LL.toList res @?= (zipWith func (LL.toList f) f2)+prop_zipWith f =+ LL.toList res == (zipWith func (LL.toList f) f2) where f2 = [(100::Int)..(-100)] func x y = (y + 5, x) res = asTypeOf (LL.zipWith func f f2) [(5::Int, LL.head f)]---FIXME: prop_unzip +--FIXME: prop_unzip --FIXME: prop_and --FIXME: prop_or --FIXME: prop_sum --FIXME: prop_product-prop_foldl f func (i::Int) = LL.foldl func i f @?= foldl func i (LL.toList f)+prop_foldl f func (i::Int) = LL.foldl func i f == foldl func i (LL.toList f) prop_foldl' f func (i::Integer) =- LL.foldl' func i f @?= foldl' func i (LL.toList f)-prop_foldl1 f func = not (LL.null f) ==> - (LL.foldl1 func f) @?= (foldl1 func (LL.toList f))-prop_foldr f func (i::Int) = LL.foldr func i f @?= foldr func i (LL.toList f)+ LL.foldl' func i f == foldl' func i (LL.toList f)+prop_foldl1 f func = not (LL.null f) ==>+ (LL.foldl1 func f) == (foldl1 func (LL.toList f))+prop_foldr f func (i::Int) = LL.foldr func i f == foldr func i (LL.toList f) prop_foldr' f func (i::Integer) =- LL.foldr' func i f @?= foldr' func i (LL.toList f)+ LL.foldr' func i f == foldr' func i (LL.toList f) prop_foldr1 f func = not (LL.null f) ==>- LL.foldl1 func f @?= foldl1 func (LL.toList f)+ LL.foldl1 func f == foldl1 func (LL.toList f) prop_fold f = llcmp res resl where res = LL.fold f resl = fold (map LL.toList (LL.toList f))-prop_foldMap :: (LL.ListLike full item, Eq full) => full -> (item -> [Int]) -> Result-prop_foldMap f func = res @?= resl+prop_foldMap :: (LL.ListLike full item, Eq full) => full -> (item -> [Int]) -> Bool+prop_foldMap f func = res == resl where res = LL.foldMap func f resl = foldMap func (LL.toList f) -- asTypeOf (foldMap (LL.toList f)) (head f) prop_toString f = ((LL.fromString . LL.toString $ f) == f) where l = LL.toList f-prop_fromString f x = - LL.toString (asTypeOf (LL.fromString x) f) @?= x-prop_lines f = map LL.toString res @?= lines (LL.toString f)+prop_fromString f x =+ LL.toString (asTypeOf (LL.fromString x) f) == x+prop_lines f = map LL.toString res == lines (LL.toString f) where res = asTypeOf (LL.lines f) [f]-prop_words f = map LL.toString res @?= words (LL.toString f)+prop_words f = map LL.toString res == words (LL.toString f) where res = asTypeOf (LL.words f) [f] allt = [apf "empty" (t prop_empty),@@ -254,6 +281,7 @@ apf "splitAt" (t prop_splitAt), apf "takeWhile" (t prop_takeWhile), apf "dropWhile" (t prop_dropWhile),+ apf "dropWhileEnd" (t prop_dropWhileEnd), apf "span" (t prop_span), apf "break" (t prop_break), apf "group" (t prop_group),@@ -262,6 +290,9 @@ apf "isPrefixOf" (t prop_isPrefixOf), apf "isSuffixOf" (t prop_isSuffixOf), apf "isInfixOf" (t prop_isInfixOf),+ apf "stripPrefix" (t prop_stripPrefix),+ apf "stripPrefix2" (t prop_stripPrefix2),+ apf "stripSuffix" (t prop_stripSuffix), apf "elem" (t prop_elem), apf "notElem" (t prop_notElem), apf "find" (t prop_find),@@ -302,13 +333,13 @@ apf "genericSplitAt" (t prop_genericSplitAt), apf "genericReplicate" (t prop_genericReplicate), apf "zip" (t prop_zip),- apf "zipWith" (t prop_zipWith) + apf "zipWith" (t prop_zipWith) -- apf "unzip" (t prop_unzip), -- apf "and" (t prop_and), -- apf "or" (t prop_or), -- apf "sum" (t prop_sum), -- apf "propduct" (t prop_product),- -- sequence_ + -- sequence_ ] allf = (if compilerName == "hugs" then [] else [ apf "foldl" (t prop_foldl),@@ -320,14 +351,14 @@ apf "foldr" (t prop_foldr), apf "foldr'" (t prop_foldr'), apw "fold" (LLWrap prop_fold),- apf "foldMap" (t prop_foldMap) + apf "foldMap" (t prop_foldMap) ] alls = [ aps "toString" (t prop_toString), aps "fromString" (t prop_fromString), aps "lines" (t prop_lines),- aps "words" (t prop_words) + aps "words" (t prop_words) -- FIXME: aps (t prop_unlines), -- FIXME: aps (t prop_unwords) ]@@ -338,7 +369,11 @@ testh = HU.runTestTT $ allTests testv = runVerbTestText (HU.putTextToHandle stderr True) $ allTests- -main = - do testv- return ()++main = do+ (counts, n) <- testv+ case HU.errors counts + HU.failures counts of+ 0 -> return ()+ n -> do+ putStrLn ("counts=" ++ show counts ++ " n=" ++ show n)+ exitWith (ExitFailure 1)