packages feed

txt-sushi (empty) → 0.1

raw patch · 29 files changed

+3550/−0 lines, 29 filesdep +basedep +containersdep +directorysetup-changed

Dependencies added: base, containers, directory, haskell98, parsec

Files

+ .boring view
@@ -0,0 +1,116 @@+# Boring file regexps:++# Stuff that's boring for txt-sushi+^dist$++### compiler and interpreter intermediate files+# haskell (ghc) interfaces+\.hi$+\.hi-boot$+\.o-boot$+# object files+\.o$+\.o\.cmd$+# profiling haskell+\.p_hi$+\.p_o$+# haskell program coverage resp. profiling info+\.tix$+\.prof$+# fortran module files+\.mod$+# linux kernel+\.ko\.cmd$+\.mod\.c$+(^|/)\.tmp_versions($|/)+# *.ko files aren't boring by default because they might+# be Korean translations rather than kernel modules+# \.ko$+# python, emacs, java byte code+\.py[co]$+\.elc$+\.class$+# objects and libraries; lo and la are libtool things+\.(obj|a|exe|so|lo|la)$+# compiled zsh configuration files+\.zwc$+# Common LISP output files for CLISP and CMUCL+\.(fas|fasl|sparcf|x86f)$++### build and packaging systems+# cabal intermediates+\.installed-pkg-config+\.setup-config+# standard cabal build dir, might not be boring for everybody+# ^dist(/|$)+# autotools+(^|/)autom4te\.cache($|/)+(^|/)config\.(log|status)$+# microsoft web expression, visual studio metadata directories+\_vti_cnf$+\_vti_pvt$+# gentoo tools+\.revdep-rebuild.*+# generated dependencies+^\.depend$++### version control systems+# cvs+(^|/)CVS($|/)+\.cvsignore$+# cvs, emacs locks+^\.#+# rcs+(^|/)RCS($|/)+,v$+# subversion+(^|/)\.svn($|/)+# mercurial+(^|/)\.hg($|/)+# git+(^|/)\.git($|/)+# bzr+\.bzr$+# sccs+(^|/)SCCS($|/)+# darcs+(^|/)_darcs($|/)+(^|/)\.darcsrepo($|/)+^\.darcs-temp-mail$+-darcs-backup[[:digit:]]+$+# gnu arch+(^|/)(\+|,)+(^|/)vssver\.scc$+\.swp$+(^|/)MT($|/)+(^|/)\{arch\}($|/)+(^|/).arch-ids($|/)+# bitkeeper+(^|/)BitKeeper($|/)+(^|/)ChangeSet($|/)++### miscellaneous+# backup files+~$+\.bak$+\.BAK$+# patch originals and rejects+\.orig$+\.rej$+# X server+\..serverauth.*+# image spam+\#+(^|/)Thumbs\.db$+# vi, emacs tags+(^|/)(tags|TAGS)$+#(^|/)\.[^/]+# core dumps+(^|/|\.)core$+# partial broken files (KIO copy operations)+\.part$+# waf files, see http://code.google.com/p/waf/+(^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/)+(^|/)\.lock-wscript$+# mac os finder+(^|/)\.DS_Store$
+ COPYING view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, 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+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If 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 convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU 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+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state 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 program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Setup.hs view
@@ -0,0 +1,193 @@+import Distribution.PackageDescription(PackageDescription)+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)++import Text.ParserCombinators.Parsec++import TxtSushi.SQLParser++main = defaultMainWithHooks $ simpleUserHooks {runTests = runTxtSushiTests}++--------------------------------------------------------------------------------+-- Test code+--------------------------------------------------------------------------------++runTxtSushiTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()+runTxtSushiTests _ _ _ _ = do+    let+        -- test statement 1+        stmt1 = SelectStatement {+                    columnSelections = [+                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},+                        AllColumnsFrom {sourceTableName = "table2"}],+                    maybeFromTable = Just (+                        InnerJoin {+                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},+                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},+                            onCondition = FunctionExpression {+                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},+                                functionArguments = [+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},+                            maybeTableAlias = Nothing}),+                    maybeWhereFilter = Nothing,+                    orderByItems = []}+        stmt1_1Txt =+            "select table1.col1, table2.* " +++            "from table1 inner join table2 on table1.col1 = table2.col1"+        stmt1_2Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1"+        +        -- test statement 2+        stmt2 = SelectStatement {+                    columnSelections = [+                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},+                        AllColumnsFrom {sourceTableName = "table2"}],+                    maybeFromTable = Just (+                        InnerJoin {+                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},+                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},+                            onCondition = FunctionExpression {+                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},+                                functionArguments = [+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},+                            maybeTableAlias = Nothing}),+                    maybeWhereFilter = Just (+                        FunctionExpression {+                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},+                            functionArguments = [+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),+                    orderByItems = []}+        stmt2_1Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper(table1.col1)<>lower(table1.col1)"+        stmt2_2Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper(table1.col1) <> lower(table1.col1)"+        +        -- test statement 3+        stmt3 = SelectStatement {+                    columnSelections = [+                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},+                        AllColumnsFrom {sourceTableName = "table2"}],+                    maybeFromTable = Just (+                        InnerJoin {+                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},+                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},+                            onCondition = FunctionExpression {+                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},+                                functionArguments = [+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},+                            maybeTableAlias = Nothing}),+                    maybeWhereFilter = Just (+                        FunctionExpression {+                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},+                            functionArguments = [+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),+                    orderByItems = [OrderByItem {+                        orderExpression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "firstName"}},+                        orderAscending = True}]}+        stmt3_1Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper(table1.col1)<>lower(table1.col1) order by table1.firstName asc"+        stmt3_2Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper(table1.col1)<>lower(table1.col1) order by table1.firstName"+        stmt3_3Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName ascending"+        +        -- test statement 4+        stmt4 = SelectStatement {+                    columnSelections = [+                        ExpressionColumn {expression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}},+                        AllColumnsFrom {sourceTableName = "table2"}],+                    maybeFromTable = Just (+                        InnerJoin {+                            leftJoinTable = TableIdentifier {tableName = "table1", maybeTableAlias = Nothing},+                            rightJoinTable = TableIdentifier {tableName = "table2", maybeTableAlias = Nothing},+                            onCondition = FunctionExpression {+                                sqlFunction = SQLFunction {functionName = "=", minArgCount = 2, argCountIsFixed = True},+                                functionArguments = [+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}},+                                    ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table2", columnId = "col1"}}]},+                            maybeTableAlias = Nothing}),+                    maybeWhereFilter = Just (+                        FunctionExpression {+                            sqlFunction = SQLFunction {functionName = "<>", minArgCount = 2, argCountIsFixed = True},+                            functionArguments = [+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "UPPER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]},+                                FunctionExpression {+                                    sqlFunction = SQLFunction {functionName = "LOWER", minArgCount = 1, argCountIsFixed = True},+                                    functionArguments = [ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "col1"}}]}]}),+                    orderByItems = [OrderByItem {+                        orderExpression = ColumnExpression {column = ColumnIdentifier {maybeTableName = Just "table1", columnId = "firstName"}},+                        orderAscending = False}]}+        stmt4_1Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName descending"+        stmt4_2Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName DESCENDING"+        stmt4_3Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName desc"+        stmt4_4Txt =+            "select table1.col1, table2.* " +++            "from table1 join table2 on table1.col1 = table2.col1 " +++            "where upper (table1.col1) <> lower ( table1.col1 ) order by  table1.firstName DESC"+    +    testSqlSelect stmt1 stmt1_1Txt+    testSqlSelect stmt1 stmt1_2Txt+    +    testSqlSelect stmt2 stmt2_1Txt+    testSqlSelect stmt2 stmt2_2Txt+    +    testSqlSelect stmt3 stmt3_1Txt+    testSqlSelect stmt3 stmt3_2Txt+    testSqlSelect stmt3 stmt3_3Txt++    testSqlSelect stmt4 stmt4_1Txt+    testSqlSelect stmt4 stmt4_2Txt+    testSqlSelect stmt4 stmt4_3Txt+    testSqlSelect stmt4 stmt4_4Txt++testSqlSelect :: SelectStatement -> String -> IO ()+testSqlSelect expectedResult selectStatementText = do+    let stmtParseResult = parse parseSelectStatement "" selectStatementText+        colNums = take (length selectStatementText) ([1 .. 9] ++ cycle [0 .. 9])+    putStrLn ""+    putStrLn "Testing:"+    putStrLn $ concat (map show colNums)+    putStrLn selectStatementText+    case stmtParseResult of+        Left errMsg -> error $ show errMsg+        Right selectStatement ->+            if selectStatement == expectedResult+                then+                    putStrLn "Success"+                else+                    error $ "\n" ++ (show selectStatement) ++ "\nNOT EQUAL TO\n" ++ (show expectedResult)
+ TxtSushi/IO.hs view
@@ -0,0 +1,213 @@+{- |+The 'FlatFile' module is for reading misc. 'FlatFile' formats like CSV or+tab delimited+-}+module TxtSushi.IO (+    formatTableWithWidths,+    maxTableColumnWidths,+    formatTable,+    parseTable,+    Format(Format),+    csvFormat,+    tabDelimitedFormat,+    doubleQuote) where++import Data.List+import Util.ListUtil++{- |+'Format' allows you to specify different flat-file formats so that you+can use 'parseTable' for CSV, tab-delimited etc.+-}+data Format = Format {+    quote :: String,+    fieldDelimiter :: String,+    rowDelimiter :: String} deriving (Show)++csvFormat = Format "\"" "," "\n"+tabDelimitedFormat = Format "\"" "\t" "\n"++{- |+get a quote escape sequence for the given 'Format'+-}+doubleQuote :: Format -> String+doubleQuote format = (quote format) ++ (quote format)++formatTableWithWidths _ _ [] = []+formatTableWithWidths boundaryString widths (row:tableTail) =+    let+        (initCells, [lastCell]) = splitAt (length row - 1) row+    in+        (concat $ zipWith ensureWidth widths initCells) ++ lastCell +++        "\n" ++ (formatTableWithWidths boundaryString widths tableTail)+    where+        ensureWidth width field =+            let lengthField = length field+            in+                if width > lengthField then+                    field ++ (replicate (width - lengthField) ' ') ++ boundaryString+                else+                    field ++ boundaryString++{- |+for a table, calculate the max width in characters for each column+-}+maxTableColumnWidths :: [[String]] -> [Int]+maxTableColumnWidths [] = []+maxTableColumnWidths table =+    maxTableColumnWidthsInternal table []++maxTableColumnWidthsInternal :: [[String]] -> [Int] -> [Int]+maxTableColumnWidthsInternal [] prevMaxValues = prevMaxValues+maxTableColumnWidthsInternal (row:tableTail) prevMaxValues+    | seqList prevMaxValues = undefined+    | otherwise = maxTableColumnWidthsInternal tableTail (maxRowFieldWidths row prevMaxValues)++-- this filthy little function is for making the list strict... otherwise+-- we run out of memory+seqList [] = False+seqList (head:tail)+    | head `seq` False = undefined+    | otherwise = seqList tail++maxRowFieldWidths :: [String] -> [Int] -> [Int]+maxRowFieldWidths row prevMaxValues =+    zipWithD max (map length row) prevMaxValues+{-+    let colLengths = map length row+        lengthOfRow = length row+        lengthOfPrevMax = length prevMaxValues+        maxPrefixList = zipWith max colLengths prevMaxValues+    in+        if lengthOfRow == lengthOfPrevMax then+            maxPrefixList+        else if lengthOfRow > lengthOfPrevMax then+            maxPrefixList ++ (drop lengthOfPrevMax colLengths)+        else+            maxPrefixList ++ (drop lengthOfRow prevMaxValues)+-}++zipWithD :: (a -> a -> a) -> [a] -> [a] -> [a]+zipWithD f (x:xt) (y:yt) = (f x y):(zipWithD f xt yt)+zipWithD _ [] ys = ys+zipWithD _ xs [] = xs++{- |+Format the given table (the 2D String array) into a flat-file string using+the given 'Format'+-}+formatTable :: Format -> [[String]] -> String+formatTable _ [] = ""+formatTable format (headRow:tableTail) =+    (formatRow format headRow) ++ (rowDelimiter format) ++ (formatTable format tableTail)++{- |+Format the row into a flat file sub-string using the given 'Format'+-}+formatRow :: Format -> [String] -> String+formatRow _ [] = []+formatRow format (headField:rowTail) =+    -- we need to escape any quotes+    let escapedField = encodeField format headField+    in+        -- use a field delimiter on all but the last field+        if null rowTail then+            escapedField+        else+            escapedField ++ (fieldDelimiter format) ++ (formatRow format rowTail)++{- |+encode the given text field if it contains any special formatting characters+-}+encodeField format field =+    if (quote format) `isInfixOf` field then+        let escapedField = replaceAll field (quote format) (doubleQuote format)+        in  (quote format) ++ escapedField ++ (quote format)+    else if (rowDelimiter format) `isInfixOf` field ||+            (fieldDelimiter format) `isInfixOf` field then+        (quote format) ++ field ++ (quote format)+    else+        field++{- |+Parse the given text using the given flat file 'Format'. The result+is a list of list of strings. The strings are fields and the string+lists are rows+-}+parseTable :: Format -> String -> [[String]]+parseTable _ [] = []+parseTable format text =+    let (nextLine, remainingText) = parseLine format text+    in  nextLine:(parseTable  format remainingText)++-- parse a row giving (rowFields, remainingText)+parseLine :: Format -> String -> ([String], String)+parseLine _ [] = ([], "")+parseLine format text =+    let (nextField, moreFieldsInRow, textRemainingAfterField) = parseField format text+    in+        -- if there are more fields, recursively add them to the row+        if moreFieldsInRow then+            let (rowTail, remainingText) = parseLine format textRemainingAfterField+            in  (nextField:rowTail, remainingText)+        +        -- if there are no more fields return the current fields as a singleton+        -- list+        else+            ([nextField], textRemainingAfterField)++-- parse a field giving (field, moreFieldsInRow, remainingText)+parseField :: Format -> String -> (String, Bool, String)+parseField _ [] = ("", False, "")+parseField format text =+    -- check if this field is quoted or not+    if (quote format) `isPrefixOf` text then+        let tailOfQuote = drop (length (quote format)) text+        in  parseQuotedField format tailOfQuote+    else+        parseUnquotedField format text++-- parse a quoted field giving (field, moreFieldsInRow, remainingText)+parseQuotedField :: Format -> String -> (String, Bool, String)+parseQuotedField _ [] = ("", False, "")+parseQuotedField format text@(textHead:textTail) =+    -- a double quote is an escaped quote, so add a quote to the field+    if (doubleQuote format) `isPrefixOf` text then+        let tailOfDoubleQuote = drop (length (doubleQuote format)) text+            (fieldTail, moreFieldsInRow, remainingText) = parseQuotedField format tailOfDoubleQuote+        in  ((quote format) ++ fieldTail, moreFieldsInRow, remainingText)+    +    -- a single quote is the end of the field, we can use parseUnquotedField to+    -- chew up any chars between the ending quote and the next delimiter (there+    -- really shouldn't be any if the text is formatted well, but you never+    -- know)+    else if (quote format) `isPrefixOf` text then+        let tailOfQuote = drop (length (quote format)) text+            (_, moreFieldsInRow, remainingText) = parseUnquotedField format tailOfQuote+        in  ("", moreFieldsInRow, remainingText)+    +    -- just another character... toss it in the field and keep going+    else+        let (fieldTail, moreFieldsInRow, remainingText) = parseQuotedField format textTail+        in  (textHead:fieldTail, moreFieldsInRow, remainingText)++-- parse an unquoted field giving (field, moreFieldsInRow, remainingText)+parseUnquotedField :: Format -> String -> (String, Bool, String)+parseUnquotedField _ [] = ("", False, "")+parseUnquotedField format text@(textHead:textTail) =+    -- if we hit a field delimiter: return an empty string and let caller know+    -- there are more fields in this row+    if (fieldDelimiter format) `isPrefixOf` text then+        let tailOfDelimiter = drop (length (fieldDelimiter format)) text+        in  ([], True, tailOfDelimiter)+    +    -- if we hit a row delimiter: return an empty string and let caller know there+    -- are no more fields in this row+    else if (rowDelimiter format) `isPrefixOf` text then+        let tailOfDelimiter = drop (length (rowDelimiter format)) text+        in  ([], False, tailOfDelimiter)+    +    -- just another character... toss it in the field and keep going+    else+        let (fieldTail, moreFieldsInRow, remainingText) = parseUnquotedField format textTail+        in  (textHead:fieldTail, moreFieldsInRow, remainingText)
+ TxtSushi/SQLExecution.hs view
@@ -0,0 +1,404 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TxtSushi.SQLExecution+-- Copyright   :  (c) Keith Sheppard 2009+-- License     :  GPL3 or greater+-- Maintainer  :  keithshep@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Module for executing a SQL statement+--+-----------------------------------------------------------------------------++module TxtSushi.SQLExecution (+    select,+    databaseTableToTextTable,+    textTableToDatabaseTable) where++import Data.Char+import Data.List+import qualified Data.Map as Map++import TxtSushi.SQLParser+import TxtSushi.Transform+import Util.ListUtil++-- | an SQL table data structure+--   TODO: need allColumnsColumnIdentifiers and allColumnsTableRows so that+--         we can filter and order on columns that are selected out. we also+--         should track any column ordering that is in place+data DatabaseTable = DatabaseTable {+    -- | the columns in this table+    columnIdentifiers :: [ColumnIdentifier],+    +    -- | the actual table data+    tableRows :: [[EvaluatedExpression]]}++emptyTable = DatabaseTable [] []++stringExpression :: String -> EvaluatedExpression+stringExpression string = EvaluatedExpression {+    preferredType   = StringType,+    maybeIntValue   = maybeReadInt string,+    maybeRealValue  = maybeReadReal string,+    stringValue     = string,+    maybeBoolValue  = Just $+        (map toLower string /= "false") && (string /= "") && (string /= "0")}++intExpression int = EvaluatedExpression {+    preferredType   = IntType,+    maybeIntValue   = Just int,+    maybeRealValue  = Just $ fromIntegral int,+    stringValue     = show int,+    maybeBoolValue  = Just $ int /= 0}++realExpression real = EvaluatedExpression {+    preferredType   = RealType,+    maybeIntValue   = Just $ floor real,+    maybeRealValue  = Just real,+    stringValue     = show real,+    maybeBoolValue  = Just $ real /= 0.0}++boolExpression bool = EvaluatedExpression {+    preferredType   = BoolType,+    maybeIntValue   = Just $ if bool then 1 else 0,+    maybeRealValue  = Just $ if bool then 1.0 else 0.0,+    stringValue     = show bool,+    maybeBoolValue  = Just bool}++intValue :: EvaluatedExpression -> Int+intValue evalExpr = case maybeIntValue evalExpr of+    Just int -> int+    Nothing ->+        error $ "failed to parse \"" ++ (stringValue evalExpr) +++                "\" as an integer value"++realValue :: EvaluatedExpression -> Double+realValue evalExpr = case maybeRealValue evalExpr of+    Just real -> real+    Nothing ->+        error $ "failed to parse \"" ++ (stringValue evalExpr) +++                "\" to a numeric value"++boolValue :: EvaluatedExpression -> Bool+boolValue evalExpr = case maybeBoolValue evalExpr of+    Just bool -> bool+    Nothing ->+        error $ "failed to parse \"" ++ (stringValue evalExpr) +++                "\" to a boolean value"++data ExpressionType = StringType | RealType | IntType | BoolType deriving Eq++data EvaluatedExpression = EvaluatedExpression {+    preferredType   :: ExpressionType,+    stringValue     :: String,+    maybeRealValue  :: Maybe Double,+    maybeIntValue   :: Maybe Int,+    maybeBoolValue  :: Maybe Bool}++maybeReadBool :: String -> Maybe Bool+maybeReadBool boolStr = case map toLower boolStr of+    "true"      -> Just True+    "1"         -> Just True+    "1.0"       -> Just True+    "false"     -> Just False+    "0"         -> Just False+    "0.0"       -> Just False+    otherwise   -> Nothing++instance Eq EvaluatedExpression where+    -- base off of the Ord definition+    expr1 == expr2 = compare expr1 expr2 == EQ++instance Ord EvaluatedExpression where+    -- compare on bool based on preferred type+    compare (EvaluatedExpression BoolType _ _ _ (Just b1)) (EvaluatedExpression _ _ _ _ (Just b2)) = compare b1 b2+    compare (EvaluatedExpression _ _ _ _ (Just b1)) (EvaluatedExpression BoolType _ _ _ (Just b2)) = compare b1 b2+    +    -- compare on int based on preferred type+    compare (EvaluatedExpression IntType _ _ (Just i1) _) (EvaluatedExpression _ _ _ (Just i2) _) = compare i1 i2+    compare (EvaluatedExpression _ _ _ (Just i1) _) (EvaluatedExpression IntType _ _ (Just i2) _) = compare i1 i2++    -- compare on real based on preferred type+    compare (EvaluatedExpression RealType _ (Just r1) _ _) (EvaluatedExpression _ _ (Just r2) _ _) = compare r1 r2+    compare (EvaluatedExpression _ _ (Just r1) _ _) (EvaluatedExpression RealType _ (Just r2) _ _) = compare r1 r2+    +    -- fall back on string type+    compare expr1 expr2 = compare (stringValue expr1) (stringValue expr2)++-- convert a text table to a database table by using the 1st row as column IDs+textTableToDatabaseTable :: String -> [[String]] -> DatabaseTable+textTableToDatabaseTable tableName (headerNames:tblRows) =+    DatabaseTable (map makeColId headerNames) (map (map stringExpression) tblRows)+    where+        makeColId colName = ColumnIdentifier (Just tableName) colName++databaseTableToTextTable :: DatabaseTable -> [[String]]+databaseTableToTextTable dbTable =+    let+        headerRow = (map columnId (columnIdentifiers dbTable))+        tailRows = map (map stringValue) (tableRows dbTable)+    in+        headerRow:tailRows++-- | perform a SQL select with the given select statement on the+--   given table map+select :: SelectStatement -> (Map.Map String DatabaseTable) -> DatabaseTable+select selectStatement tableMap =+    let+        -- TODO: do we need to care about the updated aliases for filtering+        --       in the "where" part??+        fromTbl = case maybeFromTable selectStatement of+            Nothing -> emptyTable+            Just fromTblExpr -> evalTableExpression fromTblExpr tableMap+        filteredTbl = case maybeWhereFilter selectStatement of+            Nothing -> fromTbl+            Just expr -> filterRowsBy expr fromTbl+        orderedTbl = orderRowsBy (orderByItems selectStatement) filteredTbl+        selectedTbl =+            evaluateColumnSelections (columnSelections selectStatement) orderedTbl+    in+        selectedTbl++-- | sorts table rows by the given order by items+orderRowsBy :: [OrderByItem] -> DatabaseTable -> DatabaseTable+orderRowsBy [] dbTable = dbTable+orderRowsBy orderBys dbTable =+    let+        -- curry in the order and col ID params to make a row comparison function+        compareFunc = compareRowsOnOrderItems orderBys (columnIdentifiers dbTable)+    in+        dbTable {tableRows = sortBy compareFunc (tableRows dbTable)}++-- | Compares two rows using the given OrderByItem and column ID's+compareRowsOnOrderItems :: [OrderByItem] -> [ColumnIdentifier] -> [EvaluatedExpression] -> [EvaluatedExpression] -> Ordering+compareRowsOnOrderItems orderBys colIds row1 row2 =+    cascadingOrder $ toOrderList orderBys+    where+        toOrderList [] = []+        toOrderList (orderBy:orderByTail) =+            (compareRowsOnOrderItem orderBy colIds row1 row2):(toOrderList orderByTail)++-- | Compares two rows using the given OrderByItem and column ID's+compareRowsOnOrderItem :: OrderByItem -> [ColumnIdentifier] -> [EvaluatedExpression] -> [EvaluatedExpression] -> Ordering+compareRowsOnOrderItem orderBy colIds row1 row2 =+    let+        orderExpr = orderExpression orderBy+        row1Eval = evalExpression orderExpr colIds row1+        row2Eval = evalExpression orderExpr colIds row2+        rowComp = row1Eval `compare` row2Eval+    in+        if orderAscending orderBy then+            rowComp+        else+            reverseOrdering rowComp++-- | reverses the given ordering. pretty CRAZY huh???+reverseOrdering :: Ordering -> Ordering+reverseOrdering EQ = EQ+reverseOrdering LT = GT+reverseOrdering GT = LT++-- | Evaluate the FROM table part, and returns the FROM table. Also returns+--   a mapping of new table names from aliases etc.+evalTableExpression :: TableExpression -> (Map.Map String DatabaseTable) -> DatabaseTable+evalTableExpression tblExpr tableMap =+    case tblExpr of+        TableIdentifier tblName maybeTblAlias ->+            let+                -- find the from table map (error if missing)+                noTblError = error $ "failed to find table named " ++ tblName+                table = Map.findWithDefault noTblError tblName tableMap+            in+                maybeRename maybeTblAlias table+        +        -- TODO inner join should allow joining on expressions too!!+        InnerJoin leftJoinTblExpr rightJoinTblExpr onConditionExpr maybeTblAlias ->+            let+                leftJoinTbl = evalTableExpression leftJoinTblExpr tableMap+                rightJoinTbl = evalTableExpression rightJoinTblExpr tableMap+                joinCols = extractJoinCols onConditionExpr+                joinIndices = joinColumnIndices leftJoinTbl rightJoinTbl joinCols+                joinedTbl = innerJoin joinIndices leftJoinTbl rightJoinTbl+            in+                maybeRename maybeTblAlias joinedTbl+        +        -- TODO implement me+        CrossJoin leftJoinTbl maybeTblAlias rightJoinTbl ->+            error "Sorry! CROSS JOIN is not yet implemented"+    where+        maybeRename :: (Maybe String) -> DatabaseTable -> DatabaseTable+        maybeRename Nothing table = table+        maybeRename (Just newName) table = table {+            columnIdentifiers = map (\colId -> colId {maybeTableName = Just newName}) (columnIdentifiers table)}++extractJoinCols (FunctionExpression sqlFunc [arg1, arg2]) =+    case sqlFunc of+        SQLFunction "AND" _ _   -> extractJoinCols arg1 ++ extractJoinCols arg2+        SQLFunction "=" _ _     -> extractJoinColPair arg1 arg2+        +        -- Only expecting "AND" or "="+        otherwise -> onPartFormattingError+    where+        extractJoinColPair (ColumnExpression col1) (ColumnExpression col2) = [(col1, col2)]+        +        -- Only expecting "AND" or "="+        extractJoinColPair _ _ = onPartFormattingError++-- Only expecting "AND" or "="+extractJoinCols _ = onPartFormattingError++onPartFormattingError =+    error $ "The \"ON\" part of a join must only contain column equalities " +++            "joined together by \"AND\" like: " +++            "\"tbl1.id1 = table2.id1 AND tbl1.firstname = tbl2.name\""++-- | perform an inner join using the given join indices on the given+--   tables+innerJoin :: [(Int, Int)] -> DatabaseTable -> DatabaseTable -> DatabaseTable+innerJoin joinIndices leftJoinTbl rightJoinTbl = DatabaseTable {+    columnIdentifiers = (columnIdentifiers leftJoinTbl) ++ (columnIdentifiers rightJoinTbl),+    tableRows = joinTables joinIndices (tableRows leftJoinTbl) (tableRows rightJoinTbl)}++-- | convert the column ID pairs into index pairs+joinColumnIndices :: DatabaseTable -> DatabaseTable -> [(ColumnIdentifier, ColumnIdentifier)] -> [(Int, Int)]+joinColumnIndices leftJoinTbl rightJoinTbl joinCols =+    let+        leftHeader = columnIdentifiers leftJoinTbl+        rightHeader = columnIdentifiers rightJoinTbl+    in+        map (idPairToIndexPair leftHeader rightHeader) joinCols++-- | convert the column ID pair into an index pair+idPairToIndexPair :: [ColumnIdentifier] -> [ColumnIdentifier] -> (ColumnIdentifier, ColumnIdentifier) -> (Int, Int)+idPairToIndexPair leftColIds rightColIds joinColPair@(leftColId, rightColId) =+    let+        maybePairInOrder = maybeIdPairToIndexPair leftColIds rightColIds joinColPair+        maybePairSwapped = maybeIdPairToIndexPair leftColIds rightColIds (rightColId, leftColId)+    in+        case maybePairInOrder of+            Just thePairInOrder -> thePairInOrder+            Nothing ->+                case maybePairSwapped of+                    Just thePairSwapped -> thePairSwapped+                    Nothing -> error "failed to find given columns"++maybeIdPairToIndexPair :: [ColumnIdentifier] -> [ColumnIdentifier] -> (ColumnIdentifier, ColumnIdentifier) -> Maybe (Int, Int)+maybeIdPairToIndexPair leftColIds rightColIds (leftColId, rightColId) = do+    leftIndex <- findIndex (== leftColId) leftColIds+    rightIndex <- findIndex (== rightColId) rightColIds+    return (leftIndex, rightIndex)++evaluateColumnSelections :: [ColumnSelection] -> DatabaseTable -> DatabaseTable+evaluateColumnSelections colSelections dbTable =+    let+        selectionTbls = map ($ dbTable) (map evaluateColumnSelection colSelections)+    in+        foldl1' tableConcat selectionTbls++tableConcat :: DatabaseTable -> DatabaseTable -> DatabaseTable+tableConcat dbTable1 dbTable2 =+    let+        concatIds = (columnIdentifiers dbTable1) ++ (columnIdentifiers dbTable2)+        concatRows = zipWith (++) (tableRows dbTable1) (tableRows dbTable2)+    in+        DatabaseTable concatIds concatRows++evaluateColumnSelection :: ColumnSelection -> DatabaseTable -> DatabaseTable+evaluateColumnSelection AllColumns dbTable = dbTable+evaluateColumnSelection (AllColumnsFrom srcTblName) dbTable =+    let+        colIds = columnIdentifiers dbTable+        indices = findIndices matchesSrcTblName (map maybeTableName colIds)+        selectedColIds = selectIndices indices colIds+        selectedColRows = map (selectIndices indices) (tableRows dbTable)+    in+        DatabaseTable selectedColIds selectedColRows+    where+        matchesSrcTblName Nothing           = False+        matchesSrcTblName (Just tblName)    = tblName == srcTblName+        selectIndices indices xs = [xs !! i | i <- indices]+evaluateColumnSelection (ExpressionColumn expr) dbTable =+    let+        tblColIds = columnIdentifiers dbTable+        exprColId = expressionIdentifier expr+        evaluatedExprs = map (evalExpression expr tblColIds) (tableRows dbTable)+    in+        DatabaseTable [exprColId] (transpose [evaluatedExprs])++-- | This is a little different that a strict equals compare in that it returns+--   true if the query column has a Nothing table and the column name part+--   matches the reference column's name. Also not that this makes it+--   an asymetric comparison+columnMatches :: ColumnIdentifier -> ColumnIdentifier -> Bool+columnMatches (ColumnIdentifier Nothing queryColIdStr) referenceColumn =+    -- In this case we don't care about the table name so+    -- just check to make sure that the column names match up+    queryColIdStr == columnId referenceColumn++columnMatches queryColumn referenceColumn =+    -- table name is important here so match on the whole object+    queryColumn == referenceColumn++-- | filters the database's table rows on the given expression+filterRowsBy :: Expression -> DatabaseTable -> DatabaseTable+filterRowsBy filterExpr table =+    table {tableRows = filter myBoolEvalExpr (tableRows table)}+    where myBoolEvalExpr row =+            boolValue $ evalExpression filterExpr (columnIdentifiers table) row++evalExpression :: Expression -> [ColumnIdentifier] -> [EvaluatedExpression] -> EvaluatedExpression+-- Here's the easy stuff. evaluate constants+evalExpression (StringConstantExpression string) _ _ = stringExpression string+evalExpression (IntegerConstantExpression int) _ _ = intExpression int+evalExpression (RealConstantExpression real) _ _ = realExpression real++-- A little bit harder. evaluate a column expression+evalExpression (ColumnExpression col) columnIds tblRow =+    case findIndex (columnMatches col) columnIds of+        Just colIndex -> tblRow !! colIndex+        Nothing -> error $ "Failed to find column named: " ++ (prettyFormatColumn col)++-- this is where the action is. evaluate a function+evalExpression (FunctionExpression sqlFun funArgs) columnIds tblRow+    -- String functions+    | sqlFun == upperFunction = stringExpression $ map toUpper (stringValue (head evaluatedArgs))+    | sqlFun == lowerFunction = stringExpression $ map toLower (stringValue (head evaluatedArgs))+    | sqlFun == trimFunction = stringExpression $ trimSpace (stringValue (head evaluatedArgs))+    +    -- algebraic infix functions+    | sqlFun == multiplyFunction = algebraWithCoercion (*) (*) evaluatedArgs+    | sqlFun == divideFunction = realExpression $ foldl1' (/) (map realValue evaluatedArgs)+    | sqlFun == plusFunction = algebraWithCoercion (+) (+) evaluatedArgs+    | sqlFun == minusFunction = algebraWithCoercion (-) (-) evaluatedArgs+    +    -- boolean infix functions+    | sqlFun == isFunction = boolExpression (arg1 == arg2)+    | sqlFun == isNotFunction = boolExpression (arg1 /= arg2)+    | sqlFun == lessThanFunction = boolExpression (arg1 < arg2)+    | sqlFun == lessThanOrEqualToFunction = boolExpression (arg1 <= arg2)+    | sqlFun == greaterThanFunction = boolExpression (arg1 > arg2)+    | sqlFun == greaterThanOrEqualToFunction = boolExpression (arg1 >= arg2)+    | sqlFun == andFunction = boolExpression $ (boolValue arg1) && (boolValue arg2)+    | sqlFun == orFunction = boolExpression $ (boolValue arg1) || (boolValue arg2)+    +    where+        arg1 = head evaluatedArgs+        arg2 = evaluatedArgs !! 1+        evaluatedArgs = map evalArgExpr funArgs+        evalArgExpr expr = evalExpression expr columnIds tblRow+        algebraWithCoercion intFunc realFunc args =+            if any useRealAlgebra args then+                realExpression $ foldl1' realFunc (map realValue args)+            else+                intExpression $ foldl1' intFunc (map intValue args)+        +        useRealAlgebra expr =+            let prefType = preferredType expr+            in prefType == StringType || prefType == RealType++-- | trims leading and trailing spaces+trimSpace :: String -> String+trimSpace = f . f+   where f = reverse . dropWhile isSpace
+ TxtSushi/SQLParser.hs view
@@ -0,0 +1,704 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TxtSushi.SQLParser+-- Copyright   :  (c) Keith Sheppard 2009+-- License     :  GPL3 or greater+-- Maintainer  :  keithshep@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Module for parsing SQL+--+-----------------------------------------------------------------------------++module TxtSushi.SQLParser (+    allMaybeTableNames,+    parseSelectStatement,+    SelectStatement(..),+    TableExpression(..),+    ColumnIdentifier(..),+    prettyFormatColumn,+    ColumnSelection(..),+    expressionIdentifier,+    Expression(..),+    OrderByItem(..),+    prettyFormatWithArgs,+    SQLFunction(..),+    +    -- SQL functions with "normal" syntax+    upperFunction,+    lowerFunction,+    trimFunction,+    +    -- Algebraic infix SQL functions+    multiplyFunction,+    divideFunction,+    plusFunction,+    minusFunction,+    +    -- Boolean infix SQL functions+    isFunction,+    isNotFunction,+    lessThanFunction,+    lessThanOrEqualToFunction,+    greaterThanFunction,+    greaterThanOrEqualToFunction,+    andFunction,+    orFunction,+    +    -- Etc...+    maybeReadInt,+    maybeReadReal) where++import Data.Char+import Data.List+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Util.ListUtil++--------------------------------------------------------------------------------+-- The data definition for select statements+--------------------------------------------------------------------------------++-- | represents a select statement+--   TODO this should be moved inside the TableExpression type+data SelectStatement = SelectStatement {+    columnSelections :: [ColumnSelection],+    maybeFromTable :: Maybe TableExpression,+    maybeWhereFilter :: Maybe Expression,+    orderByItems :: [OrderByItem]}+    deriving (Show, Ord, Eq)++data TableExpression =+    TableIdentifier {+        tableName :: String,+        maybeTableAlias :: Maybe String} |+    InnerJoin {+        leftJoinTable :: TableExpression,+        rightJoinTable :: TableExpression,+        onCondition :: Expression,+        maybeTableAlias :: Maybe String} |+    CrossJoin {+        leftJoinTable :: TableExpression,+        rightJoinTable :: TableExpression,+        maybeTableAlias :: Maybe String}+    deriving (Show, Ord, Eq)++-- | convenience function for extracting all of the table names used by the+--   given table expression+allMaybeTableNames :: (Maybe TableExpression) -> [String]+allMaybeTableNames Nothing = []+allMaybeTableNames (Just tblExp) = allTableNames tblExp++allTableNames (TableIdentifier tblName _) = [tblName]+allTableNames (InnerJoin lftTbl rtTbl _ _) =+    (allTableNames lftTbl) ++ (allTableNames rtTbl)+allTableNames (CrossJoin lftTbl rtTbl _) =+    (allTableNames lftTbl) ++ (allTableNames rtTbl)++data ColumnSelection =+    AllColumns |+    AllColumnsFrom {sourceTableName :: String} |+    ExpressionColumn {expression :: Expression}+    --QualifiedColumn {+    --    qualifiedColumnId :: ColumnIdentifier}+    deriving (Show, Ord, Eq)++data ColumnIdentifier =+    ColumnIdentifier {+        maybeTableName :: Maybe String,+        columnId :: String}+    deriving (Show, Ord, Eq)++-- | I wanted to leave the default Show, but I also wanted a pretty print, so+--   here it is!+prettyFormatColumn :: ColumnIdentifier -> String+prettyFormatColumn (ColumnIdentifier (Just tblName) colId) = tblName ++ "." ++ colId+prettyFormatColumn (ColumnIdentifier (Nothing) colId) = colId++data Expression =+    FunctionExpression {+        sqlFunction :: SQLFunction,+        functionArguments :: [Expression]} |+    ColumnExpression {+        column :: ColumnIdentifier} |+    StringConstantExpression {+        stringConstant :: String} |+    IntegerConstantExpression {+        intConstant :: Int} |+    RealConstantExpression {+        realConstant :: Double}+    deriving (Show, Ord, Eq)++expressionIdentifier :: Expression -> ColumnIdentifier+expressionIdentifier (FunctionExpression func args) =+    ColumnIdentifier Nothing ((prettyFormatWithArgs func) args)+expressionIdentifier (ColumnExpression col) = col+expressionIdentifier (StringConstantExpression str) =+    ColumnIdentifier Nothing ("\"" ++ str ++ "\"")+expressionIdentifier (IntegerConstantExpression int) =+    ColumnIdentifier Nothing (show int)+expressionIdentifier (RealConstantExpression real) =+    ColumnIdentifier Nothing (show real)++needsParens :: Expression -> Bool+needsParens (FunctionExpression _ _) = True+needsParens _ = False++toArgString :: Expression -> String+toArgString expr =+    let exprFmt = prettyFormatColumn $ expressionIdentifier expr+    in if needsParens expr then "(" ++ exprFmt ++ ")" else exprFmt++prettyFormatWithArgs :: SQLFunction -> [Expression] -> String+prettyFormatWithArgs sqlFunc funcArgs+    | sqlFunc `elem` normalSyntaxFunctions = prettyFormatNormalFunctionExpression sqlFunc funcArgs+    | or (map (sqlFunc `elem`) infixFunctions) = prettyFormatInfixFunctionExpression sqlFunc funcArgs++prettyFormatInfixFunctionExpression :: SQLFunction -> [Expression] -> String+prettyFormatInfixFunctionExpression sqlFunc funcArgs =+    let+        arg1 = head funcArgs+        arg2 = funcArgs !! 1+    in+        toArgString arg1 ++ functionName sqlFunc ++ toArgString arg2++prettyFormatNormalFunctionExpression :: SQLFunction -> [Expression] -> String+prettyFormatNormalFunctionExpression sqlFunc funcArgs =+    let argString = intercalate ", " (map toArgString funcArgs)+    in functionName sqlFunc ++ "(" ++ argString ++ ")"++data SQLFunction = SQLFunction {+    functionName :: String,+    minArgCount :: Int,+    argCountIsFixed :: Bool}+    deriving (Show, Ord, Eq)++data OrderByItem = OrderByItem {+    orderExpression :: Expression,+    orderAscending :: Bool}+    deriving (Show, Ord, Eq)++-- | Parses a SQL select statement+parseSelectStatement :: GenParser Char st SelectStatement+parseSelectStatement = do+    try $ upperOrLower "SELECT" >> spaces1+    parseSelectBody++-- | Parses all of the stuff that comes after "SELECT "+parseSelectBody :: GenParser Char st SelectStatement+parseSelectBody = do+    columnVals <- parseColumnSelections+    -- TODO need a better error message for missing "ON" etc. in+    -- the from part, can do this by grabing "FROM" first+    maybeFrom <- maybeParseFromPart+    maybeWhere <- maybeParseWherePart+    orderBy <- parseOrderByPart+    +    spaces+    eof+    +    return SelectStatement {+        columnSelections    = columnVals,+        maybeFromTable      = maybeFrom,+        maybeWhereFilter    = maybeWhere,+        orderByItems        = orderBy}+    +    where+        maybeParseFromPart =+            ifParseThen (spaces1 >> upperOrLower "FROM" >> spaces1) parseTableExpression+        +        maybeParseWherePart =+            ifParseThen (spaces1 >> upperOrLower "WHERE" >> spaces1) parseExpression++-- | Parses the "ORDER BY ..." part of a select statement returning the list+--   of OrderByItem's that were parsed (this list will be empty if there is no+--   "ORDER BY" parsed+parseOrderByPart :: GenParser Char st [OrderByItem]+parseOrderByPart =+    ifParseThenElse+        -- if we see an "ORDER BY"+        (spaces1 >> upperOrLower "ORDER" >> spaces1 >> upperOrLower "BY" >> spaces1)+        +        -- then parse the order expression+        (sepByAtLeast 1 parseOrderByItem parseCommaSeparator)+        +        -- else there is nothing to sort by+        (return [])+    +    where+        parseOrderByItem :: GenParser Char st OrderByItem+        parseOrderByItem = do+            orderExpr <- parseExpression+            isAscending <- ifParseThenElse+                -- if we parse "DESC"+                (try parseDescending)+                +                -- then return false, it isn't ascending+                (return False)+                +                -- else try to consume "ASC" but even if we don't it's still+                -- ascending so return true+                ((try parseAscending <|> return []) >> return True)+            +            return $ OrderByItem orderExpr isAscending+        +        parseAscending  = spaces1 >> ((try $ upperOrLower "ASCENDING") <|> upperOrLower "ASC")+        parseDescending = spaces1 >> ((try $ upperOrLower "DESCENDING") <|> upperOrLower "DESC")++--------------------------------------------------------------------------------+-- Functions for parsing the column names specified after "SELECT"+--------------------------------------------------------------------------------++parseColumnSelections =+    sepBy1 parseAnyColType (try parseCommaSeparator)+    where parseAnyColType = parseAllCols <|>+                            (try parseAllColsFromTbl) <|>+                            (try parseColExpression)++parseAllCols = string "*" >> return AllColumns++parseAllColsFromTbl = do+    tableVal <- parseIdentifier+    string ".*"+    +    return $ AllColumnsFrom tableVal++parseColExpression = parseExpression >>= \expr -> return $ ExpressionColumn expr++parseColumnId = do+    firstId <- parseIdentifier+    +    maybeFullyQual <- maybeParse $ char '.'+    case maybeFullyQual of+        -- No '.' means it's a partially qualified column+        Nothing -> return $ ColumnIdentifier Nothing firstId+        Just _ -> do+            secondId <- parseIdentifier+            return $ ColumnIdentifier (Just firstId) secondId++--------------------------------------------------------------------------------+-- Functions for parsing the table part (after "FROM")+--------------------------------------------------------------------------------++parseTableExpression = do+    nextTblChunk <- parseNextTblExpChunk+    +    let ifInnerJoinParse = ifParseThenElse+            -- if+            parseInnerJoinKeywords+            -- then+            (parseInnerJoinRemainder nextTblChunk)+            -- else+            (return nextTblChunk)+        +        ifCrossOrInnerJoinParse = ifParseThenElse+            -- if+            parseCrossJoinKeywords+            -- then+            (parseCrossJoinRemainder nextTblChunk)+            -- else+            ifInnerJoinParse+    +    ifCrossOrInnerJoinParse++parseNextTblExpChunk =+    parenthesize parseTableExpression <|>  parseTableIdentifier++parseCrossJoinKeywords = do+    spaces1+    upperOrLower "CROSS"+    spaces1+    upperOrLower "JOIN"+    spaces1++parseInnerJoinKeywords = do+    spaces1+    maybeParse $ upperOrLower "INNER" >> spaces1+    upperOrLower "JOIN"+    spaces1++parseInnerJoinRemainder leftTblExpr = do+    rightTblExpr <- parseTableExpression+    +    spaces1+    upperOrLower "ON"+    spaces1+    onPart <- parseExpression+    +    maybeAlias <- maybeParse $ spaces1 >> parseTableAlias+    +    return InnerJoin {+            leftJoinTable=leftTblExpr,+            rightJoinTable=rightTblExpr,+            onCondition=onPart,+            maybeTableAlias=maybeAlias}++parseCrossJoinRemainder leftTblExpr = do+    rightTblExpr <- parseTableExpression+    maybeAlias <- maybeParse $ spaces1 >> parseTableAlias+    +    return CrossJoin {+            leftJoinTable=leftTblExpr,+            rightJoinTable=rightTblExpr,+            maybeTableAlias=maybeAlias}++parseTableIdentifier = do+    theId <- parseIdentifier+    maybeAlias <- maybeParse $ spaces1 >> parseTableAlias+    return $ TableIdentifier theId maybeAlias++parseTableAlias = upperOrLower "AS" >> spaces1 >> parseIdentifier++--------------------------------------------------------------------------------+-- Expression parsing: These can be after "SELECT", "WHERE" or "HAVING"+--------------------------------------------------------------------------------++parseExpression :: GenParser Char st Expression+parseExpression =+    let opTable = map (map parseInfixOp) infixFunctions+    in buildExpressionParser opTable parseAnyNonInfixExpression++parseAnyNonInfixExpression :: GenParser Char st Expression+parseAnyNonInfixExpression =+    parenthesize parseExpression <|>+    parseStringConstant <|>+    try parseRealConstant <|>+    parseIntConstant <|>+    parseAnyNormalFunction <|>+    (parseColumnId >>= (\colId -> return $ ColumnExpression colId))++parseStringConstant :: GenParser Char st Expression+parseStringConstant =+    quotedText True '"' >>= (\txt -> return $ StringConstantExpression txt)++parseIntConstant :: GenParser Char st Expression+parseIntConstant =+    parseInt >>= (\int -> return $ IntegerConstantExpression int)++parseInt :: GenParser Char st Int+parseInt = do+    digitTxt <- anyParseTxt+    return $ read digitTxt+    where+        anyParseTxt = signedParseTxt <|> unsignedParseTxt <?> "integer"+        unsignedParseTxt = many1 digit+        signedParseTxt = do+            char '-'+            unsignedDigitTxt <- unsignedParseTxt+            return ('-':unsignedDigitTxt)++-- | returns an int if it can be read from the string+maybeReadInt :: String -> Maybe Int+maybeReadInt intStr =+    case parse (parseToEof parseInt) "" intStr of+        Left _      -> Nothing+        Right int   -> Just int++-- | returns a real if it can be read from the string+maybeReadReal :: String -> Maybe Double+maybeReadReal realStr =+    case parse (parseToEof parseReal) "" realStr of+        Left _      -> maybeReadInt realStr >>= (\int -> Just $ fromIntegral int)+        Right real  -> Just real++parseToEof p = p >>= \x -> (eof >> return x)++parseRealConstant :: GenParser Char st Expression+parseRealConstant =+    parseReal >>= (\real -> return $ RealConstantExpression real)++parseReal :: GenParser Char st Double+parseReal = do+    realTxt <- anyParseTxt+    return $ read realTxt+    where+        anyParseTxt = signedParseTxt <|> unsignedParseTxt <?> "real"+        unsignedParseTxt = do+            intTxt <- many1 digit+            char '.'+            fracTxt <- many1 digit+            return $ intTxt ++ "." ++ fracTxt+        signedParseTxt = do+            char '-'+            unsignedDigitTxt <- unsignedParseTxt+            return ('-':unsignedDigitTxt)++parseAnyNormalFunction :: GenParser Char st Expression+parseAnyNormalFunction =+    let allParsers = map parseNormalFunction normalSyntaxFunctions+    in choice allParsers++parseNormalFunction sqlFunc = do+    try $ (upperOrLower $ functionName sqlFunc)+    spaces -- TODO careful here: what happens with upperVar? it breaks because of "upper" (maybe a blog entry!!)+    args <- parenthesize $ argSepBy (minArgCount sqlFunc) parseExpression parseCommaSeparator+    return $ FunctionExpression sqlFunc args+    where argSepBy = if argCountIsFixed sqlFunc then sepByExactly else sepByAtLeast++-- Functions with "normal" syntax --+normalSyntaxFunctions = [upperFunction, lowerFunction, trimFunction]++upperFunction = SQLFunction {+    functionName    = "UPPER",+    minArgCount     = 1,+    argCountIsFixed = True}++lowerFunction = SQLFunction {+    functionName    = "LOWER",+    minArgCount     = 1,+    argCountIsFixed = True}++trimFunction = SQLFunction {+    functionName    = "TRIM",+    minArgCount     = 1,+    argCountIsFixed = True}++-- Infix functions --+infixFunctions =+    [[multiplyFunction, divideFunction],+     [plusFunction, minusFunction],+     [isFunction, isNotFunction, lessThanFunction, lessThanOrEqualToFunction,+      greaterThanFunction, greaterThanOrEqualToFunction],+     [andFunction, orFunction]]++-- | This function parses the operator part of the infix function and returns+--   a function that excepts a left expression and right expression to form+--   an Expression from the FunctionExpression constructor+parseInfixOp infixFunc =+    -- use the magic infix type, always assuming left associativity+    Infix opParser AssocLeft+    where+        opParser =+            if funcIsAlphaNum+            then do+                try (spaces1 >> (upperOrLower $ functionName infixFunc) >> spaces1)+                return $ buildExpr+            else do+                try (spaces >> (upperOrLower $ functionName infixFunc) >> notOpChar) >> spaces+                return $ buildExpr+        buildExpr leftSubExpr rightSubExpr =+            FunctionExpression {+                sqlFunction = infixFunc,+                functionArguments = [leftSubExpr, rightSubExpr]}+        funcIsAlphaNum = any isAlphaNum (functionName infixFunc)+        notOpChar =+            notFollowedBy $ oneOf "*/+-=<>^"++-- Algebraic+multiplyFunction = SQLFunction {+    functionName    = "*",+    minArgCount     = 2,+    argCountIsFixed = True}++divideFunction = SQLFunction {+    functionName    = "/",+    minArgCount     = 2,+    argCountIsFixed = True}++plusFunction = SQLFunction {+    functionName    = "+",+    minArgCount     = 2,+    argCountIsFixed = True}++minusFunction = SQLFunction {+    functionName    = "-",+    minArgCount     = 2,+    argCountIsFixed = True}++-- Boolean+isFunction = SQLFunction {+    functionName    = "=",+    minArgCount     = 2,+    argCountIsFixed = True}++isNotFunction = SQLFunction {+    functionName    = "<>",+    minArgCount     = 2,+    argCountIsFixed = True}++lessThanFunction = SQLFunction {+    functionName    = "<",+    minArgCount     = 2,+    argCountIsFixed = True}++lessThanOrEqualToFunction = SQLFunction {+    functionName    = "<=",+    minArgCount     = 2,+    argCountIsFixed = True}++greaterThanFunction = SQLFunction {+    functionName    = ">",+    minArgCount     = 2,+    argCountIsFixed = True}++greaterThanOrEqualToFunction = SQLFunction {+    functionName    = ">=",+    minArgCount     = 2,+    argCountIsFixed = True}++andFunction = SQLFunction {+    functionName    = "AND",+    minArgCount     = 2,+    argCountIsFixed = True}++orFunction = SQLFunction {+    functionName    = "OR",+    minArgCount     = 2,+    argCountIsFixed = True}++++-- Functions with special syntax --+specialFunctions = [substringFromFunction,+                    substringFromToFunction]++-- | SUBSTRING(extraction_string FROM starting_position [FOR length]+--             [COLLATE collation_name])+--   TODO implement these+substringFromFunction = SQLFunction {+    functionName    = "SUBSTRING",+    minArgCount     = 2,+    argCountIsFixed = True}+substringFromToFunction = SQLFunction {+    functionName    = "SUBSTRING",+    minArgCount     = 3,+    argCountIsFixed = True}++--------------------------------------------------------------------------------+-- Parse utility functions+--------------------------------------------------------------------------------++-- | parses an identifier. you can use a tick '`' as a quote for+--   an identifier with white-space+parseIdentifier = do+    let parseId = do+            let idChar = alphaNum <|> char '_'+            quotedText False '`' <|> many1 idChar+    (parseId `genExcept` parseReservedWord) <?> "identifier"++quotedText allowEmpty quoteChar = do+    let quote = char quoteChar+        manyFunc = if allowEmpty then many else many1+    +    quote+    textValue <- manyFunc $ (anyChar `genExcept` quote) <|>+                            try (escapedQuote quoteChar)+    quote+    +    return textValue++exceptChar parser theException = notFollowedBy theException >> parser++escapedQuote quoteChar = string [quoteChar, quoteChar] >> return quoteChar++parseCommaSeparator = spaces >> char ',' >> spaces++-- | Wraps parentheses parsers around the given inner parser+parenthesize :: GenParser Char st a -> GenParser Char st a+parenthesize innerParser = do+    char '('+    spaces+    innerParseResults <- innerParser+    spaces+    char ')'+    return innerParseResults++-- | Either parses the left or right parser returning the result of the+--   successful parser+eitherParse :: GenParser tok st a -> GenParser tok st b -> GenParser tok st (Either a b)+eitherParse leftParser rightParser =+    do {parseResult <- try leftParser; return $ Left parseResult} <|>+    do {parseResult <- rightParser; return $ Right parseResult}++-- parses 1 or more spaces+spaces1 = skipMany1 space <?> "whitespace"++-- | if the ifParse parser succeeds return the result of thenParse, else+--   return Nothing without parsing any input+ifParseThen :: GenParser tok st a -> GenParser tok st b -> GenParser tok st (Maybe b)+ifParseThen ifParse thenPart = do+    ifResult <- maybeParse ifParse+    case ifResult of+        Just _ ->   thenPart >>= (\x -> return $ Just x)+        Nothing ->  return Nothing++-- | if ifParse succeeds then parse thenPart otherwise parse elsePart+ifParseThenElse :: GenParser tok st a -> GenParser tok st b -> GenParser tok st b -> GenParser tok st b+ifParseThenElse ifParse thenPart elsePart = do+    ifResult <- maybeParse ifParse+    case ifResult of+        Just _ -> thenPart+        Nothing -> elsePart++parseReservedWord = do+    let reservedWordParsers = map reservedWordParser reservedWords+    choice reservedWordParsers+    where reservedWordParser word = do+            parseVal <- upperOrLower word+            notFollowedBy alphaNum+            return parseVal++-- TODO are function names reserved... i don't think so+reservedWords =+    map functionName normalSyntaxFunctions +++    map functionName (concat infixFunctions) +++    map functionName specialFunctions +++    ["BY","CROSS", "FROM", "GROUP", "HAVING", "INNER", "JOIN", "ON", "ORDER", "SELECT", "WHERE"]++-- | tries parsing both the upper and lower case versions of the given string+upperOrLower :: String -> GenParser Char st String+upperOrLower stringToParse =+    string (map toUpper stringToParse) <|>+    string (map toLower stringToParse) <?> stringToParse++-- | accepst the same input as the given parser except and input that matches+--   theException parser+genExcept :: (Show b) => GenParser tok st a -> GenParser tok st b -> GenParser tok st a+genExcept parser theException = do+    genNotFollowedBy theException+    parser++-- | a generic version of the notFollowedBy library function. We require+--   Show types so that we can better report failures+genNotFollowedBy :: (Show a) => GenParser tok st a -> GenParser tok st ()+genNotFollowedBy theParser = try $ do+    mayParseResult <- maybeParse theParser+    case mayParseResult of+        Nothing -> return ()+        Just x -> unexpected $ show x++-- | returns Just parseResult if the parse succeeds and Nothing if it fails+maybeParse :: GenParser tok st a -> GenParser tok st (Maybe a)+maybeParse parser =+    (try parser >>= (\x -> return $ Just x)) <|>+    return Nothing++-- | parse `itemParser`s seperated by exactly `minCount` `sepParser`s+sepByExactly :: Int -> GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepByExactly count itemParser sepParser =+    let itemParsers = replicate count itemParser+    in parseEach itemParsers+    where+        -- for an empty parser list return an empty result+        parseEach [] = return []+        +        -- for a parser list of 1 we don't want to use a separator+        parseEach [lastParser] = lastParser >>= (\x -> return [x])+        +        -- for lists greater than 1 we do need to care about the separator+        parseEach (headParser:parserTail) = do+            resultHead <- headParser+            sepParser+            resultTail <- parseEach parserTail+            +            return $ resultHead:resultTail++-- | parse `itemParser`s seperated by at least `minCount` `sepParser`s+sepByAtLeast :: Int -> GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepByAtLeast minCount itemParser sepParser = do+    minResults <- sepByExactly minCount itemParser sepParser+    ifParseThenElse+        sepParser+        (sepBy1 itemParser sepParser >>= (\tailResults -> return $ minResults ++ tailResults))+        (return minResults)
+ TxtSushi/Transform.hs view
@@ -0,0 +1,162 @@+{- |+Simple table transformations+-}+module TxtSushi.Transform (+    selectColumns,+    sortColumns,+    fileBasedSortTable,+    mergeAllBy,+    joinTables,+    joinPresortedTables,+    rowComparison) where++import Data.List+import System.Directory+import System.IO++import TxtSushi.IO++{- |+Create a new table by selecting the given 'columnIndices'+-}+selectColumns _ [] = []+selectColumns columnIndices (headRow:tableTail) =+    ([headRow !! i | i <- columnIndices]):(selectColumns columnIndices tableTail)++removeColumns _ [] = []+removeColumns columnIndices (headRow:tableTail) =+    let indexesToSelect = [0 .. ((length headRow) - 1)] \\ columnIndices+    in ([headRow !! i | i <- indexesToSelect]):(removeColumns columnIndices tableTail)++-- | sort the given 'table' on the given columns+sortColumns columns table =+    sortBy (rowComparison columns) table++-- | compare two rows based on given column balues+rowComparison [] _ _ = EQ+rowComparison (columnHead:columnsTail) row1 row2 =+    let colComparison = (row1 !! columnHead) `compare` (row2 !! columnHead)+    in+        case colComparison of+            EQ          -> rowComparison columnsTail row1 row2+            otherwise   -> colComparison++-- | merge two sorted lists into a single sorted list+mergeBy comparisonFunction []    list2   = list2+mergeBy comparisonFunction list1 []      = list1+mergeBy comparisonFunction list1@(head1:tail1) list2@(head2:tail2) =+    case head1 `comparisonFunction` head2 of+        GT          -> (head2:(mergeBy comparisonFunction list1 tail2))+        otherwise   -> (head1:(mergeBy comparisonFunction tail1 list2))++-- | merge the sorted lists in the list to a list about 1/2 the size+mergePairsBy _ [] = []+mergePairsBy comparisonFunction singletonListList@(headList:[]) = singletonListList+mergePairsBy comparisonFunction (list1:list2:listListTail) =+    let mergedPair = mergeBy comparisonFunction list1 list2+    in mergedPair:(mergePairsBy comparisonFunction listListTail)++-- | merge a list of sorted lists into a single sorted list+mergeAllBy _ [] = []+mergeAllBy comparisonFunction listList =+    let mergedPairs = mergePairsBy comparisonFunction listList+    in+        case mergedPairs of+            singletonListHead:[]    -> singletonListHead+            otherwise               -> mergeAllBy comparisonFunction mergedPairs++{- |+perform a table sort using files to keep from holding the whole list in memory+-}+fileBasedSortTable columns table = do+    partialSortFiles <- bufferPartialSorts columns table+    partialSortFileHandles <- (unwrapIOList [openFile file ReadMode | file <- partialSortFiles])+    partialSortContents <- (unwrapIOList [hGetContents handle | handle <- partialSortFileHandles])+    let partialSortTables = map (parseTable csvFormat) partialSortContents+    return (partialSortTables, partialSortFileHandles, partialSortFiles)++-- | unwrap a list of 'IO' boxed items+unwrapIOList [] = do return []+unwrapIOList (ioHead:ioTail) = do+    unwrappedHead <- ioHead+    unwrappedTail <- unwrapIOList ioTail+    return (unwrappedHead:unwrappedTail)++-- | create a list of parial sorts+bufferPartialSorts columns [] = return []+bufferPartialSorts columns table = do+    let rowLimit = 100000+        (rowsToSortNow, rowsToSortLater) = splitAt rowLimit table+        sortedRows = sortColumns columns rowsToSortNow+    sortBuffer <- bufferToTempFile sortedRows+    otherSortBuffers <- bufferPartialSorts columns rowsToSortLater+    return (sortBuffer:otherSortBuffers)++-- | buffer the table to a temporary file and return a handle to that file+bufferToTempFile table = do+    tempDir <- getTemporaryDirectory+    (tempFilePath, tempFileHandle) <- openTempFile tempDir "buffer.txt"+    hPutStr tempFileHandle (formatTable csvFormat table)+    hClose tempFileHandle+    return tempFilePath++-- | join together two tables on the given column index pairs+joinTables :: (Ord o) => [(Int, Int)] -> [[o]] -> [[o]] -> [[o]]+joinTables joinColumnZipList table1 table2 =+    let+        (joinColumns1, joinColumns2) = unzip joinColumnZipList+        sortedTable1 = sortColumns joinColumns1 table1+        sortedTable2 = sortColumns joinColumns2 table2+    in+        joinPresortedTables joinColumnZipList sortedTable1 sortedTable2++-- | join together two tables that are presorted on the given column index pairs+joinPresortedTables :: (Ord o) => [(Int, Int)] -> [[o]] -> [[o]] -> [[o]]+joinPresortedTables joinColumnZipList sortedTable1 sortedTable2 =+    let+        (joinColumns1, joinColumns2) = unzip joinColumnZipList+        rowEq1 = (\a b -> (rowComparison joinColumns1 a b) == EQ)+        rowEq2 = (\a b -> (rowComparison joinColumns2 a b) == EQ)+        tableGroups1 = groupBy rowEq1 sortedTable1+        tableGroups2 = groupBy rowEq2 sortedTable2+    in+        joinGroupedTables joinColumnZipList tableGroups1 tableGroups2++permutePrependRows [] _ = []+permutePrependRows _ [] = []+permutePrependRows (table1HeadRow:table1Tail) table2 =+    let+        prependHead = (table1HeadRow ++)+        newTable2 = map prependHead table2+    in+        newTable2 ++ (permutePrependRows table1Tail table2)++joinGroupedTables _ [] _  = []+joinGroupedTables _ _  [] = []+joinGroupedTables joinColumnZipList tableGroups1@(headTableGroup1:tableGroupsTail1) tableGroups2@(headTableGroup2:tableGroupsTail2) =+    let+        headRow1 = head headTableGroup1+        headRow2 = head headTableGroup2+    in+        case asymmetricRowComparison joinColumnZipList headRow1 headRow2 of+            -- drop the 1st group if its smaller+            LT -> joinGroupedTables joinColumnZipList tableGroupsTail1 tableGroups2+            +            -- drop the 2nd group if its smaller+            GT -> joinGroupedTables joinColumnZipList tableGroups1 tableGroupsTail2+            +            -- the two groups are equal so permute+            otherwise ->+                (permutePrependRows headTableGroup1 headTableGroup2) +++                (joinGroupedTables joinColumnZipList tableGroupsTail1 tableGroupsTail2)++asymmetricRowComparison [] _ _ = EQ+asymmetricRowComparison (columnsZipHead:columnsZipTail) row1 row2 =+    let+        (columnHead1, columnHead2) = columnsZipHead+        colComparison = (row1 !! columnHead1) `compare` (row2 !! columnHead2)+    in+        case colComparison of+            EQ          -> asymmetricRowComparison columnsZipTail row1 row2+            otherwise   -> colComparison+
+ Util/CommandLineArgument.hs view
@@ -0,0 +1,213 @@+module Util.CommandLineArgument (+    extractCommandLineArguments,+    formatCommandLine,+    CommandLineDescription(CommandLineDescription),+    options,+    minTailArgumentCount,+    tailArgumentNames,+    tailArgumentCountIsFixed,+    OptionDescription(OptionDescription),+    isRequired,+    optionFlag,+    argumentNames,+    minArgumentCount,+    argumentCountIsFixed) where++import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+--import Test.HUnit++data CommandLineDescription = CommandLineDescription {+    options :: [OptionDescription],+    +    minTailArgumentCount :: Int,+    +    tailArgumentNames :: [String],+    +    tailArgumentCountIsFixed :: Bool} deriving (Show, Eq, Ord)++-- | a data structure for describing command line arguments+data OptionDescription = OptionDescription {+    +    -- | determines if this is a required option or not+    isRequired :: Bool,+    +    {- |+    What flag should we use. Eg: "-pretty-output"+    -}+    optionFlag :: String,+    +    {- |+    The name(s) to use for the argument(s).+    -}+    argumentNames :: [String],+    +    {- |+    the minimum number of args allowed+    -}+    minArgumentCount :: Int,+    +    {- |+    if true then 'minArgumentCount' is the upper threshold+    -}+    argumentCountIsFixed :: Bool} deriving (Show, Eq, Ord)++space = " ";+etc = "...";++formatCommandLine commandLine =+    let formattedOptions = formatOptions (options commandLine)+        formattedTailArgs = formatTailArguments commandLine+    in+        if null formattedOptions || null formattedTailArgs then+            formattedOptions ++ formattedTailArgs+        else+            formattedOptions ++ space ++ formattedTailArgs++formatTailArguments commandLine =+    let tailArgs = tailArgumentNames commandLine+        minTailArgs = minTailArgumentCount commandLine+        formattedTailArgs = intercalate space (take minTailArgs (cycle tailArgs))+    in+        if tailArgumentCountIsFixed commandLine then+            formattedTailArgs+         else+            if null formattedTailArgs then etc+            else formattedTailArgs ++ space ++ etc++formatOptions :: [OptionDescription] -> String+formatOptions [] = ""+formatOptions (headOption:optionsTail) =+    let argSubstring = argumentSubstring headOption+        spacedArgSubstring = if null argSubstring then "" else space ++ argSubstring+        requiredOptionString = (optionFlag headOption) ++ spacedArgSubstring+        formattedOptionsTail = if null optionsTail then "" else space ++ (formatOptions optionsTail)+    in+        if isRequired headOption then+            requiredOptionString ++ formattedOptionsTail+        else+            "[" ++ requiredOptionString ++ "]" ++ formattedOptionsTail++argumentSubstring option =+    let minArgs = minArgumentCount option+    in+        if argumentCountIsFixed option then+            if minArgs == 0 then ""+            else intercalate space (take minArgs (cycle (argumentNames option)))+        else+            -- take care of the bounded case+            (intercalate space (take minArgs (cycle (argumentNames option)))) ++ space ++ etc++extractCommandLineArguments ::+    CommandLineDescription ->+    [String] ->+    (Map.Map OptionDescription [[String]], [String])+extractCommandLineArguments cmdLineDesc argValues =+    let unreservedArgCount = (length argValues) - (minTailArgumentCount cmdLineDesc)+        (unreservedArgs, reservedArgs) = splitAt unreservedArgCount argValues+        theOptions = options cmdLineDesc+        (optionMap, remainingArgs) = extractOptions theOptions unreservedArgs+        anyOptionsInReservedArgs =+            let (hopefullyEmptyMap, _) = extractOptions theOptions reservedArgs+            in not $ Map.null hopefullyEmptyMap+    in+        -- TODO this if else is really lame. we should replace all this+        --      along w/ error handling with status codes+        if anyOptionsInReservedArgs then+            (Map.empty, [])+        else+            (optionMap, remainingArgs ++ reservedArgs)++extractOptions ::+    [OptionDescription] ->+    [String] ->+    (Map.Map OptionDescription [[String]], [String])+extractOptions [] argValues = (Map.empty, argValues)+extractOptions _ [] = (Map.empty, [])+extractOptions optDescs argValues@(argHead:argTail) =+    case (find (\optDesc -> optionFlag optDesc == argHead) optDescs) of+        Nothing ->+            (Map.empty, argValues)+        Just optDesc ->+            let (optArgs, afterOptArgs) = extractOption optDesc optDescs argValues+                (tailArgsMap, afterTailArgs) = extractOptions optDescs afterOptArgs+            in (addOptionArgsToMap tailArgsMap optDesc optArgs, afterTailArgs)++extractOption ::+    OptionDescription ->+    [OptionDescription] ->+    [String] ->+    ([String], [String])+extractOption optDesc allOptDescs (argHead:argTail) =+    let optArgExtent = argumentExtent optDesc allOptDescs argTail+    in splitAt optArgExtent argTail++argumentExtent :: OptionDescription -> [OptionDescription] -> [String] -> Int+argumentExtent optionDescription allOptDescs afterOptArgs =+    let allOptFlags = map optionFlag allOptDescs+        maybeNextArgIndex = findIndex (\arg -> any (== arg) allOptFlags) afterOptArgs+        minArgCount = minArgumentCount optionDescription+        isFixed = argumentCountIsFixed optionDescription+    in+        case maybeNextArgIndex of+            Nothing ->+                let afterOptLength = length afterOptArgs+                in+                    if afterOptLength < minArgCount then missingParameters+                    else if isFixed then minArgCount+                    else afterOptLength+            Just nextArgIndex ->+                if nextArgIndex < minArgCount then missingParameters+                else if isFixed then minArgCount+                else nextArgIndex+    where+        missingParameters =+            error $ "missing parameter(s) for " ++ (optionFlag optionDescription)++addOptionArgsToMap ::+    Map.Map OptionDescription [[String]] ->+    OptionDescription ->+    [String] ->+    Map.Map OptionDescription [[String]]+addOptionArgsToMap optArgMap opt args =+    case (Map.lookup opt optArgMap) of+        Nothing ->          Map.insert opt [args] optArgMap+        Just currArgs ->    Map.insert opt (currArgs ++ [args]) optArgMap++-- Test code+{-+byNameOption = OptionDescription+    False       -- isRequired+    "-by-name"  -- optionFlag+    []          -- argumentNames+    0           -- minArgumentCount+    True        -- argumentCountIsFixed++helpOption = OptionDescription+    False       -- isRequired+    "-help"     -- optionFlag+    []          -- argumentNames+    0           -- minArgumentCount+    True        -- argumentCountIsFixed++fancyPantsOption = OptionDescription+    False           -- isRequired+    "-fancy"        -- optionFlag+    ["f1", "f2"]    -- argumentNames+    2               -- minArgumentCount+    False           -- argumentCountIsFixed++cmdLineOps1 = [byNameOption, helpOption, fancyPantsOption]++cmdLineDesc1 = CommandLineDescription+    cmdLineOps1 -- options+    1           -- minTailArgumentCount+    "file/-"    -- tailArgumentNames+    True        -- tailArgumentCountIsFixed+cmdLine1 = ["-by-name", "-fancy", "f1arg", "f2arg", "-help", "-"]+parsedCmd1 = extractOptions (options cmdLineDesc1) cmdLine1++test1 = TestCase $ assertEqual+    "options test" cmdLineOps1 (options cmdLineDesc1)+-}
+ Util/IOUtil.hs view
@@ -0,0 +1,35 @@+module Util.IOUtil (+    bufferStdioToTempFile,+    getContentsFromFileOrStdin,+    getAll) where++import System.Directory+import System.IO++bufferStdioToTempFile = do+    stdioText <- getContents+    tempDir <- getTemporaryDirectory+    (tempFilePath, tempFileHandle) <- openTempFile tempDir "stdiobuffer.txt"+    hPutStr tempFileHandle stdioText+    hClose tempFileHandle+    return tempFilePath++getContentsFromFileOrStdin filePath = do+    if filePath == "-"+        then do+            getContents+        else do+            handle <- openFile filePath ReadMode+            hGetContents handle++getAll [] = []+getAll (x:xt) = do+    y <- x+    yt <- getAll xt+    return (y:yt)++-- | returns an infinite list of gets from a monad+keepGetting getAction = do+    headVal <- getAction+    tailVal <- keepGetting getAction+    return (headVal:tailVal)
+ Util/ListUtil.hs view
@@ -0,0 +1,27 @@+module Util.ListUtil (+    cascadingOrder,+    replaceAll) where++import Data.List++{-+replace all instances of 'targetSublist' found in 'list' with+'replacementList'+-}+replaceAll :: (Eq a) => [a] -> [a] -> [a] -> [a]+replaceAll [] _ _ = []+replaceAll list@(listHead:listTail) targetSublist replacementList =+    if targetSublist `isPrefixOf` list then+        let remainingList = drop (length targetSublist) list+        in  replacementList ++ (replaceAll remainingList targetSublist replacementList)+    else+        listHead:(replaceAll listTail targetSublist replacementList)++-- | applies a cascading order logic where 1st non-equal ordering defines+--   the ordering for the list. If they're all equal (or the list is empty)+--   then return EQ+cascadingOrder :: [Ordering] -> Ordering+cascadingOrder [] = EQ+cascadingOrder (LT:_) = LT+cascadingOrder (GT:_) = GT+cascadingOrder (EQ:tailOrders) = cascadingOrder tailOrders
+ csvtopretty.hs view
@@ -0,0 +1,38 @@+import Data.List+import System.Directory+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import Util.IOUtil++main = do+    args <- getArgs+    +    if (length args) /= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires a single command line argument " +++                    "(filename or '-')"+            exitFailure+        else do+            let fileArg = head args+                useStdio = (fileArg == "-")+            +            file <- if useStdio then bufferStdioToTempFile else return fileArg+            +            handle1 <- openFile file ReadMode+            contents1 <- hGetContents handle1+            handle2 <- openFile file ReadMode+            contents2 <- hGetContents handle2+            +            let table1 = parseTable csvFormat contents1+                columnWidths = maxTableColumnWidths table1+                table2 = parseTable csvFormat contents2+                prettyTableText = formatTableWithWidths "|" columnWidths table2+            +            putStr prettyTableText+            hClose handle1+            hClose handle2+            if useStdio then removeFile file else return ()
+ csvtotab.hs view
@@ -0,0 +1,23 @@+import Data.List+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import Util.IOUtil++main = do+    args <- getArgs+    +    if (length args) /= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires a single command line argument " +++                    "(filename or '-')"+            exitFailure+        else do+            contents <- getContentsFromFileOrStdin (last args)+            +            let table = parseTable csvFormat contents+                tabDelimitedText = formatTable tabDelimitedFormat table+            putStr tabDelimitedText
+ examples/create-view-metricstats.bash view
@@ -0,0 +1,17 @@+#!/bin/bash++# replicating 1st CREATE VIEW from+# http://www.itl.nist.gov/div897/ctg/dm/sql_examples.htm+#+# CREATE VIEW METRIC_STATS (ID, MONTH, TEMP_C, RAIN_C) AS+# SELECT ID,+# MONTH,+# (TEMP_F - 32) * 5 /9,+# RAIN_I * 0.3937+# FROM STATS;++# After redirecting to metric_stats.csv we can simply use that as a table.+# So, that's as close as TxtSushi gets to creating a view :-)+../dist/build/tssql/tssql -table STATS stats.csv \+'SELECT ID, MONTH, (TEMP_F - 32) * 5 /9, RAIN_I * 0.3937 FROM STATS' \+> metric_stats.csv
+ examples/example1.csv view
@@ -0,0 +1,242 @@+"id","some val","other val"+12,43,"hello 33"+13,44,"hello 34"+14,45,"hello 35"+15,46,"hello 36"+16,47,"hello 37"+17,48,"hello 38"+18,49,"hello 39"+19,50,"hello 40"+20,51,"hello 41"+21,52,"hello 42"+22,53,"hello 43"+23,54,"hello 44"+24,55,"hello 45"+25,56,"hello 46"+26,57,"hello 47"+27,58,"hello 48"+28,59,"hello 49"+29,60,"hello 50"+30,61,"hello 51"+31,62,"hello 52"+32,63,"hello 53"+33,64,"hello 54"+34,65,"hello 55"+35,66,"hello 56"+36,67,"hello 57"+37,68,"hello 58"+38,69,"hello 59"+39,70,"hello 60"+40,71,"hello 61"+41,72,"hello 62"+42,73,"hello 63"+43,74,"hello 64"+44,75,"hello 65"+45,76,"hello 66"+46,77,"hello 67"+47,78,"hello 68"+48,79,"hello 69"+49,80,"hello 70"+50,81,"hello 71"+51,82,"hello 72"+52,83,"hello 73"+53,84,"hello 74"+54,85,"hello 75"+55,86,"hello 76"+56,87,"hello 77"+57,43,"hello 78"+58,43,"hello 79"+59,43,"hello 80"+60,43,"hello 81"+61,43,"hello 82"+62,43,"hello 83"+63,43,"hello 84"+64,43,"hello 85"+65,44,"hello 86"+66,44,"hello 87"+67,44,"hello 88"+68,44,"hello 89"+69,44,"hello 90"+70,44,"hello 91"+71,44,"hello 92"+72,43,"hello 93"+73,43,"hello 94"+74,43,"hello 95"+75,43,"hello 96"+76,43,"hello 97"+77,43,"hello 98"+78,43,"hello 99"+79,43,"hello 100"+80,43,"hello 101"+81,43,"hello 102"+82,43,"hello 103"+83,43,"hello 104"+84,43,"hello 105"+85,43,"hello 106"+86,43,"hello 107"+87,43,"hello 108"+88,44,"hello 109"+89,44,"hello 110"+90,44,"hello 111"+91,44,"hello 112"+92,44,"hello 113"+93,44,"hello 114"+94,44,"hello 115"+95,43,"hello 116"+96,43,"hello 117"+97,43,"hello 118"+98,43,"hello 119"+99,43,"hello 120"+100,43,"hello 121"+101,43,"hello 122"+102,43,"hello 123"+103,43,"hello 124"+104,43,"hello 125"+105,43,"hello 126"+106,43,"hello 127"+107,43,"hello 128"+108,43,"hello 129"+109,43,"hello 130"+110,43,"hello 131"+111,43,"hello 132"+112,43,"hello 133"+113,43,"hello 134"+114,43,"hello 135"+115,43,"hello 136"+116,43,"hello 137"+117,43,"hello 138"+118,43,"hello 139"+119,43,"hello 140"+120,43,"hello 141"+121,43,"hello 142"+122,43,"hello 143"+123,43,"hello 144"+124,43,"hello 145"+125,43,"hello 146"+126,43,"hello 147"+127,43,"hello 148"+128,43,"hello 149"+129,43,"hello 150"+130,43,"hello 151"+131,43,"hello 152"+132,43,"hello 153"+133,43,"hello 154"+134,43,"hello 155"+135,43,"hello 156"+136,43,"hello 157"+137,43,"hello 158"+138,43,"hello 159"+139,43,"hello 160"+140,43,"hello 161"+141,43,"hello 162"+142,43,"hello 163"+143,43,"hello 164"+144,43,"hello 165"+145,43,"hello 166"+146,43,"hello 167"+147,43,"hello 168"+148,43,"hello 169"+149,43,"hello 170"+150,43,"hello 171"+151,43,"hello 172"+152,43,"hello 173"+153,43,"hello 174"+154,43,"hello 175"+155,43,"hello 176"+156,43,"hello 177"+157,43,"hello 178"+158,43,"hello 179"+159,43,"hello 180"+160,43,"hello 181"+161,43,"hello 182"+162,43,"hello 183"+163,43,"hello 184"+164,43,"hello 185"+165,43,"hello 186"+166,43,"hello 187"+167,43,"hello 188"+168,43,"hello 189"+169,43,"hello 190"+170,43,"hello 191"+171,43,"hello 192"+172,43,"hello 193"+173,43,"hello 194"+174,43,"hello 195"+175,43,"hello 196"+176,43,"hello 197"+177,43,"hello 198"+178,43,"hello 199"+179,43,"hello 200"+180,43,"hello 201"+181,43,"hello 202"+182,43,"hello 203"+183,43,"hello 204"+184,43,"hello 205"+185,43,"hello 206"+186,43,"hello 207"+187,43,"hello 208"+188,43,"hello 209"+189,43,"hello 210"+190,43,"hello 211"+191,43,"hello 212"+192,43,"hello 213"+193,43,"hello 214"+194,43,"hello 215"+195,43,"hello 216"+196,43,"hello 217"+197,43,"hello 218"+198,43,"hello 219"+199,43,"hello 220"+200,43,"hello 221"+201,43,"hello 222"+202,43,"hello 223"+203,43,"hello 224"+204,43,"hello 225"+205,43,"hello 226"+206,43,"hello 227"+207,43,"hello 228"+208,43,"hello 229"+209,43,"hello 230"+210,43,"hello 231"+211,43,"hello 232"+212,43,"hello 233"+213,43,"hello 234"+214,43,"hello 235"+215,43,"hello 236"+216,43,"hello 237"+217,43,"hello 238"+218,43,"hello 239"+219,43,"hello 240"+220,43,"hello 241"+221,43,"hello 242"+222,43,"hello 243"+223,43,"hello 244"+224,43,"hello 245"+225,43,"hello 246"+226,43,"hello 247"+227,43,"hello 248"+228,43,"hello 249"+229,43,"hello 250"+230,43,"hello 251"+231,43,"hello 252"+232,43,"hello 253"+233,43,"hello 254"+234,43,"hello 255"+235,43,"hello 256"+236,43,"hello 257"+237,43,"hello 258"+238,43,"hello 259"+239,43,"hello 260"+240,43,"hello 261"+241,43,"hello 262"+242,43,"hello 263"+243,43,"hello 264"+244,43,"hello 265"+245,43,"hello 266"+246,43,"hello 267"+247,43,"hello '268"""+248,"this +-- has +a couple of newlines","hello 269"+249,43,"hello 270"+250,43,"hello 271"
+ examples/example2.csv view
@@ -0,0 +1,8 @@+"id2","some val","other val"+244,"some","hello 265"+245,"other","hello 266"+246,"values","hello 267"+247,"than","hello '268"""+248,"example","hello 269"+249,"number","hello 270"+250,"one","hello 271"
+ examples/join-stats-station.bash view
@@ -0,0 +1,15 @@+#!/bin/bash++# replicating JOIN from+# http://www.itl.nist.gov/div897/ctg/dm/sql_examples.htm+#+# SELECT LAT_N, CITY, TEMP_F+# FROM STATS, STATION+# WHERE MONTH = 7+# AND STATS.ID = STATION.ID+# ORDER BY TEMP_F;++../dist/build/tssql/tssql -table STATION station.csv -table STATS stats.csv \+'SELECT LAT_N, CITY, TEMP_F FROM STATS JOIN STATION ON STATS.ID = STATION.ID+WHERE MONTH = 7 ORDER BY TEMP_F' \+| ../dist/build/csvtopretty/csvtopretty -
+ examples/kitchen-sink.bash view
@@ -0,0 +1,12 @@+#!/bin/bash++# Our kitchen sink example to exercise all of the TxtSushi functionality as+# we can in one SELECT.+# NOTE: the "+ 0" is needed to coerce id to an integer. Otherwise it is+# sorted as text which is not what we want+../dist/build/tssql/tssql \+'select `example1.csv`.*, `example2.csv`.`other val`, `example2.csv`.id2+from `example1.csv` join `example2.csv` on `example1.csv`.id = `example2.csv`.id2+where `other val` <> "hello 269" and id2 > 246+order by id + 0 asc' \+| ../dist/build/csvtopretty/csvtopretty -
+ examples/query-mgi-markers.bash view
@@ -0,0 +1,12 @@+#!/bin/bash++# An example of using TxtSushi to query one of the MGI (mouse genome informatics)+# database reports++wget -q -O - ftp://ftp.informatics.jax.org/pub/reports/MRK_List2.rpt | tabtocsv - \+| tssql -table mgi - \+'select `MGI Accession ID`, Symbol, Chr, trim(`cM Position`)+from mgi where (Chr = 1 or Chr = 8 or Chr = 19) and trim(`cM Position`) = "N/A"+order by Chr+0, Symbol' \+| csvtopretty -+
+ examples/select-station.bash view
@@ -0,0 +1,11 @@+#!/bin/bash++# replicating SELECT from+# http://www.itl.nist.gov/div897/ctg/dm/sql_examples.htm+#+# SELECT * FROM STATION+# WHERE LAT_N > 39.7++../dist/build/tssql/tssql -table STATION station.csv \+'SELECT * FROM STATION WHERE LAT_N > 39.7' \+| ../dist/build/csvtopretty/csvtopretty -
+ examples/station.csv view
@@ -0,0 +1,4 @@+ID,CITY,STATE,LAT_N,LONG_W+13,Phoenix,AZ,33,112+44,Denver,CO,40,105+66,Caribou,ME,47,68
+ examples/stats.csv view
@@ -0,0 +1,7 @@+ID,MONTH,TEMP_F,RAIN_I+13,1,57.4,0.31+13,7,91.7,5.15+44,1,27.3,0.18+44,7,74.8,2.11+66,1,6.7,2.1+66,7,65.8,4.52
+ joincol.hs view
@@ -0,0 +1,60 @@+import Data.List+import System.Directory+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import TxtSushi.Transform+import Util.IOUtil++closeAll [] = do return ()+closeAll (handle:tail) = do+    hClose handle+    closeAll tail++removeAll [] = do return ()+removeAll (file:tail) = do+    removeFile file+    removeAll tail++main = do+    args <- getArgs+    +    let lenArgs = length args+    +    if lenArgs < 4 || odd lenArgs+        then do+            hPutStrLn stderr $+                    "ERROR: program requires at least four arguments " +++                    "(two or more join column arguments and two filenames), " +++                    "also the argument count should be even"+            exitFailure+        else do+            let lenNonFileArgs = (lenArgs - 2)+                (nonFileArgs, fileName1:fileName2:[]) = splitAt lenNonFileArgs args+                allJoinIndices = map read nonFileArgs :: [Int]+                table1ColIndices = [allJoinIndices !! i | i <- [0, 2 .. (lenNonFileArgs - 1)]]+                table2ColIndices = [allJoinIndices !! i | i <- [1, 3 .. (lenNonFileArgs - 1)]]+                zippedColumnIndices = zip table1ColIndices table2ColIndices+            +            contents1 <- getContentsFromFileOrStdin fileName1+            contents2 <- getContentsFromFileOrStdin fileName2+            +            let table1 = parseTable csvFormat contents1+                table2 = parseTable csvFormat contents2+            +            (partialSortTables1, partialSortFileHandles1, partialSortFiles1) <- fileBasedSortTable table1ColIndices table1+            (partialSortTables2, partialSortFileHandles2, partialSortFiles2) <- fileBasedSortTable table2ColIndices table2+            +            let sortedTable1 = mergeAllBy (rowComparison table1ColIndices) partialSortTables1+                sortedTable2 = mergeAllBy (rowComparison table2ColIndices) partialSortTables2+                joinedTable = joinPresortedTables zippedColumnIndices sortedTable1 sortedTable2+                joinedTableText = formatTable csvFormat joinedTable+            +            putStr joinedTableText+            +            closeAll $ partialSortFileHandles1 ++ partialSortFileHandles2+            removeAll $ partialSortFiles1 ++ partialSortFiles2+            +            return ()
+ selectcol.hs view
@@ -0,0 +1,51 @@+import Data.List+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import TxtSushi.Transform+import Util.CommandLineArgument+import Util.IOUtil++{-+byNameOption = OptionDescription+    False       -- isRequired+    "-by-name"  -- optionFlag+    []          -- argumentNames+    0           -- minArgumentCount+    True        -- argumentCountIsFixed++helpOption = OptionDescription+    False       -- isRequired+    "-help"     -- optionFlag+    []          -- argumentNames+    0           -- minArgumentCount+    True        -- argumentCountIsFixed++options = [helpOption, byNameOption]+-}++--toColumnIndices optionMap [] = ++main = do+    args <- getArgs+    progName <- getProgName+    +    if (length args) <= 1+        then do+            error $ progName ++ " requires at least two arguments " +++                    "(one column argument and a filename or '-')"+        else do+            let argCount = length args+                (argsWithoutFile, [fileName]) = splitAt (argCount - 1) args+                --(optionsMap, tailArgs) = extractOptions options argsWithoutFile+                colIndices = map read (init args) :: [Int]+            +            contents <- getContentsFromFileOrStdin fileName+            +            let table = parseTable csvFormat contents+                subsetTable = selectColumns colIndices table+                subsetTableText = formatTable csvFormat subsetTable+            putStr subsetTableText+            return ()
+ selectcolname.hs view
@@ -0,0 +1,38 @@+import Data.List+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import TxtSushi.Transform+import Util.IOUtil++maybeIndexToIndexOrError :: [String] -> [Maybe Int] -> [Int]+maybeIndexToIndexOrError [] [] = []+maybeIndexToIndexOrError (name:namesTail) (Nothing:indexTail) =+    error $ "Could not find column header named \"" ++ name ++ "\""+maybeIndexToIndexOrError (name:namesTail) ((Just index):indexTail) =+    index:(maybeIndexToIndexOrError namesTail indexTail)++main = do+    args <- getArgs+    +    if (length args) <= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires at least two arguments " +++                    "(one column name argument and a filename or '-')"+            exitFailure+        else do+            contents <- getContentsFromFileOrStdin (last args)+            +            let argsWithoutFile = init args+                colNames = init args+                table = parseTable csvFormat contents+                header = head table+                maybeColIndices = [elemIndex name header | name <- colNames]+                colIndices = maybeIndexToIndexOrError colNames maybeColIndices+                subsetTable = selectColumns colIndices table+                subsetTableText = formatTable csvFormat subsetTable+            putStr subsetTableText+            return ()
+ sortcol.hs view
@@ -0,0 +1,47 @@+import Data.List+import System.Directory+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import TxtSushi.Transform+import Util.IOUtil++closeAll [] = do return ()+closeAll (handle:tail) = do+    hClose handle+    closeAll tail++removeAll [] = do return ()+removeAll (file:tail) = do+    removeFile file+    removeAll tail++main = do+    args <- getArgs+    +    if (length args) <= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires at least two arguments " +++                    "(one column argument and a filename or '-')"+            exitFailure+        else do+            contents <- getContentsFromFileOrStdin (last args)+            +            let argsWithoutFile = init args+                colIndices = map read (init args) :: [Int]+                table = parseTable csvFormat contents+            +            (partialSortTables, partialSortFileHandles, partialSortFiles) <- fileBasedSortTable colIndices table+            +            let sortedTable     = mergeAllBy (rowComparison colIndices) partialSortTables+                sortedTableText = formatTable csvFormat sortedTable+            +            putStr sortedTableText+            +            closeAll partialSortFileHandles+            removeAll partialSortFiles+            +            return ()
+ tabtocsv.hs view
@@ -0,0 +1,23 @@+import Data.List+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import Util.IOUtil++main = do+    args <- getArgs+    +    if (length args) /= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires a single command line argument " +++                    "(filename or '-')"+            exitFailure+        else do+            contents <- getContentsFromFileOrStdin (last args)+            +            let table = parseTable tabDelimitedFormat contents+                csvText = formatTable csvFormat table+            putStr csvText
+ tabtopretty.hs view
@@ -0,0 +1,38 @@+import Data.List+import System.Directory+import System.Environment+import System.Exit+import System.IO++import TxtSushi.IO+import Util.IOUtil++main = do+    args <- getArgs+    +    if (length args) /= 1+        then do+            hPutStrLn stderr $+                    "ERROR: program requires a single command line argument " +++                    "(filename or '-')"+            exitFailure+        else do+            let fileArg = head args+                useStdio = (fileArg == "-")+            +            file <- if useStdio then bufferStdioToTempFile else return fileArg+            +            handle1 <- openFile file ReadMode+            contents1 <- hGetContents handle1+            handle2 <- openFile file ReadMode+            contents2 <- hGetContents handle2+            +            let table1 = parseTable tabDelimitedFormat contents1+                columnWidths = maxTableColumnWidths table1+                table2 = parseTable tabDelimitedFormat contents2+                prettyTableText = formatTableWithWidths "|" columnWidths table2+            +            putStr prettyTableText+            hClose handle1+            hClose handle2+            if useStdio then removeFile file else return ()
+ tssql.hs view
@@ -0,0 +1,116 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Keith Sheppard 2009+-- License     :  GPL3 or greater+-- Maintainer  :  keithshep@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Main entry point for the TxtSushi SQL command line+--+-----------------------------------------------------------------------------+import Data.List+import qualified Data.Map as Map+import System.Environment+import System.Exit+import System.IO++import Text.ParserCombinators.Parsec++import TxtSushi.IO+import TxtSushi.SQLExecution+import TxtSushi.SQLParser+import TxtSushi.Transform+import Util.CommandLineArgument+import Util.IOUtil++helpOption = OptionDescription {+    isRequired              = False,+    optionFlag              = "-help",+    argumentNames           = [],+    minArgumentCount        = 0,+    argumentCountIsFixed    = True}++tableDefOption = OptionDescription {+    isRequired              = False,+    optionFlag              = "-table",+    argumentNames           = ["CSV-file-name", "table-name"],+    minArgumentCount        = 2,+    argumentCountIsFixed    = True}++turtleSqlOpts = [helpOption, tableDefOption]++sqlCmdLine = CommandLineDescription {+    options                     = turtleSqlOpts,+    minTailArgumentCount        = 1,+    tailArgumentNames           = ["SQL-select-statement"],+    tailArgumentCountIsFixed    = True}++validateTableNames :: [String] -> [String] -> Bool+validateTableNames [] _ = True+validateTableNames (argTblHead:argTblTail) selectTbls =+    if argTblHead `elem` selectTbls then+        validateTableNames argTblTail selectTbls+    else+        error $ "The given table name \"" ++ argTblHead +++                "\" does not appear in the SELECT statement"++tableArgsToMap [] = Map.empty+tableArgsToMap (currTableArgs:tailTableArgs) =+    case currTableArgs of+        [fileName, tableName] ->+            Map.insert fileName tableName (tableArgsToMap tailTableArgs)+        otherwise ->+            error $ "the \"" ++ (optionFlag tableDefOption) +++                    "\" option should have exactly two arguments"++unwrapMapList [] = return []+unwrapMapList ((key, value):mapTail) = do+    unwrappedValue <- value+    unwrappedTail <- unwrapMapList mapTail+    return $ (key, unwrappedValue):unwrappedTail++printUsage progName =+    putStrLn $ "Usage: " ++ progName ++ " " ++ formatCommandLine sqlCmdLine++main = do+    args <- getArgs+    progName <- getProgName+    +    let (argMap, argTail) = extractCommandLineArguments sqlCmdLine args+        showHelp = Map.member helpOption argMap || length argTail /= 1+        parseOutcome = parse parseSelectStatement "" (head argTail)+    +    if showHelp then printUsage progName else+        case parseOutcome of+            Left  err        -> print err+            Right selectStmt ->+                let+                    -- create a table file map from the user args+                    tableArgs = Map.findWithDefault [] tableDefOption argMap+                    tableArgMap = tableArgsToMap tableArgs+                    +                    -- get a default table to file map from the select statement+                    selectTblNames = allMaybeTableNames (maybeFromTable selectStmt)+                    defaultTblMap = Map.fromList (zip selectTblNames selectTblNames)+                    +                    -- join the two with arg values taking precidence over+                    -- the default values+                    finalTblFileMap = tableArgMap `Map.union` defaultTblMap+                in+                    -- turn the files into strings+                    if validateTableNames (Map.keys tableArgMap) selectTblNames+                        then do+                            let contentsMap = Map.map getContentsFromFileOrStdin finalTblFileMap+                            +                            unwrappedContents <- unwrapMapList $ Map.toList contentsMap+                            +                            let unwrappedContentsMap = Map.fromList unwrappedContents+                                textTableMap = Map.map (parseTable csvFormat) unwrappedContentsMap+                                dbTableMap = Map.mapWithKey textTableToDatabaseTable textTableMap+                                selectedDbTable = select selectStmt dbTableMap+                                selectedTxtTable = databaseTableToTextTable selectedDbTable+                            +                            putStr $ formatTable csvFormat selectedTxtTable+                        else+                            exitFailure
+ txt-sushi.cabal view
@@ -0,0 +1,47 @@+Name:                txt-sushi+Version:             0.1+Synopsis:            A collection of command line utilities for processing text tables+Description:+    TxtSushi is a collection of command line utilities for processing+    comma-separated and tab-delimited files (AKA flat files, spreadsheets).+    By focusing exclusively on processing text files with a tabular structure,+    TxtSushi simplifies common tasks like filtering, joining and transformation+    that would take some effort to accomplish with a more powerful scripting+    language. TxtSushi's homepage is <http://keithsheppard.name/txt-sushi>.+License:             GPL+License-File:        COPYING+Author:              Keith Sheppard+Maintainer:          keithshep@gmail.com+Build-Type:          Simple+Category:            Utils, Text, Database+Cabal-Version:       >=1.2++Executable tssql+  Main-Is:          tssql.hs+  Build-Depends:    base,haskell98,directory,containers,parsec+  +  -- creates highly optimized code (slow compile)+  GHC-Options:      -O2 -fvia-C+  +  -- combine the following with the +RTS -xc -RTS runtime option for stack taces+  --GHC-Options:      -prof -auto-all++Executable csvtotab+  Main-Is:          csvtotab.hs+  Build-Depends:    base,haskell98,directory,containers+  GHC-Options:      -O2 -fvia-C++Executable tabtocsv+  Main-Is:          tabtocsv.hs+  Build-Depends:    base,haskell98,directory,containers+  GHC-Options:      -O2 -fvia-C++Executable csvtopretty+  Main-Is:          csvtopretty.hs+  Build-Depends:    base,haskell98,directory,containers+  GHC-Options:      -O2 -fvia-C++Executable tabtopretty+  Main-Is:          tabtopretty.hs+  Build-Depends:    base,haskell98,directory,containers+  GHC-Options:      -O2 -fvia-C