packages feed

nirum (empty) → 0.1.0

raw patch · 37 files changed

+6368/−0 lines, 37 filesdep +basedep +cmdargsdep +containerssetup-changed

Dependencies added: base, cmdargs, containers, directory, filepath, hlint, hspec, hspec-core, hspec-meta, interpolatedstring-perl6, megaparsec, nirum, process, semigroups, semver, temporary, text

Files

+ LICENSE 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>.
+ Main.hs view
@@ -0,0 +1,3 @@+module Main (main) where++import Nirum.Cli (main)
+ README.md view
@@ -0,0 +1,69 @@+Nirum+=====++Nirum is an [IDL][1] compiler and [RPC][2]/[distributed object][3] framework+for [microservices][4], built on top of the modern Web server technologies+such as RESTful HTTP and JSON.++You can find how its IDL looks like from source codes in the `examples/`+directory.++**Note that its design is highly unstable and could be changed.**+Also the feature set is incomplete yet.++[1]: https://en.wikipedia.org/wiki/Interface_description_language+[2]: https://en.wikipedia.org/wiki/Remote_procedure_call+[3]: https://en.wikipedia.org/wiki/Distributed_object+[4]: https://en.wikipedia.org/wiki/Microservices+++Installation+------------++If you already installed [Haskell Platform][5] or [Haskell Stack][6],+you can build the project in the same way other Haskell projects are built:++    $ cabal sandbox init+    $ cabal install --only-dependencies+    $ cabal configure+    $ cabal build++or:++    $ stack build++[5]: https://www.haskell.org/platform/+[6]: https://www.haskellstack.org/+++Getting Started+---------------++In order to compile a Nirum package (`examples/`) to a Python package:++    $ mkdir out/  # directory to place generated Python files+    $ nirum -o out/ examples/++For more infomration, use `--help` option:++    $ nirum --help+    Nirum Compiler 0.1.0++    nirum [OPTIONS] DIR++    Common flags:+      -o --output-dir=DIR   The directory to place object files+      -? --help             Display help message+      -V --version          Print version information+         --numeric-version  Print just the version number+++Etymology+---------++**니름** (IPA: /niɾɯm/; *nireum*) is a sort of telepathy in the fictional world+of [The Bird That Drinks Tears][7] (눈물을 마시는 새 *Nunmureul masineun sae*)+by [Lee Yeongdo][8] (이영도).++[7]: https://en.wikipedia.org/wiki/The_Bird_That_Drinks_Tears+[8]: https://en.wikipedia.org/wiki/Lee_Yeongdo
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ nirum.cabal view
@@ -0,0 +1,111 @@+name:                nirum+version:             0.1.0+synopsis:            Distributed object framework built on top of+                     REST HTTP and JSON+description:         Distributed object framework for microservices,+                     built on top of RESTful HTTP and JSON+homepage:            https://github.com/spoqa/nirum+bug-reports:         https://github.com/spoqa/nirum/issues+license:             GPL-3+license-file:        LICENSE+author:              Nirum team+maintainer:          Nirum team+copyright:           (c) 2016 Nirum team+stability:           alpha+category:            Language+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     Nirum.Cli+                 ,     Nirum.Constructs+                 ,     Nirum.Constructs.Annotation+                 ,     Nirum.Constructs.Declaration+                 ,     Nirum.Constructs.DeclarationSet+                 ,     Nirum.Constructs.Identifier+                 ,     Nirum.Constructs.Module+                 ,     Nirum.Constructs.ModulePath+                 ,     Nirum.Constructs.Name+                 ,     Nirum.Constructs.Service+                 ,     Nirum.Constructs.TypeDeclaration+                 ,     Nirum.Constructs.TypeExpression+                 ,     Nirum.Package+                 ,     Nirum.Parser+                 ,     Nirum.Targets.Python+                 ,     Nirum.Version+  build-depends:       base                     >=4.7     && <5+               ,       containers               >=0.5.6.2 && <0.6+               ,       cmdargs                  >=0.10.14 && <0.11+               ,       directory                >=1.2.5   && <1.3+               ,       filepath                 >=1.4     && <1.5+               ,       interpolatedstring-perl6 >=1.0.0   && <1.1.0+               ,       megaparsec               >=5       && <5.1+               ,       semver                   >=0.3.0   && <1.0+               ,       text                     >=0.9.1.0 && <1.3+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -fwarn-incomplete-uni-patterns++executable nirum+  build-depends:       base   >=4.7     && <5+               ,       nirum+  main-is:             Main.hs+  default-language:    Haskell2010+  ghc-options:         -fwarn-incomplete-uni-patterns+                       -threaded -with-rtsopts=-N++executable nirum-static+  build-depends:       base   >=4.7     && <5+               ,       nirum+  main-is:             Main.hs+  default-language:    Haskell2010+  ghc-options:         -fwarn-incomplete-uni-patterns+                       -threaded -with-rtsopts=-N+                       -static++test-suite spec+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Nirum.CliSpec+               ,       Nirum.Constructs.AnnotationSpec+               ,       Nirum.Constructs.DeclarationSpec+               ,       Nirum.Constructs.DeclarationSetSpec+               ,       Nirum.Constructs.IdentifierSpec+               ,       Nirum.Constructs.ModuleSpec+               ,       Nirum.Constructs.ModulePathSpec+               ,       Nirum.Constructs.NameSpec+               ,       Nirum.Constructs.TypeDeclarationSpec+               ,       Nirum.Constructs.TypeExpressionSpec+               ,       Nirum.PackageSpec+               ,       Nirum.ParserSpec+               ,       Nirum.Targets.PythonSpec+               ,       Nirum.VersionSpec+  default-language:    Haskell2010+  build-depends:       base                     >=4.7     && <5+               ,       containers               >=0.5.6.2 && <0.6+               ,       directory+               ,       filepath                 >=1.4     && <1.5+               ,       hspec+               ,       hspec-core+               ,       hspec-meta+               ,       interpolatedstring-perl6 >=1.0.0   && <1.1.0+               ,       megaparsec               >=5       && <5.1+               ,       nirum+               ,       process                  >=1.1     && <2+               ,       semigroups+               ,       semver                   >=0.3.0   && <1.0+               ,       temporary                >=1.2     && <1.3+               ,       text                     >=0.9.1.0 && <1.3+  ghc-options:         -fno-warn-incomplete-uni-patterns+                       -fno-warn-missing-signatures+                       -threaded -with-rtsopts=-N++test-suite hlint+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             HLint.hs+  default-language:    Haskell2010+  build-depends:       base        >=4.7     && <5+               ,       hlint       >=1.9     && <2
+ src/Nirum/Cli.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings, QuasiQuotes,+             DeriveDataTypeable #-}+module Nirum.Cli (main, writeFiles) where++import Control.Monad (forM_)+import GHC.Exts (IsList(toList))+import System.IO.Error (catchIOError, ioeGetErrorString)++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Data.Text.IO as TI+import System.Console.CmdArgs.Implicit ( Data+                                       , Typeable+                                       , argPos+                                       , cmdArgs+                                       , explicit+                                       , help+                                       , name+                                       , program+                                       , summary+                                       , typDir+                                       , (&=)+                                       )+import System.Console.CmdArgs.Default (def)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory, (</>))+import Text.InterpolatedString.Perl6 (qq)+import Text.Megaparsec (Token)+import Text.Megaparsec.Error ( Dec+                             , ParseError(errorPos)+                             , parseErrorPretty+                             )+import Text.Megaparsec.Pos (SourcePos(sourceLine, sourceColumn), unPos)++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Identifier (toText)+import Nirum.Constructs.ModulePath (ModulePath)+import Nirum.Package ( PackageError(ParseError, ImportError, ScanError)+                     , ImportError ( CircularImportError+                                   , MissingImportError+                                   , MissingModulePathError+                                   )+                     , scanModules+                     , scanPackage+                     )+import Nirum.Targets.Python (compilePackage)+import Nirum.Version (versionString)++data NirumCli = NirumCli { sourcePath :: FilePath+                         , objectPath :: FilePath+                         } deriving (Show, Data, Typeable)++parseErrortoPrettyMessage :: ParseError (Token T.Text) Dec+                          -> FilePath+                          -> IO String+parseErrortoPrettyMessage parseError' filePath' = do+    sourceCode <- readFile filePath'+    let sourceLines = lines sourceCode+        sl = if length sourceLines < errorLine then ""+             else sourceLines !! (errorLine - 1)+    return [qq|+{parseErrorPretty $ parseError'}+$sl+{arrow}+|]+  where+    error' :: SourcePos+    error' = head $ toList $ errorPos parseError'+    errorLine :: Int+    errorLine = fromEnum $ unPos $ sourceLine error'+    errorColumn :: Int+    errorColumn = fromEnum $ unPos $ sourceColumn error'+    arrow :: T.Text+    arrow = T.snoc (T.concat (replicate (errorColumn - 1) (T.pack " "))) '^'++toModuleNameText :: T.Text -> T.Text+toModuleNameText t = [qq|'{t}'|]++modulePathToRepr :: ModulePath -> T.Text+modulePathToRepr = toModuleNameText . toCode++importErrorToPrettyMessage :: ImportError -> T.Text+importErrorToPrettyMessage (CircularImportError modulePaths) =+    [qq|Circular import detected in following orders: $order|]+  where+    circularModulesText :: [ModulePath] -> [T.Text]+    circularModulesText = map modulePathToRepr+    order :: T.Text+    order = T.intercalate " > " $ circularModulesText modulePaths+importErrorToPrettyMessage (MissingModulePathError path path') =+    [qq|No module named $dataName in $moduleName|]+  where+    moduleName :: T.Text+    moduleName = modulePathToRepr path+    dataName :: T.Text+    dataName = modulePathToRepr path'+importErrorToPrettyMessage (MissingImportError path path' identifier) =+    [qq|Cannot import $importText from $attrText in $foundText|]+  where+    importText :: T.Text+    importText = (toModuleNameText . toText) identifier+    foundText :: T.Text+    foundText = modulePathToRepr path+    attrText :: T.Text+    attrText = modulePathToRepr path'+++importErrorsToMessageList :: S.Set ImportError -> [T.Text]+importErrorsToMessageList importErrors =+    S.toList $ S.map importErrorToPrettyMessage importErrors+importErrorsToPrettyMessage :: S.Set ImportError -> String+importErrorsToPrettyMessage importErrors =+    T.unpack $ T.intercalate "\n" withListStyleText+  where+    withListStyleText :: [T.Text]+    withListStyleText =+        map (T.append "- ") (importErrorsToMessageList importErrors)++nirumCli :: NirumCli+nirumCli = NirumCli { objectPath = def &= explicit+                          &= name "o" &= name "output-dir" &= typDir+                          &= help "The directory to place object files"+                    , sourcePath = def &= argPos 1 &= typDir+                    }+         &= program "nirum"+         &= summary ("Nirum Compiler " ++ versionString)++main' :: IO ()+main' = do+    NirumCli src obj <- cmdArgs nirumCli+    scanResult <- scanPackage src+    case scanResult of+        Left (ParseError modulePath error') -> do+            -- FIXME: find more efficient way to determine filename from+            --        the given module path+            filePaths <- scanModules src+            case M.lookup modulePath filePaths of+                Just filePath' -> do+                    m <- parseErrortoPrettyMessage error' filePath'+                    putStrLn m+                Nothing -> putStrLn [qq|$modulePath not found|]+        Left (ImportError importErrors) ->+            putStrLn [qq|Import error:+{importErrorsToPrettyMessage importErrors}+|]+        Left (ScanError _ error') -> putStrLn [qq|Scan error: $error'|]+        Right pkg -> writeFiles obj $ compilePackage pkg++writeFiles :: FilePath -> M.Map FilePath (Either T.Text T.Text) -> IO ()+writeFiles obj m =+    forM_ files $ \(filePath, result) ->+        case result of+            Left compileError -> putStrLn [qq|error: $filePath: $compileError|]+            Right code -> do+                createDirectoryIfMissing True $ takeDirectory filePath+                putStrLn filePath+                TI.writeFile filePath code+  where+    files :: [(FilePath, Either T.Text T.Text)]+    files = [(obj </> f, r) | (f, r) <- M.toList m]++main :: IO ()+main = catchIOError main' $ putStrLn . ioeGetErrorString
+ src/Nirum/Constructs.hs view
@@ -0,0 +1,6 @@+module Nirum.Constructs (Construct, toCode) where++import Data.Text (Text)++class (Eq a, Ord a) => Construct a where+    toCode :: a -> Text
+ src/Nirum/Constructs/Annotation.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}+module Nirum.Constructs.Annotation ( Annotation(Annotation)+                                   , AnnotationSet(AnnotationSet)+                                   , Metadata+                                   , NameDuplication(AnnotationNameDuplication)+                                   , annotations+                                   , empty+                                   , fromList+                                   , toCode+                                   , toList+                                   ) where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import Text.InterpolatedString.Perl6 (qq)++import Nirum.Constructs (Construct (toCode))+import Nirum.Constructs.Identifier (Identifier)+++type Metadata = T.Text++-- | Annotation for 'Declaration'.+data Annotation = Annotation { name :: Identifier+                             , metadata :: Maybe Metadata+                             } deriving (Eq, Ord, Show)++instance Construct Annotation where+    toCode Annotation {name = n,  metadata = Just m} =+        let m' = T.replace "\"" "\\\"" m in [qq|@{toCode n}("$m'")|]+    toCode Annotation {name = n,  metadata = Nothing} = [qq|@{toCode n}|]++data AnnotationSet+  -- | The set of 'Annotation' values.+  -- Every annotation name has to be unique in the set.+  = AnnotationSet { annotations :: M.Map Identifier Annotation }+  deriving (Eq, Ord, Show)++instance Construct AnnotationSet where+    toCode AnnotationSet {annotations = annotations'} =+        T.concat [s | e <- M.elems annotations', s <- [toCode e, "\n"]]++data NameDuplication = AnnotationNameDuplication Identifier+                     deriving (Eq, Ord, Show)++empty :: AnnotationSet+empty = AnnotationSet { annotations = M.empty }++fromList :: [Annotation] -> Either NameDuplication AnnotationSet+fromList annotations' =+    case findDup names S.empty of+        Just duplication -> Left (AnnotationNameDuplication duplication)+        _ -> Right AnnotationSet { annotations = M.fromList [ (name a, a)+                                                            | a <- annotations'+                                                            ]+                                 }+  where+    names :: [Identifier]+    names = [name a | a <- annotations']+    findDup :: [Identifier] -> S.Set Identifier -> Maybe Identifier+    findDup identifiers dups =+        case identifiers of+            x:xs -> if x `S.member` dups+                    then Just x+                    else findDup xs $ S.insert x dups+            _ -> Nothing++toList :: AnnotationSet -> [Annotation]+toList AnnotationSet { annotations = annotations' } = M.elems annotations'
+ src/Nirum/Constructs/Declaration.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.Declaration ( Declaration+                                    , Docs(Docs)+                                    , docs+                                    , name+                                    , toCode+                                    , toCodeWithPrefix+                                    , toText+                                    ) where++import Data.String (IsString(fromString))++import qualified Data.Text as T++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Name (Name)++-- 'Construct' which has its own unique 'name' and can has its 'docs'.+class Construct a => Declaration a where+    name :: a -> Name+    docs :: a -> Maybe Docs++-- | Docstring for constructs.+data Docs = Docs T.Text deriving (Eq, Ord, Show)++-- | Convert the docs to text.+toText :: Docs -> T.Text+toText (Docs docs') = docs'++-- | Similar to 'toCode' except it takes 'Maybe Docs' instead of 'Docs'.+-- If the given docs is 'Nothing' it simply returns an empty string.+-- Otherwise it returns a code string with the prefix.+toCodeWithPrefix :: T.Text     -- | The prefix to be prepended if not empty.+                 -> Maybe Docs -- | The docs to convert to code.+                 -> T.Text+toCodeWithPrefix _ Nothing = ""+toCodeWithPrefix prefix (Just docs') = T.append prefix $ toCode docs'++instance Construct Docs where+    toCode (Docs docs') = let d = if "\n" `T.isSuffixOf` docs'+                                  then T.dropEnd 1 docs'+                                  else docs'+                          in T.append "# " $ T.replace "\n" "\n# " d++instance IsString Docs where+    fromString s = let t = T.pack s+                   in Docs (if "\n" `T.isSuffixOf` t+                            then t+                            else t `T.snoc` '\n')
+ src/Nirum/Constructs/DeclarationSet.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedLists, TypeFamilies #-}+module Nirum.Constructs.DeclarationSet ( DeclarationSet()+                                       , NameDuplication( BehindNameDuplication+                                                        , FacialNameDuplication+                                                        )+                                       , empty+                                       , fromList+                                       , lookup+                                       , lookup'+                                       , null+                                       , null'+                                       , size+                                       , toList+                                       , union+                                       , (!)+                                       ) where++import Data.Maybe (fromJust)+import qualified GHC.Exts as L+import Prelude hiding (lookup, null)++import qualified Data.Map.Strict as M+import qualified Data.Set as S++import Nirum.Constructs.Declaration (Declaration(name))+import Nirum.Constructs.Identifier (Identifier)+import Nirum.Constructs.Name (Name(Name, behindName, facialName))++data Declaration a => DeclarationSet a+    -- | The set of 'Declaration' values.+    -- Every 'name' has to be unique in the set.+    -- The order of declarations is maintained.+    = DeclarationSet { declarations :: M.Map Identifier a+                     , index :: ![Identifier]+                     }+    deriving (Eq, Ord, Show)++data NameDuplication = FacialNameDuplication !Name+                     | BehindNameDuplication !Name+                     deriving (Eq, Show)++empty :: Declaration a => DeclarationSet a+empty = DeclarationSet { declarations = M.empty+                       , index = []+                       }++fromList :: Declaration a => [a] -> Either NameDuplication (DeclarationSet a)+fromList declarations' =+    case findDup names facialName S.empty of+        Just dup -> Left $ FacialNameDuplication dup+        _ -> case findDup names behindName S.empty of+            Just dup -> Left $ BehindNameDuplication dup+            _ -> Right DeclarationSet { declarations = M.fromList mapList+                                      , index = index'+                                      }+  where+    names :: [Name]+    names = map name declarations'+    index' :: [Identifier]+    index' = map facialName names+    mapList = [(facialName (name d), d) | d <- declarations']+    findDup :: [Name] -> (Name -> Identifier) -> S.Set Identifier -> Maybe Name+    findDup names' f dups =+        case names' of+            x:xs -> let name' = f x+                    in if name' `S.member` dups+                       then Just x+                       else findDup xs f $ S.insert name' dups+            _ -> Nothing++toList :: Declaration a => DeclarationSet a -> [a]+toList (DeclarationSet declarations' index') =+    map ((M.!) declarations') index'++size :: Declaration a => DeclarationSet a -> Int+size (DeclarationSet declarations' _) = M.size declarations'++null :: Declaration a => DeclarationSet a -> Bool+null = null'++null' :: Declaration a => DeclarationSet a -> Bool+null' (DeclarationSet declarations' _) = M.null declarations'++lookup :: Declaration a => Identifier -> DeclarationSet a -> Maybe a+lookup = lookup'++lookup' :: Declaration a => Identifier -> DeclarationSet a -> Maybe a+lookup' facialName' (DeclarationSet declarations' _) =+    M.lookup facialName' declarations'++(!) :: Declaration a => DeclarationSet a -> Identifier -> a+declarationSet ! facialName' = fromJust $ lookup' facialName' declarationSet++union :: Declaration a+      => DeclarationSet a+      -> DeclarationSet a+      -> Either NameDuplication (DeclarationSet a)+union a b = fromList $ toList a ++ toList b++instance (Declaration a) => L.IsList (DeclarationSet a) where+    type Item (DeclarationSet a) = a+    fromList declarations' =+        case fromList declarations' of+            Right set -> set+            Left (FacialNameDuplication (Name fname _)) ->+                error ("identifiers must be unique; " ++ show fname +++                       " is defined more than once")+            Left (BehindNameDuplication (Name _ bname)) ->+                error ("behind names must be unique; " ++ show bname +++                        " is defined more than once")+    toList = toList
+ src/Nirum/Constructs/Identifier.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.Constructs.Identifier ( Identifier+                                   , fromString+                                   , fromText+                                   , identifierRule+                                   , normalize+                                   , reservedKeywords+                                   , show+                                   , toCode+                                   , tokens+                                   , toCamelCaseText+                                   , toNormalizedString+                                   , toNormalizedText+                                   , toString+                                   , toSnakeCaseText+                                   , toText+                                   , toPascalCaseText+                                   , toLispCaseText+                                   , (==)+                                   ) where++import Data.Char (toLower, toUpper)+import Data.Maybe (fromMaybe)+import Data.String (IsString(fromString))++import qualified Data.Text as T+import qualified Data.Set as S+import qualified Text.Megaparsec as P+import Text.Megaparsec.Char (oneOf, satisfy)+import Text.Megaparsec.Text (Parser)++import Nirum.Constructs (Construct(toCode))++-- | Case-insensitive identifier.  It also doesn't distinguish hyphens+-- from underscores.+--+-- It has more restrict rules than the most of programming languages:+--+-- * It can't start with digits or hyphens/underscores.+-- * Hyphens/underscores can't continuously appear more than once.+-- * Only roman alphabets, Arabic numerals, hyphens and underscores+--   are allowed.+-- +-- These rules are for portability between various programming languages.+-- For example, @BOOK_CATEGORY@ and @Book-Category@ are all normalized+-- to @book-category@, and it can be translated to:+-- +-- [snake_case] @book_category@+-- [camelCase] @bookCategory@+-- [PascalCase] @BookCategory@+-- [lisp-case] @book-category@+data Identifier = Identifier T.Text deriving (Show)++reservedKeywords :: S.Set Identifier+reservedKeywords = [ "boxed"+                   , "enum"+                   , "record"+                   , "service"+                   , "throws"+                   , "type"+                   , "union"+                   ]++identifierRule :: Parser Identifier+identifierRule = do+    firstChar <- satisfy isAlpha+    restChars <- P.many $ satisfy isAlnum+    restWords <- P.many $ do+        sep <- oneOf ("-_" :: String)+        chars <- P.some $ satisfy isAlnum+        return $ T.pack $ sep:chars+    return $ Identifier $ T.concat $ T.pack (firstChar : restChars) : restWords+  where+    isAlpha :: Char -> Bool+    isAlpha c = 'a' <= c && c <= 'z' || 'A' <= c && c <= 'Z'+    isDigit :: Char -> Bool+    isDigit c = '0' <= c && c <= '9'+    isAlnum :: Char -> Bool+    isAlnum c = isAlpha c || isDigit c++-- | Constructs a 'Identifier' value from the given identifier string.+-- It could return 'Nothing' if the given identifier is invalid.+fromText :: T.Text -> Maybe Identifier+fromText text =+    case P.parse rule "" text of+        Right ident -> Just ident+        Left _ -> Nothing+  where+    rule :: Parser Identifier+    rule = do+        identifier' <- identifierRule+        _ <- P.eof+        return identifier'++normalize :: Identifier -> Identifier+normalize (Identifier i) =+    Identifier $ T.map (\c -> if c == '_' then '-' else toLower c) i++toText :: Identifier -> T.Text+toText (Identifier text) = text++toNormalizedText :: Identifier -> T.Text+toNormalizedText = toText . normalize++tokens :: Identifier -> [T.Text]+tokens ident = T.split (== '-') $ toText $ normalize ident++instance Eq Identifier where+    a@(Identifier _) == b@(Identifier _) =+        toNormalizedText a == toNormalizedText b++instance Ord Identifier where+    compare a@(Identifier _) b@(Identifier _) =+        compare (toNormalizedText a) (toNormalizedText b)++instance Construct Identifier where+    toCode ident+        | ident `S.member` reservedKeywords = '`' `T.cons` text `T.snoc` '`'+        | otherwise = text+      where+        text = toText ident++instance IsString Identifier where+    fromString string = fromMaybe (error $ "invalid identifier: " ++ string) $+                                  fromText (T.pack string)++toString :: Identifier -> String+toString = T.unpack . toText++toNormalizedString :: Identifier -> String+toNormalizedString = T.unpack . toNormalizedText++toPascalCaseText :: Identifier -> T.Text+toPascalCaseText identifier =+    T.concat $ fmap makeFirstUpper (tokens identifier)+  where+    makeFirstUpper :: T.Text -> T.Text+    makeFirstUpper t = toUpper (T.head t) `T.cons` T.tail t++toCamelCaseText :: Identifier -> T.Text+toCamelCaseText identifier =+    toLower (T.head pascalCased) `T.cons` T.tail pascalCased+  where+    pascalCased :: T.Text+    pascalCased = toPascalCaseText identifier++toSnakeCaseText :: Identifier -> T.Text+toSnakeCaseText identifier = T.intercalate "_" $ tokens identifier++toLispCaseText :: Identifier -> T.Text+toLispCaseText = toNormalizedText
+ src/Nirum/Constructs/Module.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings, QuasiQuotes  #-}+module Nirum.Constructs.Module ( Module(Module, docs, types)+                               , coreModule+                               , coreModulePath+                               , coreTypes+                               , imports+                               ) where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import Text.InterpolatedString.Perl6 (q)++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Annotation (empty)+import Nirum.Constructs.Declaration (Docs)+import qualified Nirum.Constructs.DeclarationSet as DS+import Nirum.Constructs.Identifier (Identifier)+import Nirum.Constructs.ModulePath (ModulePath)+import Nirum.Constructs.TypeDeclaration ( JsonType(..)+                                        , PrimitiveTypeIdentifier(..)+                                        , Type(..)+                                        , TypeDeclaration(..)+                                        )++data Module = Module { types :: DS.DeclarationSet TypeDeclaration+                     , docs :: Maybe Docs+                     } deriving (Eq, Ord, Show)++instance Construct Module where+    toCode m@(Module types' docs') =+        T.concat [ maybe "" ((`T.snoc` '\n') . toCode) docs'+                 , T.intercalate "\n" importCodes+                 , if null importCodes then "\n" else "\n\n"+                 , T.intercalate "\n\n" typeCodes+                 , "\n"+                 ]+      where+        typeList :: [TypeDeclaration]+        typeList = DS.toList types'+        importCodes :: [T.Text]+        importCodes =+            [ T.concat [ "import ", toCode p, " ("+                       , T.intercalate ", " $ map toCode $ S.toAscList i+                       , ");"+                       ]+            | (p, i) <- M.toAscList (imports m)+            ]+        typeCodes :: [T.Text]+        typeCodes = [ toCode t+                    | t <- typeList+                    , case t of+                          Import {} -> False+                          _ -> True+                    ]++imports :: Module -> M.Map ModulePath (S.Set Identifier)+imports (Module decls _) =+    M.fromListWith S.union [(p, [i]) | Import p i <- DS.toList decls]++coreModulePath :: ModulePath+coreModulePath = ["core"]++coreModule :: Module+coreModule = Module coreTypes $ Just coreDocs++coreTypes :: DS.DeclarationSet TypeDeclaration+coreTypes =+    -- number types+    [ TypeDeclaration "bigint" (PrimitiveType Bigint String) Nothing empty+    , TypeDeclaration "decimal" (PrimitiveType Decimal String) Nothing empty+    , TypeDeclaration "int32" (PrimitiveType Int32 Number) Nothing empty+    , TypeDeclaration "int64" (PrimitiveType Int64 Number) Nothing empty+    , TypeDeclaration "float32" (PrimitiveType Float32 Number) Nothing empty+    , TypeDeclaration "float64" (PrimitiveType Float64 Number) Nothing empty+    -- string types+    , TypeDeclaration "text" (PrimitiveType Text String) Nothing empty+    , TypeDeclaration "binary" (PrimitiveType Binary String) Nothing empty+    -- time types+    , TypeDeclaration+          "date" (PrimitiveType Date String) Nothing empty+    , TypeDeclaration+          "datetime" (PrimitiveType Datetime String) Nothing empty+    -- et cetera+    , TypeDeclaration "bool" (PrimitiveType Bool Boolean) Nothing empty+    , TypeDeclaration "uuid" (PrimitiveType Uuid String) Nothing empty+    , TypeDeclaration "uri" (PrimitiveType Uri String) Nothing empty+    ]++coreDocs :: Docs+coreDocs = [q|+Built-in types+==============++The core module is implicitly imported by every module so that built-in types+are available everywhere.++TBD.++|]
+ src/Nirum/Constructs/ModulePath.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies #-}+module Nirum.Constructs.ModulePath ( ModulePath( ModuleName+                                               , ModulePath+                                               , moduleName+                                               , path+                                               )+                                   , ancestors+                                   , fromFilePath+                                   , fromIdentifiers+                                   ) where++import Data.Char (toLower)+import Data.Maybe (fromMaybe, mapMaybe)+import GHC.Exts (IsList(Item, fromList, toList))++import Data.Set (Set, insert, singleton)+import Data.Text (intercalate, pack)+import System.FilePath (splitDirectories, stripExtension)++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Identifier (Identifier, fromText)++data ModulePath = ModulePath { path :: ModulePath+                             , moduleName :: Identifier }+                | ModuleName { moduleName :: Identifier }+                deriving (Eq, Ord, Show)++instance Construct ModulePath where+    toCode = intercalate "." . map toCode . toList++fromIdentifiers :: [Identifier] -> Maybe ModulePath+fromIdentifiers [] = Nothing+fromIdentifiers [identifier] = Just $ ModuleName identifier+fromIdentifiers identifiers = fmap (`ModulePath` last identifiers) init'+  where+    init' :: Maybe ModulePath+    init' = fromIdentifiers $ init identifiers++fromFilePath :: FilePath -> Maybe ModulePath+fromFilePath filePath =+    if length fileIdentifiers == length paths+    then fromIdentifiers fileIdentifiers+    else Nothing+  where+    replaceLast :: (a -> a) -> [a] -> [a]+    replaceLast _ [] = []+    replaceLast f l = init l ++ [f $ last l]+    paths :: [FilePath]+    paths = replaceLast (fromMaybe "" . stripExtension "nrm" . map toLower)+                        (splitDirectories filePath)+    fileIdentifiers :: [Identifier]+    fileIdentifiers = mapMaybe (fromText . pack) paths++ancestors :: ModulePath -> Set ModulePath+ancestors m@ModuleName {} = singleton m+ancestors m@(ModulePath parent _) = m `insert` ancestors parent++instance IsList ModulePath where+    type Item ModulePath = Identifier+    fromList identifiers =+        fromMaybe (error "ModulePath cannot be empty") +                  (fromIdentifiers identifiers)+    toList (ModuleName identifier) = [identifier]+    toList (ModulePath path' identifier) = toList path' ++ [identifier]
+ src/Nirum/Constructs/Name.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.Name ( Name(Name)+                             , behindName+                             , facialName+                             , isComplex+                             , isSimple+                             , toCode+                             ) where++import Data.String (IsString(fromString))++import Data.Text (append, snoc)++import Nirum.Constructs (Construct)+import Nirum.Constructs.Identifier (Identifier, toCode)++-- | Name consists of a 'facialName' and a 'behindName'.+-- The 'behindName' is for internal coding, while the 'facialName' is for+-- human-readable identifier of programming language bindings.+--+-- If 'behind_Name' is omitted, 'facialName' is used also for+-- 'behindName'.  Explicit 'behindName' is useful to maintain+-- old name for backward compatibility with new 'facialName'.+data Name = Name { facialName :: Identifier+                 , behindName :: Identifier+                 } deriving (Eq, Ord, Show)++isSimple :: Name -> Bool+isSimple (Name f b) = f == b++isComplex :: Name -> Bool+isComplex = not . isSimple++instance Construct Name where+    toCode name@(Name facial behind)+        | isSimple name = toCode facial+        | otherwise = (toCode facial `snoc` '/') `append` toCode behind++instance IsString Name where+    fromString s =+        Name { facialName = identifier, behindName = identifier }+      where+        identifier :: Identifier+        identifier = fromString s
+ src/Nirum/Constructs/Service.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.Service ( Method ( Method+                                         , methodAnnotations+                                         , methodDocs+                                         , methodName+                                         , parameters+                                         , returnType+                                         )+                                , Parameter(Parameter)+                                , Service(Service, methods)+                                ) where++import qualified Data.Text as T++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Annotation (AnnotationSet)+import Nirum.Constructs.Declaration ( Declaration(name, docs)+                                    , Docs+                                    , toCodeWithPrefix+                                    )+import Nirum.Constructs.DeclarationSet (DeclarationSet, toList)+import Nirum.Constructs.Name (Name)+import Nirum.Constructs.TypeExpression (TypeExpression)++-- | 'Method' parameter.+data Parameter = Parameter Name TypeExpression (Maybe Docs)+                 deriving (Eq, Ord, Show)++instance Construct Parameter where+    toCode (Parameter name' typeExpr docs') =+        T.concat [ toCode typeExpr+                 , " "+                 , toCode name'+                 , ","+                 , toCodeWithPrefix "\n" docs'+                 ]++instance Declaration Parameter where+    name (Parameter name' _ _) = name'+    docs (Parameter _ _ docs') = docs'++-- | 'Service' method.+data Method = Method { methodName :: Name+                     , parameters :: DeclarationSet Parameter+                     , returnType :: TypeExpression+                     , errorType  :: Maybe TypeExpression+                     , methodDocs :: Maybe Docs+                     , methodAnnotations :: AnnotationSet+                     } deriving (Eq, Ord, Show)++instance Construct Method where+    toCode method@Method { parameters = params+                         , errorType = error'+                         , methodDocs = docs'+                         , methodAnnotations = annotationSet'+                         } =+        T.concat $ [ toCode annotationSet'+                   , toCode $ returnType method+                   , " "+                   , toCode $ methodName method+                   , " ("+                   , toCodeWithPrefix "\n  " docs'+                   ] ++ case (docs', params') of+                            (Nothing, []) -> []+                            (Just _, []) -> ["\n"]+                            (Nothing, [p@(Parameter _ _ Nothing)]) ->+                                [T.dropWhileEnd (== ',') $ toCode p]+                            _ -> [ "\n"+                                 , T.intercalate "\n" $ map indentedCode params'+                                 , "\n"+                                 ]+                   ++ [")"]+                   ++ case error' of+                          Nothing -> []+                          Just e -> [" throws ", toCode e]+                   ++ [","]+      where+        params' :: [Parameter]+        params' = toList params+        indentedCode :: Construct a => a -> T.Text+        indentedCode c = T.concat [ "  "+                                  , T.intercalate "\n  " $ T.lines (toCode c)+                                  ]++instance Declaration Method where+    name = methodName+    docs = methodDocs++-- | RPC service.+data Service =+    Service { methods :: DeclarationSet Method } deriving (Eq, Ord, Show)
+ src/Nirum/Constructs/TypeDeclaration.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember)+                                        , Field(Field)+                                        , JsonType(..)+                                        , PrimitiveTypeIdentifier(..)+                                        , Tag(Tag)+                                        , Type(..)+                                        , TypeDeclaration( Import+                                                         , ServiceDeclaration+                                                         , TypeDeclaration+                                                         , importName+                                                         , modulePath+                                                         , service+                                                         , serviceAnnotations+                                                         , serviceDocs+                                                         , serviceName+                                                         , type'+                                                         , typeAnnotations+                                                         , typeDocs+                                                         , typename+                                                         )+                                        ) where++import Data.Maybe (isJust)+import Data.String (IsString(fromString))++import qualified Data.Text as T++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Annotation (AnnotationSet)+import Nirum.Constructs.Declaration ( Declaration (..)+                                    , Docs (..)+                                    , toCodeWithPrefix+                                    )+import Nirum.Constructs.DeclarationSet (DeclarationSet, null', toList)+import Nirum.Constructs.Identifier (Identifier)+import Nirum.Constructs.ModulePath (ModulePath)+import Nirum.Constructs.Name (Name(Name))+import Nirum.Constructs.Service ( Method (Method, methodDocs)+                                , Service (Service)+                                )+import Nirum.Constructs.TypeExpression (TypeExpression)++data Type+    = Alias { canonicalType :: TypeExpression }+    | BoxedType { innerType :: TypeExpression }+    | EnumType { members :: DeclarationSet EnumMember }+    | RecordType { fields :: DeclarationSet Field }+    | UnionType { tags :: DeclarationSet Tag }+    | PrimitiveType { primitiveTypeIdentifier :: PrimitiveTypeIdentifier+                    , jsonType :: JsonType+                    }+    deriving (Eq, Ord, Show)++-- | Member of 'EnumType'.+data EnumMember = EnumMember Name (Maybe Docs) deriving (Eq, Ord, Show)++instance Construct EnumMember where+    toCode (EnumMember name' docs') = T.concat [ toCode name'+                                               , toCodeWithPrefix "\n" docs'+                                               ]++instance Declaration EnumMember where+    name (EnumMember name' _) = name'+    docs (EnumMember _ docs') = docs'++instance IsString EnumMember where+    fromString s = EnumMember (fromString s) Nothing++-- | Field of 'RecordType' and 'Tag'.+data Field = Field Name TypeExpression (Maybe Docs) deriving (Eq, Ord, Show)++instance Construct Field where+    toCode (Field name' typeExpr docs') = T.concat [ toCode typeExpr+                                                   , " "+                                                   , toCode name'+                                                   , ","+                                                   , toCodeWithPrefix "\n" docs'+                                                   ]++instance Declaration Field where+    name (Field name' _ _) = name'+    docs (Field _ _ docs') = docs'++-- | Tag of 'UnionType'.+data Tag = Tag Name (DeclarationSet Field) (Maybe Docs) deriving (Eq, Ord, Show)++instance Construct Tag where+    toCode (Tag name' fields' docs') =+        if null' fields'+        then T.concat [toCode name', toCodeWithPrefix "\n" docs']+        else T.concat [ toCode name'+                      , " (", fieldsCode, ")"+                      , toCodeWithPrefix "\n" docs'+                      ]+      where+        fieldsCode = T.intercalate " " $ map toCode $ toList fields'++instance Declaration Tag where+    name (Tag name' _ _) = name'+    docs (Tag _ _ docs') = docs'++-- | Primitive type identifiers.+data PrimitiveTypeIdentifier+    = Bigint | Decimal | Int32 | Int64 | Float32 | Float64 | Text | Binary+    | Date | Datetime | Bool | Uuid | Uri+    deriving (Eq, Ord, Show)++-- | Possible coded types of 'PrimitiveType' in JSON representation.+data JsonType = Boolean | Number | String deriving (Eq, Ord, Show)++-- Top-level 'Declaration' of type.+data TypeDeclaration+    = TypeDeclaration { typename :: Name+                      , type' :: Type+                      , typeDocs :: Maybe Docs+                      , typeAnnotations :: AnnotationSet+                      }+    | ServiceDeclaration { serviceName :: Name+                         , service :: Service+                         , serviceDocs :: Maybe Docs+                         , serviceAnnotations :: AnnotationSet+                         }+    | Import { modulePath :: ModulePath+             , importName :: Identifier+             }+    deriving (Eq, Ord, Show)++instance Construct TypeDeclaration where+    toCode (TypeDeclaration name' (Alias cname) docs' annotationSet') =+        T.concat [ toCode annotationSet'+                 , "type ", toCode name'+                 , " = ", toCode cname, ";"+                 , toCodeWithPrefix "\n" docs'+                 ]+    toCode (TypeDeclaration name' (BoxedType itype) docs' annotationSet') =+        T.concat [ toCode annotationSet'+                 , "boxed ", toCode name'+                 , " (", toCode itype, ");"+                 , toCodeWithPrefix "\n" docs']+    toCode (TypeDeclaration name' (EnumType members') docs' annotationSet') =+        T.concat [ toCode annotationSet'+                 , "enum ", toCode name'+                 , toCodeWithPrefix "\n    " docs'+                 , "\n    = ", T.replace "\n" "\n    " membersCode, "\n    ;"+                 ]+      where+        membersCode = T.intercalate "\n| " $ map toCode $ toList members'+    toCode (TypeDeclaration name' (RecordType fields') docs' annotationSet') =+        T.concat [ toCode annotationSet'+                 , "record ", toCode name', " ("+                 , toCodeWithPrefix "\n    " docs'+                 , if isJust docs' then "\n" else ""+                 , T.replace "\n" "\n    " $ T.cons '\n' fieldsCode+                 , "\n);"+                 ]+      where+        fieldsCode = T.intercalate "\n" $ map toCode $ toList fields'+    toCode (TypeDeclaration name' (UnionType tags') docs' annotationSet') =+        T.concat [ toCode annotationSet'+                 , "union ", nameCode+                 , toCodeWithPrefix "\n    " docs'+                 , "\n    = " , tagsCode+                 , "\n    ;"+                 ]+      where+        nameCode :: T.Text+        nameCode = toCode name'+        tagsCode :: T.Text+        tagsCode = T.intercalate "\n    | "+                                 [ T.replace "\n" "\n    " (toCode t)+                                 | t <- toList tags'+                                 ]+    toCode (TypeDeclaration name'+                            (PrimitiveType typename' jsonType')+                            docs'+                            annotationSet') =+        T.concat [ toCode annotationSet'+                 , "// primitive type `", toCode name', "`\n"+                 , "//     internal type identifier: ", showT typename', "\n"+                 , "//     coded to json ", showT jsonType', " type\n"+                 , docString docs'+                 ]+      where+        showT :: Show a => a -> T.Text+        showT = T.pack . show+        docString :: Maybe Docs -> T.Text+        docString Nothing = ""+        docString (Just (Docs d)) =+            T.concat ["\n// ", T.replace "\n" "\n// " $ T.stripEnd d, "\n"]+    toCode (ServiceDeclaration name' (Service methods) docs' annotations') =+        T.concat [ toCode annotations'+                 , "service "+                 , toCode name'+                 , " ("+                 , toCodeWithPrefix "\n    " docs'+                 , case (docs', methods') of+                      (_, []) -> ""+                      (Nothing, [Method { methodDocs = Nothing }]) -> ""+                      _ -> "\n    "+                 , if length methods' > 1+                   then methodsText+                   else T.dropWhileEnd (== ',') (T.strip methodsText)+                 , case docs' of+                       Nothing -> ""+                       Just _ -> "\n"+                 , ");"+                 ]+      where+        methods' :: [Method]+        methods' = toList methods+        methodsText :: T.Text+        methodsText = T.intercalate "\n" $ map toCode methods'+    toCode (Import path ident) = T.concat [ "import "+                                          , toCode path+                                          , " ("+                                          , toCode ident+                                          , ");\n"+                                          ]++instance Declaration TypeDeclaration where+    name (TypeDeclaration name' _ _ _) = name'+    name (ServiceDeclaration name' _ _ _) = name'+    name (Import _ identifier) = Name identifier identifier+    docs (TypeDeclaration _ _ docs' _) = docs'+    docs (ServiceDeclaration _ _ docs' _) = docs'+    docs (Import _ _) = Nothing
+ src/Nirum/Constructs/TypeExpression.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.TypeExpression (TypeExpression(..), toCode) where++import Data.String (IsString(fromString))++import qualified Data.Text as T++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Identifier (Identifier)++-- | Refers a type.+data TypeExpression+    = TypeIdentifier { identifier :: Identifier }+    | OptionModifier { type' :: TypeExpression }+    | SetModifier { elementType :: TypeExpression }+    | ListModifier { elementType :: TypeExpression }+    | MapModifier { keyType :: TypeExpression+                  , valueType :: TypeExpression+                  }+    deriving (Eq, Ord, Show)++instance Construct TypeExpression where+    toCode (TypeIdentifier id') = toCode id'+    toCode (OptionModifier type_) = toCode type_ `T.snoc` '?'+    toCode (SetModifier element) =+        '{' `T.cons` toCode element `T.snoc` '}'+    toCode (ListModifier element) =+        '[' `T.cons` toCode element `T.snoc` ']'+    toCode (MapModifier key value) =+        T.concat ["{", toCode key, ": ", toCode value, "}"]++instance IsString TypeExpression where+    fromString string = TypeIdentifier (fromString string :: Identifier)
+ src/Nirum/Package.hs view
@@ -0,0 +1,209 @@+module Nirum.Package ( BoundModule(boundPackage, modulePath)+                     , ImportError ( CircularImportError+                                   , MissingImportError+                                   , MissingModulePathError+                                   )+                     , Package(modules)+                     , PackageError(ImportError, ParseError, ScanError)+                     , TypeLookup(Imported, Local, Missing)+                     , docs+                     , findInBoundModule+                     , lookupType+                     , makePackage+                     , resolveBoundModule+                     , resolveModule+                     , scanModules+                     , scanPackage+                     , types+                     ) where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import System.Directory (doesDirectoryExist, listDirectory)+import System.FilePath ((</>))++import Nirum.Constructs.Declaration (Docs)+import qualified Nirum.Constructs.DeclarationSet as DS+import Nirum.Constructs.Identifier (Identifier)+import qualified Nirum.Constructs.Module as Mod+import Nirum.Constructs.ModulePath (ModulePath, fromFilePath)+import Nirum.Constructs.TypeDeclaration ( Type+                                        , TypeDeclaration ( Import+                                                          , ServiceDeclaration+                                                          , TypeDeclaration+                                                          , type'+                                                          )+                                        )+import Nirum.Parser (ParseError, parseFile)++-- | Represents a package which consists of modules.+data Package = Package { modules :: M.Map ModulePath Mod.Module+                       } deriving (Eq, Ord, Show)+-- TODO: uri, version, dependencies++data ImportError = CircularImportError [ModulePath]+                 | MissingModulePathError ModulePath ModulePath+                 | MissingImportError ModulePath ModulePath Identifier+                 deriving (Eq, Ord, Show)++makePackage :: M.Map ModulePath Mod.Module -> Either (S.Set ImportError) Package+makePackage modules'+    | S.null importErrors = Right package+    | otherwise = Left importErrors+  where+    package :: Package+    package = Package modules'+    importErrors :: S.Set ImportError+    importErrors = detectImportErrors package++resolveModule :: ModulePath -> Package -> Maybe Mod.Module+resolveModule path Package { modules = ms } = M.lookup path ms++resolveBoundModule :: ModulePath -> Package -> Maybe BoundModule+resolveBoundModule path package =+    case resolveModule path package of+        Just _ -> Just $ BoundModule package path+        Nothing -> Nothing++detectImportErrors :: Package -> S.Set ImportError+detectImportErrors package = detectMissingImports package `S.union`+                             detectCircularImports package++detectMissingImports :: Package -> S.Set ImportError+detectMissingImports package@Package { modules = ms } =+    S.fromList [e | (path, module') <- M.toList ms, e <- detect path module']+  where+    detect :: ModulePath -> Mod.Module -> [ImportError]+    detect path module' =+        [ e+        | (path', idents) <- M.toList (Mod.imports module')+        , e <- case resolveModule path' package of+                Nothing -> [MissingModulePathError path path']+                Just (Mod.Module decls _) ->+                    [ e+                    | i <- S.toList idents+                    , e <- case DS.lookup i decls of+                        Just TypeDeclaration {} -> []+                        Just ServiceDeclaration {} -> []+                        Just Import {} -> [MissingImportError path path' i]+                        Nothing -> [MissingImportError path path' i]+                    ]+        ]++detectCircularImports :: Package -> S.Set ImportError+detectCircularImports Package { modules = ms } =+    S.fromList [e | path <- M.keys ms, e <- detect path []]+  where+    moduleImports :: M.Map ModulePath (S.Set ModulePath)+    moduleImports =+        M.fromList [ (path, M.keysSet $ Mod.imports module')+                   | (path, module') <- M.toList ms+                   ]+    detect :: ModulePath -> [ModulePath] -> [ImportError]+    detect path reversedCycle+        | path `elem` reversedCycle =+            [CircularImportError $ reverse reversedCycle']+        | otherwise =+            case M.lookup path moduleImports of+                Just paths -> [ e+                              | path' <- S.toList paths+                              , e <- detect path' reversedCycle'+                              ]+                Nothing -> []+      where+        reversedCycle' :: [ModulePath]+        reversedCycle' = path : reversedCycle++data PackageError = ScanError FilePath IOError+                  | ParseError ModulePath ParseError+                  | ImportError (S.Set ImportError)+                  deriving (Eq, Show)++-- | Scan the given package path, and then return the read package.+scanPackage :: FilePath -> IO (Either PackageError Package)+scanPackage packagePath = do+    modulePaths <- scanModules packagePath+    -- FIXME: catch IO errors+    modules' <- mapM parseFile modulePaths+    return $ case M.foldrWithKey excludeFailedParse (Right M.empty) modules' of+        Right parsedModules -> case makePackage parsedModules of+            Right p -> Right p+            Left errors -> Left $ ImportError errors+        Left error' -> Left error'+  where+    excludeFailedParse :: ModulePath+                       -> Either ParseError Mod.Module+                       -> Either PackageError (M.Map ModulePath Mod.Module)+                       -> Either PackageError (M.Map ModulePath Mod.Module)+    excludeFailedParse _ _ (Left error') = Left error'+    excludeFailedParse path (Left error') _ = Left $ ParseError path error'+    excludeFailedParse path (Right module') (Right map') =+        Right (M.insert path module' map')++-- | Scan the given path recursively, and then return the map of+-- detected module paths.+scanModules :: FilePath -> IO (M.Map ModulePath FilePath)+scanModules packagePath = do+    files <- scanFiles ""+    return $ M.fromList files+  where+    isNotHidden :: FilePath -> Bool+    isNotHidden ('.':_) = False+    isNotHidden _ = True+    scanFiles :: FilePath -> IO [(ModulePath, FilePath)]+    scanFiles path = do+        dir <- doesDirectoryExist realPath+        if dir+        then do+            subpaths <- listDirectory realPath+            scans <- mapM (scanFiles . (path </>)) $ filter isNotHidden subpaths+            return $ concat scans+        else return $ case fromFilePath path of+                          Just modulePath' -> [(modulePath', realPath)]+                          Nothing -> []+      where+        realPath :: FilePath+        realPath = case path of+                       [] -> packagePath+                       p -> packagePath </> p++data BoundModule = BoundModule { boundPackage :: Package+                               , modulePath :: ModulePath+                               } deriving (Eq, Ord, Show)++findInBoundModule :: (Mod.Module -> a) -> a -> BoundModule -> a+findInBoundModule valueWhenExist valueWhenNotExist+                  BoundModule { boundPackage = Package { modules = ms }+                              , modulePath = path+                              } =+    case M.lookup path ms of+        Nothing -> valueWhenNotExist+        Just mod' -> valueWhenExist mod'++types :: BoundModule -> DS.DeclarationSet TypeDeclaration+types = findInBoundModule Mod.types DS.empty++docs :: BoundModule -> Maybe Docs+docs = findInBoundModule Mod.docs Nothing++data TypeLookup = Missing+                | Local Type+                | Imported ModulePath Type+                deriving (Eq, Ord, Show)++lookupType :: Identifier -> BoundModule -> TypeLookup+lookupType identifier boundModule =+    case DS.lookup identifier (types boundModule) of+        Nothing -> toType Mod.coreModulePath+            (DS.lookup identifier $ Mod.types Mod.coreModule)+        Just TypeDeclaration { type' = t } -> Local t+        Just (Import path _) ->+            case resolveModule path (boundPackage boundModule) of+                Nothing -> Missing+                Just (Mod.Module decls _) ->+                    toType path (DS.lookup identifier decls)+        Just ServiceDeclaration {} -> Missing+  where+    toType :: ModulePath -> Maybe TypeDeclaration -> TypeLookup+    toType mp (Just TypeDeclaration { type' = t }) = Imported mp t+    toType _ _ = Missing
+ src/Nirum/Parser.hs view
@@ -0,0 +1,567 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Nirum.Parser ( Parser+                    , ParseError+                    , aliasTypeDeclaration+                    , annotation+                    , annotationSet+                    , boxedTypeDeclaration+                    , docs+                    , enumTypeDeclaration+                    , file+                    , handleNameDuplication+                    , identifier+                    , imports+                    , listModifier+                    , mapModifier+                    , method+                    , module'+                    , modulePath+                    , name+                    , optionModifier+                    , parse+                    , parseFile+                    , recordTypeDeclaration+                    , serviceDeclaration+                    , setModifier+                    , typeDeclaration+                    , typeExpression+                    , typeExpressionWithoutOptionModifier+                    , typeIdentifier+                    , unionTypeDeclaration+                    ) where++import Control.Applicative ((<$>))+import Control.Monad (join, void)+import Data.List (foldl1')+import Prelude hiding (readFile)++import Data.Set (elems)+import qualified Data.Text as T+import Data.Text.IO (readFile)+import Text.Megaparsec ( Token+                       , eof+                       , many+                       , manyTill+                       , notFollowedBy+                       , option+                       , optional+                       , runParser+                       , sepBy1+                       , sepEndBy+                       , sepEndBy1+                       , skipMany+                       , skipSome+                       , try+                       , (<|>)+                       , (<?>)+                       )+import Text.Megaparsec.Char ( char+                            , eol+                            , noneOf+                            , spaceChar+                            , string+                            , string'+                            )+import qualified Text.Megaparsec.Error as E+import Text.Megaparsec.Text (Parser)+import Text.Megaparsec.Lexer (charLiteral)++import qualified Nirum.Constructs.Annotation as A+import Nirum.Constructs.Declaration (Declaration, Docs(Docs))+import Nirum.Constructs.DeclarationSet ( DeclarationSet+                                       , NameDuplication( BehindNameDuplication+                                                        , FacialNameDuplication+                                                        )+                                       , empty+                                       , fromList+                                       )+import Nirum.Constructs.Identifier ( Identifier+                                   , identifierRule+                                   , reservedKeywords+                                   , toString+                                   )+import Nirum.Constructs.Module (Module(Module))+import Nirum.Constructs.ModulePath (ModulePath(ModulePath, ModuleName))+import Nirum.Constructs.Name (Name(Name))+import Nirum.Constructs.Service ( Method(Method)+                                , Parameter(Parameter)+                                , Service(Service)+                                )+import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember)+                                        , Field(Field)+                                        , Tag(Tag)+                                        , Type( Alias+                                              , BoxedType+                                              , EnumType+                                              , RecordType+                                              , UnionType+                                              )+                                        , TypeDeclaration( Import+                                                         , ServiceDeclaration+                                                         , TypeDeclaration+                                                         )+                                        )+import Nirum.Constructs.TypeExpression ( TypeExpression( ListModifier+                                                       , MapModifier+                                                       , OptionModifier+                                                       , SetModifier+                                                       , TypeIdentifier+                                                       )+                                       )++type ParseError = E.ParseError (Token T.Text) E.Dec++comment :: Parser ()+comment = string "//" >> void (many $ noneOf ("\n" :: String)) <?> "comment"++spaces :: Parser ()+spaces = skipMany $ void spaceChar <|> comment++spaces1 :: Parser ()+spaces1 = skipSome $ void spaceChar <|> comment++identifier :: Parser Identifier+identifier =+    quotedIdentifier <|> bareIdentifier <?> "identifier"+  where+    keywords :: Parser String+    keywords = foldl1' (<|>) $ map (string' . toString) $ elems reservedKeywords+    bareIdentifier :: Parser Identifier+    bareIdentifier = do+        notFollowedBy keywords+        identifierRule+    quotedIdentifier :: Parser Identifier+    quotedIdentifier = do+        char '`'+        identifier' <- identifierRule+        char '`'+        return identifier'++name :: Parser Name+name = do+    facialName <- identifier <?> "facial name"+    behindName <- option facialName $ try $ do+        spaces+        char '/'+        spaces+        identifier <?> "behind name"+    return $ Name facialName behindName++annotation :: Parser A.Annotation+annotation = do+    char '@'+    spaces+    name' <- identifier+    spaces+    metadata <- optional $ do+        char '('+        spaces+        m <- optional ((char '"' >> manyTill charLiteral (char '"'))+                       <?> "annotation metadata")+        spaces+        char ')'+        return m+    let metadata' = T.pack <$> join metadata+    return $ A.Annotation name' metadata'++annotationSet :: Parser A.AnnotationSet+annotationSet = do+    annotations <- many $ do+        spaces+        a <- annotation+        spaces+        return a+    case A.fromList annotations of+        Right annotations' -> return annotations'+        Left (A.AnnotationNameDuplication _) -> fail "annotation name duplicate"++typeExpression :: Parser TypeExpression+typeExpression =+    try optionModifier <|> typeExpressionWithoutOptionModifier+                       <?> "type expression"++typeExpressionWithoutOptionModifier :: Parser TypeExpression+typeExpressionWithoutOptionModifier =+    try setModifier <|> listModifier <|> mapModifier <|> typeIdentifier++typeIdentifier :: Parser TypeExpression+typeIdentifier = do+    typeIdentifier' <- identifier <?> "type identifier"+    return $ TypeIdentifier typeIdentifier'++optionModifier :: Parser TypeExpression+optionModifier = do+    expr <- typeExpressionWithoutOptionModifier+    spaces+    char '?'+    return $ OptionModifier expr++setModifier :: Parser TypeExpression+setModifier = do+    char '{'+    spaces+    expr <- typeExpression <?> "element type of set type"+    spaces+    char '}'+    return $ SetModifier expr++listModifier :: Parser TypeExpression+listModifier = do+    char '['+    spaces+    expr <- typeExpression <?> "element type of list type"+    spaces+    char ']'+    return $ ListModifier expr++mapModifier :: Parser TypeExpression+mapModifier = do+    char '{'+    spaces+    key <- typeExpression <?> "key type of map type"+    spaces+    char ':'+    spaces+    value <- typeExpression <?> "value type of map type"+    spaces+    char '}'+    return $ MapModifier key value++docs :: Parser Docs+docs = do+    comments <- sepEndBy1 (do { char '#'+                              ; void $ optional $ char ' '+                              ; line <- many $ noneOf ("\r\n" :: String)+                              ; return $ T.pack line+                              }) (eol >> spaces) <?> "comments"+    return $ Docs $ T.unlines comments++aliasTypeDeclaration :: Parser TypeDeclaration+aliasTypeDeclaration = do+    annotationSet' <- annotationSet <?> "type alias annotations"+    string' "type" <?> "type alias keyword"+    spaces+    typename <- identifier <?> "alias type name"+    let name' = Name typename typename+    spaces+    char '='+    spaces+    canonicalType <- typeExpression <?> "canonical type of alias"+    spaces+    char ';'+    docs' <- optional $ try $ spaces >> (docs <?> "type alias docs")+    return $ TypeDeclaration name' (Alias canonicalType) docs' annotationSet'+++boxedTypeDeclaration :: Parser TypeDeclaration+boxedTypeDeclaration = do+    annotationSet' <- annotationSet <?> "boxed type annotations"+    string' "boxed" <?> "boxed type keyword"+    spaces+    typename <- identifier <?> "boxed type name"+    let name' = Name typename typename+    spaces+    char '('+    spaces+    innerType <- typeExpression <?> "inner type of boxed type"+    spaces+    char ')'+    spaces+    char ';'+    docs' <- optional $ try $ spaces >> (docs <?> "boxed type docs")+    return $ TypeDeclaration name' (BoxedType innerType) docs' annotationSet'++enumMember :: Parser EnumMember+enumMember = do+    memberName <- name <?> "enum member name"+    spaces+    docs' <- optional $ do+        d <- docs <?> "enum member docs"+        spaces+        return d+    return $ EnumMember memberName docs'++handleNameDuplication :: Declaration a+                      => String -> [a]+                      -> (DeclarationSet a -> Parser b)+                      -> Parser b+handleNameDuplication label declarations cont =+    case fromList declarations of+        Left (BehindNameDuplication (Name _ bname)) ->+            fail ("the behind " ++ label ++ " name `" ++ toString bname +++                  "` is duplicated")+        Left (FacialNameDuplication (Name fname _)) ->+            fail ("the facial " ++ label ++ " name `" ++ toString fname +++                  "` is duplicated")+        Right set -> cont set++enumTypeDeclaration :: Parser TypeDeclaration+enumTypeDeclaration = do+    annotationSet' <- annotationSet <?> "enum type annotations"+    string "enum" <?> "enum keyword"+    spaces+    typename <- name <?> "enum type name"+    spaces+    frontDocs <- optional $ do+        d <- docs <?> "enum type docs"+        spaces+        return d+    char '='+    spaces+    docs' <- case frontDocs of+        d@(Just _) -> return d+        Nothing -> optional $ do+            d <- docs <?> "enum type docs"+            spaces+            return d+    members <- (enumMember `sepBy1` (spaces >> char '|' >> spaces))+                   <?> "enum members"+    case fromList members of+        Left (BehindNameDuplication (Name _ bname)) ->+            fail ("the behind member name `" ++ toString bname +++                  "` is duplicated")+        Left (FacialNameDuplication (Name fname _)) ->+            fail ("the facial member name `" ++ toString fname +++                  "` is duplicated")+        Right memberSet -> do+            spaces+            char ';'+            return $ TypeDeclaration typename (EnumType memberSet)+                                     docs' annotationSet'++fieldsOrParameters :: forall a. (String, String)+                   -> (Name -> TypeExpression -> Maybe Docs -> a)+                   -> Parser [a]+fieldsOrParameters (label, pluralLabel) make = do+    type' <- typeExpression <?> (label ++ " type")+    spaces1+    name' <- name <?> (label ++ " name")+    spaces+    let makeWithDocs = make name' type'+    followedByComma makeWithDocs <|> do+        d <- optional docs' <?> (label ++ " docs")+        return [makeWithDocs d]+  where+    recur :: Parser [a]+    recur = fieldsOrParameters (label, pluralLabel) make+    followedByComma :: (Maybe Docs -> a) -> Parser [a]+    followedByComma makeWithDocs = do+        char ','+        spaces+        d <- optional docs' <?> (label ++ " docs")+        rest <- option [] recur <?> ("rest of " ++ pluralLabel)+        return $ makeWithDocs d : rest+    docs' :: Parser Docs+    docs' = do+        d <- docs <?> (label ++ " docs")+        spaces+        return d++fields :: Parser [Field]+fields = fieldsOrParameters ("label", "labels") Field++fieldSet :: Parser (DeclarationSet Field)+fieldSet = do+    fields' <- fields <?> "fields"+    handleNameDuplication "field" fields' return++recordTypeDeclaration :: Parser TypeDeclaration+recordTypeDeclaration = do+    annotationSet' <- annotationSet <?> "record type annotations"+    string "record" <?> "record keyword"+    spaces+    typename <- name <?> "record type name"+    spaces+    char '('+    spaces+    docs' <- optional $ do+        d <- docs <?> "record type docs"+        spaces+        return d+    fields' <- fieldSet <?> "record fields"+    spaces+    char ')'+    spaces+    char ';'+    return $ TypeDeclaration typename (RecordType fields') docs' annotationSet'++tag :: Parser Tag+tag = do+    tagName <- name <?> "union tag name"+    spaces+    paren <- optional $ char '('+    fields' <- case paren of+        Just _ -> do { f <- fieldSet <?> "union tag fields"+                     ; char ')'+                     ; return f+                     }+        Nothing -> return empty+    docs' <- optional $ do+        d <- docs <?> "union tag docs"+        spaces+        return d+    return $ Tag tagName fields' docs'++unionTypeDeclaration :: Parser TypeDeclaration+unionTypeDeclaration = do+    annotationSet' <- annotationSet <?> "union type annotations"+    string "union" <?> "union keyword"+    spaces+    typename <- name <?> "union type name"+    spaces+    docs' <- optional $ do+        d <- docs <?> "union type docs"+        spaces+        return d+    char '='+    spaces+    tags' <- (tag `sepBy1` try (spaces >> char '|' >> spaces))+             <?> "union tags"+    spaces+    char ';'+    handleNameDuplication "tag" tags' $ \tagSet ->+        return $ TypeDeclaration typename (UnionType tagSet) docs' annotationSet'++typeDeclaration :: Parser TypeDeclaration+typeDeclaration =+    ( try aliasTypeDeclaration <|>+      try boxedTypeDeclaration <|>+      try enumTypeDeclaration <|>+      try recordTypeDeclaration <|>+      unionTypeDeclaration+    ) <?> "type declaration (e.g. boxed, enum, record, union)"++parameters :: Parser [Parameter]+parameters = fieldsOrParameters ("parameter", "parameters") Parameter++parameterSet :: Parser (DeclarationSet Parameter)+parameterSet = option empty $ try $ do+    params <- parameters <?> "method parameters"+    handleNameDuplication "parameter" params return++method :: Parser Method+method = do+    annotationSet' <- annotationSet <?> "service method annotation"+    returnType <- typeExpression <?> "method return type"+    spaces1+    methodName <- name <?> "method name"+    spaces+    char '('+    spaces+    docs' <- optional $ do+        d <- docs <?> "method docs"+        spaces+        return d+    params <- parameterSet+    spaces+    char ')'+    spaces+    errorType <- optional $ do+        string "throws" <?> "throws keyword"+        spaces+        e <- typeExpression <?> "method error type"+        spaces+        return e+    return $ Method methodName params returnType errorType docs' annotationSet'++methods :: Parser [Method]+methods = method `sepEndBy` try (spaces >> char ',' >> spaces)++methodSet :: Parser (DeclarationSet Method)+methodSet = do+    methods' <- methods <?> "service methods"+    handleNameDuplication "method" methods' return++serviceDeclaration :: Parser TypeDeclaration+serviceDeclaration = do+    annotationSet' <- annotationSet <?> "service annotation"+    string "service" <?> "service keyword"+    spaces+    serviceName <- name <?> "service name"+    spaces+    char '('+    spaces+    docs' <- optional $ do+        d <- docs <?> "service docs"+        spaces+        return d+    methods' <- methodSet <?> "service methods"+    spaces+    char ')'+    spaces+    char ';'+    return $ ServiceDeclaration serviceName (Service methods')+                                docs' annotationSet'++modulePath :: Parser ModulePath+modulePath = do+    idents <- sepBy1 (identifier <?> "module identifier")+                     (try (spaces >> char '.' >> spaces))+              <?> "module path"+    case makePath idents of+        Nothing -> fail "module path cannot be empty"+        Just path -> return path+  where+    makePath :: [Identifier] -> Maybe ModulePath+    makePath = foldl f Nothing+    f :: Maybe ModulePath -> Identifier -> Maybe ModulePath+    f Nothing i = Just $ ModuleName i+    f (Just p) i = Just $ ModulePath p i++imports :: Parser [TypeDeclaration]+imports = do+    string' "import" <?> "import keyword"+    spaces+    path <- modulePath <?> "module path"+    spaces+    char '('+    spaces+    idents <- sepBy1 (identifier <?> "name to import")+                     (spaces >> char ',' >> spaces)+              <?> "names to import"+    spaces+    char ')'+    spaces+    char ';'+    return [Import path ident | ident <- idents]+++module' :: Parser Module+module' = do+    spaces+    docs' <- optional $ do+        d <- docs <?> "module docs"+        spaces+        return d+    spaces+    importLists <- many $ do+        importList <- imports+        spaces+        return importList+    types <- many $ do+        typeDecl <- try typeDeclaration <|>+                    (serviceDeclaration <?> "service declaration")+        spaces+        return typeDecl+    handleNameDuplication "type" (types ++ [i | l <- importLists, i <- l]) $+                          \typeSet -> return $ Module typeSet docs'++file :: Parser Module+file = do+    mod' <- module'+    eof+    return mod'++parse :: FilePath -- | Source path (although it's only used for error message)+      -> T.Text   -- | Input source code+      -> Either ParseError Module+parse = runParser file++parseFile :: FilePath -- | Source path+          -> IO (Either ParseError Module)+parseFile path = do+    code <- readFile path+    return $ runParser file path code++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
+ src/Nirum/Targets/Python.hs view
@@ -0,0 +1,751 @@+{-# LANGUAGE ExtendedDefaultRules, OverloadedLists, OverloadedStrings,+             QuasiQuotes #-}+module Nirum.Targets.Python ( Code+                            , CodeGen( code+                                     , localImports+                                     , standardImports+                                     , thirdPartyImports+                                     )+                            , CompileError+                            , InstallRequires ( InstallRequires+                                              , dependencies+                                              , optionalDependencies+                                              )+                            , Source( Source+                                    , sourceModule+                                    , sourcePackage+                                    )+                            , addDependency+                            , addOptionalDependency+                            , compileError+                            , compileModule+                            , compilePackage+                            , compilePrimitiveType+                            , compileTypeDeclaration+                            , compileTypeExpression+                            , hasError+                            , toAttributeName+                            , toClassName+                            , toImportPath+                            , toNamePair+                            , unionInstallRequires+                            , withLocalImport+                            , withStandardImport+                            , withThirdPartyImports+                            ) where++import qualified Data.List as L+import Data.Maybe (fromMaybe)+import GHC.Exts (IsList(toList))++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import System.FilePath (joinPath)+import Text.InterpolatedString.Perl6 (qq)++import qualified Nirum.Constructs.DeclarationSet as DS+import Nirum.Constructs.Identifier ( Identifier+                                   , toPascalCaseText+                                   , toSnakeCaseText+                                   , toString+                                   )+import Nirum.Constructs.ModulePath (ModulePath, ancestors)+import Nirum.Constructs.Name (Name(Name))+import qualified Nirum.Constructs.Name as N+import Nirum.Constructs.Service ( Method(Method, methodName)+                                , Parameter(Parameter)+                                , Service(Service)+                                )+import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember)+                                        , Field(Field)+                                        , PrimitiveTypeIdentifier(..)+                                        , Tag(Tag)+                                        , Type( Alias+                                              , BoxedType+                                              , EnumType+                                              , PrimitiveType+                                              , RecordType+                                              , UnionType+                                              )+                                        , TypeDeclaration( Import+                                                         , ServiceDeclaration+                                                         , TypeDeclaration+                                                         )+                                        )+import Nirum.Constructs.TypeExpression ( TypeExpression( ListModifier+                                                       , MapModifier+                                                       , OptionModifier+                                                       , SetModifier+                                                       , TypeIdentifier+                                                       )+                                       )+import Nirum.Package ( BoundModule+                     , Package(modules)+                     , TypeLookup(Imported, Local, Missing)+                     , lookupType+                     , resolveBoundModule+                     , types+                     )++data Source = Source { sourcePackage :: Package+                     , sourceModule :: BoundModule+                     } deriving (Eq, Ord, Show)++type Code = T.Text+type CompileError = T.Text++data CodeGen a = CodeGen { standardImports :: S.Set T.Text+                         , thirdPartyImports :: M.Map T.Text (S.Set T.Text)+                         , localImports :: M.Map T.Text (S.Set T.Text)+                         , code :: a+                         }+               | CodeGenError CompileError+               deriving (Eq, Ord, Show)++instance Functor CodeGen where+    fmap f codeGen = pure f <*> codeGen++instance Applicative CodeGen where+    pure = return+    c@CodeGen { code = f } <*> codeGen = codeGen >>= \x -> c { code = f x }+    (CodeGenError m) <*> _ = CodeGenError m++instance Monad CodeGen where+    return code' = CodeGen { standardImports = []+                           , thirdPartyImports = []+                           , localImports = []+                           , code = code'+                           }+    (CodeGen si ti li c) >>= f = case f c of+        (CodeGen si' ti' li' code') ->+            let stdImports = S.union si si'+                thirdPartyImports' = M.unionWith S.union ti ti'+                localImports' = M.unionWith S.union li li'+            in+                CodeGen stdImports thirdPartyImports' localImports' code'+        (CodeGenError m) -> CodeGenError m+    (CodeGenError m) >>= _ = CodeGenError m++    fail = CodeGenError . T.pack++hasError :: CodeGen a -> Bool+hasError (CodeGenError _) = True+hasError _ = False++compileError :: CodeGen a -> Maybe CompileError+compileError CodeGen {} = Nothing+compileError (CodeGenError m) = Just m++withStandardImport :: T.Text -> CodeGen a -> CodeGen a+withStandardImport module' c@CodeGen { standardImports = si } =+    c { standardImports = S.insert module' si }+withStandardImport _ c@(CodeGenError _) = c++withThirdPartyImports :: [(T.Text, S.Set T.Text)] -> CodeGen a -> CodeGen a+withThirdPartyImports imports c@CodeGen { thirdPartyImports = ti } =+    c { thirdPartyImports = L.foldl (M.unionWith S.union) ti importList }+  where+    importList :: [M.Map T.Text (S.Set T.Text)]+    importList = map (uncurry M.singleton) imports+withThirdPartyImports _ c@(CodeGenError _) = c++withLocalImport :: T.Text -> T.Text -> CodeGen a -> CodeGen a+withLocalImport module' object c@CodeGen { localImports = li } =+    c { localImports = M.insertWith S.union module' [object] li }+withLocalImport _ _ c@(CodeGenError _) = c++-- | The set of Python reserved keywords.+-- See also: https://docs.python.org/3/reference/lexical_analysis.html#keywords+keywords :: S.Set T.Text+keywords = [ "False", "None", "True"+           , "and", "as", "assert", "break", "class", "continue"+           , "def", "del" , "elif", "else", "except", "finally"+           , "for", "from", "global", "if", "import", "in", "is"+           , "lambda", "nonlocal", "not", "or", "pass", "raise"+           , "return", "try", "while", "with", "yield"+           ]++toClassName :: Identifier -> T.Text+toClassName identifier =+    if className `S.member` keywords then className `T.snoc` '_' else className+  where+    className :: T.Text+    className = toPascalCaseText identifier++toClassName' :: Name -> T.Text+toClassName' = toClassName . N.facialName++toAttributeName :: Identifier -> T.Text+toAttributeName identifier =+    if attrName `S.member` keywords then attrName `T.snoc` '_' else attrName+  where+    attrName :: T.Text+    attrName = toSnakeCaseText identifier++toAttributeName' :: Name -> T.Text+toAttributeName' = toAttributeName . N.facialName++toImportPath :: ModulePath -> T.Text+toImportPath = T.intercalate "." . map toAttributeName . toList++toNamePair :: Name -> T.Text+toNamePair (Name f b) = [qq|('{toAttributeName f}', '{toSnakeCaseText b}')|]++toIndentedCodes :: (a -> T.Text) -> [a] -> T.Text -> T.Text+toIndentedCodes f traversable concatenator =+    T.intercalate concatenator $ map f traversable+++compileUnionTag :: Source+                -> Name+                -> Name+                -> DS.DeclarationSet Field+                -> CodeGen Code+compileUnionTag source parentname typename fields = do+    typeExprCodes <- mapM (compileTypeExpression source)+        [typeExpr | (Field _ typeExpr _) <- toList fields]+    let className = toClassName' typename+        tagNames = map toAttributeName' [ name+                                        | (Field name _ _) <- toList fields+                                        ]+        nameNTypes = zip tagNames typeExprCodes+        slotTypes = toIndentedCodes+            (\(n, t) -> [qq|'{n}': {t}|]) nameNTypes ",\n        "+        slots = toIndentedCodes (\n -> [qq|'{n}'|]) tagNames ",\n        "+        initialArgs = toIndentedCodes+            (\(n, t) -> [qq|{n}: {t}|]) nameNTypes ", "+        initialValues =+            toIndentedCodes (\n -> [qq|self.{n} = {n}|]) tagNames "\n        "+        nameMaps = toIndentedCodes+            toNamePair+            [name | Field name _ _ <- toList fields]+            ",\n        "+        parentClass = toClassName' parentname+    withStandardImport "typing" $+        withThirdPartyImports [ ("nirum.validate", ["validate_union_type"])+                              , ("nirum.constructs", ["name_dict_type"])+                              ] $+            return [qq|+class $className($parentClass):+    # TODO: docstring++    __slots__ = (+        $slots,+    )+    __nirum_tag__ = $parentClass.Tag.{toAttributeName' typename}+    __nirum_tag_types__ = \{+        $slotTypes+    \}+    __nirum_tag_names__ = name_dict_type([+        $nameMaps+    ])++    def __init__(self, $initialArgs) -> None:+        $initialValues+        validate_union_type(self)++    def __repr__(self) -> str:+        return '\{0.__module__\}.\{0.__qualname__\}(\{1\})'.format(+            type(self),+            ', '.join('\{\}=\{\}'.format(attr, getattr(self, attr))+                      for attr in self.__slots__)+        )++    def __eq__(self, other) -> bool:+        return isinstance(other, $className) and all(+            getattr(self, attr) == getattr(other, attr)+            for attr in self.__slots__+        )+            |]++compilePrimitiveType :: PrimitiveTypeIdentifier -> CodeGen Code+compilePrimitiveType primitiveTypeIdentifier =+    case primitiveTypeIdentifier of+        Bool -> return "bool"+        Bigint -> return "int"+        Decimal -> withStandardImport "decimal" $ return "decimal.Decimal"+        Int32 -> return "int"+        Int64 -> return "int"+        Float32 -> return "float"+        Float64 -> return "float"+        Text -> return "str"+        Binary -> return "bytes"+        Date -> withStandardImport "datetime" $ return "datetime.date"+        Datetime -> withStandardImport "datetime" $ return "datetime.datetime"+        Uuid -> withStandardImport "uuid" $ return"uuid.UUID"+        Uri -> return "str"++compileTypeExpression :: Source -> TypeExpression -> CodeGen Code+compileTypeExpression Source { sourceModule = boundModule } (TypeIdentifier i) =+    case lookupType i boundModule of+        Missing -> fail $ "undefined identifier: " ++ toString i+        Imported _ (PrimitiveType p _) -> compilePrimitiveType p+        Imported m _ ->+            withThirdPartyImports [(toImportPath m, [toClassName i])] $+                return $ toClassName i+        Local _ -> return $ toClassName i+compileTypeExpression source (MapModifier k v) = do+    kExpr <- compileTypeExpression source k+    vExpr <- compileTypeExpression source v+    withStandardImport "typing" $ return [qq|typing.Mapping[$kExpr, $vExpr]|]+compileTypeExpression source modifier = do+    expr <- compileTypeExpression source typeExpr+    withStandardImport "typing" $ return [qq|typing.$className[$expr]|]+  where+    typeExpr :: TypeExpression+    className :: T.Text+    (typeExpr, className) = case modifier of+        OptionModifier t' -> (t', "Optional")+        SetModifier t' -> (t', "AbstractSet")+        ListModifier t' -> (t', "Sequence")+        TypeIdentifier _ -> undefined  -- never happen!+        MapModifier _ _ -> undefined  -- never happen!++compileTypeDeclaration :: Source -> TypeDeclaration -> CodeGen Code+compileTypeDeclaration _ (TypeDeclaration _ (PrimitiveType _ _) _ _) =+    return ""  -- never used+compileTypeDeclaration src (TypeDeclaration typename (Alias ctype) _ _) = do+    ctypeExpr <- compileTypeExpression src ctype+    return [qq|+# TODO: docstring+{toClassName' typename} = $ctypeExpr+    |]+compileTypeDeclaration src (TypeDeclaration typename (BoxedType itype) _ _) = do+    let className = toClassName' typename+    itypeExpr <- compileTypeExpression src itype+    withStandardImport "typing" $+        withThirdPartyImports [ ("nirum.validate", ["validate_boxed_type"])+                              , ("nirum.serialize", ["serialize_boxed_type"])+                              , ( "nirum.deserialize"+                                , ["deserialize_boxed_type"]+                                )+                              ] $+            return [qq|+class $className:+    # TODO: docstring++    __nirum_boxed_type__ = $itypeExpr++    def __init__(self, value: $itypeExpr) -> None:+        validate_boxed_type(value, $itypeExpr)+        self.value = value  # type: $itypeExpr++    def __eq__(self, other) -> bool:+        return (isinstance(other, $className) and+                self.value == other.value)++    def __hash__(self) -> int:+        return hash(self.value)++    def __nirum_serialize__(self) -> typing.Any:+        return serialize_boxed_type(self)++    @classmethod+    def __nirum_deserialize__(cls: type, value: typing.Any) -> '{className}':+        return deserialize_boxed_type(cls, value)++    def __repr__(self) -> str:+        return '\{0.__module__\}.\{0.__qualname__\}(\{1!r\})'.format(+            type(self), self.value+        )+            |]+compileTypeDeclaration _ (TypeDeclaration typename (EnumType members) _ _) = do+    let className = toClassName' typename+        memberNames = T.intercalate+            "\n    "+            [ [qq|{toAttributeName' memberName} = '{toSnakeCaseText bn}'|]+            | EnumMember memberName@(Name _ bn) _ <- toList members+            ]+    withStandardImport "enum" $ return [qq|+class $className(enum.Enum):+    # TODO: docstring++    $memberNames++    def __nirum_serialize__(self) -> str:+        return self.value++    @classmethod+    def __nirum_deserialize__(cls: type, value: str) -> '{className}':+        return cls(value.replace('-', '_'))  # FIXME: validate input+    |]+compileTypeDeclaration src (TypeDeclaration typename (RecordType fields) _ _) = do+    typeExprCodes <- mapM (compileTypeExpression src)+        [typeExpr | (Field _ typeExpr _) <- toList fields]+    let className = toClassName' typename+        fieldNames = map toAttributeName' [ name+                                          | (Field name _ _) <- toList fields+                                          ]+        nameNTypes = zip fieldNames typeExprCodes+        slotTypes = toIndentedCodes+            (\(n, t) -> [qq|'{n}': {t}|]) nameNTypes ",\n        "+        slots = toIndentedCodes (\n -> [qq|'{n}'|]) fieldNames ",\n        "+        initialArgs = toIndentedCodes+            (\(n, t) -> [qq|{n}: {t}|]) nameNTypes ", "+        initialValues = toIndentedCodes+            (\n -> [qq|self.{n} = {n}|]) fieldNames "\n        "+        nameMaps = toIndentedCodes+            toNamePair+            [name | Field name _ _ <- toList fields]+            ",\n        "+    withStandardImport "typing" $+        withThirdPartyImports [ ( "nirum.validate"+                                , ["validate_record_type"]+                                )+                              , ("nirum.serialize", ["serialize_record_type"])+                              , ( "nirum.deserialize"+                                , ["deserialize_record_type"])+                              , ("nirum.constructs", ["name_dict_type"])+                              ] $+            return [qq|+class $className:+    # TODO: docstring++    __slots__ = (+        $slots,+    )+    __nirum_record_behind_name__ = '{toSnakeCaseText $ N.behindName typename}'+    __nirum_field_types__ = \{+        $slotTypes+    \}+    __nirum_field_names__ = name_dict_type([+        $nameMaps+    ])++    def __init__(self, $initialArgs) -> None:+        $initialValues+        validate_record_type(self)++    def __repr__(self) -> str:+        return '\{0.__module__\}.\{0.__qualname__\}(\{1\})'.format(+            type(self),+            ', '.join('\{\}=\{\}'.format(attr, getattr(self, attr))+                      for attr in self.__slots__)+        )++    def __eq__(self, other) -> bool:+        return isinstance(other, $className) and all(+            getattr(self, attr) == getattr(other, attr)+            for attr in self.__slots__+        )++    def __nirum_serialize__(self) -> typing.Mapping[str, typing.Any]:+        return serialize_record_type(self)++    @classmethod+    def __nirum_deserialize__(cls: type, value) -> '{className}':+        return deserialize_record_type(cls, value)+                        |]+compileTypeDeclaration src (TypeDeclaration typename (UnionType tags) _ _) = do+    fieldCodes <- mapM (uncurry (compileUnionTag src typename)) tagNameNFields+    let className = toClassName' typename+        fieldCodes' = T.intercalate "\n\n" fieldCodes+        enumMembers = toIndentedCodes+            (\(t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n        "+    withStandardImport "typing" $+        withStandardImport "enum" $+            withThirdPartyImports [ ( "nirum.serialize"+                                    , ["serialize_union_type"])+                                  , ( "nirum.deserialize"+                                    , ["deserialize_union_type"])+                                  , ("nirum.constructs", ["name_dict_type"])+                                  ] $+                return [qq|+class $className:++    __nirum_union_behind_name__ = '{toSnakeCaseText $ N.behindName typename}'+    __nirum_field_names__ = name_dict_type([+        $nameMaps+    ])++    class Tag(enum.Enum):+        $enumMembers++    def __init__(self, *args, **kwargs):+        raise NotImplementedError(+            "\{0.__module__\}.\{0.__qualname__\} cannot be instantiated "+            "since it is an abstract class.  Instantiate a concrete subtype "+            "of it instead.".format(+                type(self)+            )+        )++    def __nirum_serialize__(self) -> typing.Mapping[str, typing.Any]:+        return serialize_union_type(self)++    @classmethod+    def __nirum_deserialize__(cls: type, value) -> '{className}':+        return deserialize_union_type(cls, value)+++$fieldCodes'+            |]+  where+    tagNameNFields :: [(Name, DS.DeclarationSet Field)]+    tagNameNFields = [ (tagName, fields)+                     | (Tag tagName fields _) <- toList tags+                     ]+    enumMembers' :: [(T.Text, T.Text)]+    enumMembers' = [ ( toAttributeName' tagName+                     , toSnakeCaseText $ N.behindName tagName+                     )+                   | (Tag tagName _ _) <- toList tags+                   ]+    nameMaps :: T.Text+    nameMaps = toIndentedCodes+        toNamePair+        [name | (name, _) <- tagNameNFields]+        ",\n        "+compileTypeDeclaration src (ServiceDeclaration name (Service methods) _ _) = do+    let methods' = toList methods+    methodMetadata <- mapM compileMethodMetadata methods'+    let methodMetadata' = commaNl methodMetadata+    dummyMethods <- mapM compileMethod methods'+    let dummyMethods' = T.intercalate "\n\n" dummyMethods+    withThirdPartyImports [ ("nirum.constructs", ["name_dict_type"])+                          , ("nirum.rpc", ["service_type"])+                          ] $+        return [qq|+class $className(service_type):++    __nirum_service_methods__ = \{+        {methodMetadata'}+    \}+    __nirum_method_names__ = name_dict_type([+        $methodNameMap+    ])++    {dummyMethods'}+|]+  where+    className :: T.Text+    className = toClassName' name+    commaNl :: [T.Text] -> T.Text+    commaNl = T.intercalate ",\n"+    compileMethod :: Method -> CodeGen Code+    compileMethod (Method mName params rtype _etype _docs _anno) = do+        let mName' = toAttributeName' mName+        params' <- mapM compileParameter $ toList params+        rtypeExpr <- compileTypeExpression src rtype+        return [qq|+    def {mName'}(self, {commaNl params'}) -> $rtypeExpr:+        raise NotImplementedError('$className has to implement {mName'}()')+|]+    compileParameter :: Parameter -> CodeGen Code+    compileParameter (Parameter pName pType _) = do+        pTypeExpr <- compileTypeExpression src pType+        return [qq|{toAttributeName' pName}: $pTypeExpr|]+    compileMethodMetadata :: Method -> CodeGen Code+    compileMethodMetadata (Method mName params rtype _etype _docs _anno) = do+        let params' = toList params :: [Parameter]+        rtypeExpr <- compileTypeExpression src rtype+        paramMetadata <- mapM compileParameterMetadata params'+        let paramMetadata' = commaNl paramMetadata+        withThirdPartyImports [("nirum.constructs", ["name_dict_type"])] $+            return [qq|'{toAttributeName' mName}': \{+                '_return': $rtypeExpr,+                '_names': name_dict_type([{paramNameMap params'}]),+                {paramMetadata'}+            \}|]+    compileParameterMetadata :: Parameter -> CodeGen Code+    compileParameterMetadata (Parameter pName pType _) = do+        let pName' = toAttributeName' pName+        pTypeExpr <- compileTypeExpression src pType+        return [qq|'{pName'}': $pTypeExpr|]+    methodNameMap :: T.Text+    methodNameMap = toIndentedCodes+        toNamePair+        [mName | Method { methodName = mName } <- toList methods]+        ",\n        "+    paramNameMap :: [Parameter] -> T.Text+    paramNameMap params = toIndentedCodes+        toNamePair [pName | Parameter pName _ _ <- params] ",\n        "+compileTypeDeclaration _ (Import _ _) =+    return ""  -- Nothing to compile++compileModuleBody :: Source -> CodeGen Code+compileModuleBody src@Source { sourceModule = boundModule } = do+    let types' = types boundModule+    typeCodes <- mapM (compileTypeDeclaration src) $ toList types'+    let moduleCode = T.intercalate "\n\n" typeCodes+    return [qq|+# TODO: docs+$moduleCode+    |]++data InstallRequires =+    InstallRequires { dependencies :: S.Set T.Text+                    , optionalDependencies :: M.Map (Int, Int) (S.Set T.Text)+                    } deriving (Eq, Ord, Show)++addDependency :: InstallRequires -> T.Text -> InstallRequires+addDependency requires package =+    requires { dependencies = S.insert package $ dependencies requires }++addOptionalDependency :: InstallRequires+                      -> (Int, Int)       -- | Python version already stasified+                      -> T.Text           -- | PyPI package name+                      -> InstallRequires+addOptionalDependency requires pyVer package =+    requires { optionalDependencies = newOptDeps }+  where+    oldOptDeps :: M.Map (Int, Int) (S.Set T.Text)+    oldOptDeps = optionalDependencies requires+    newOptDeps :: M.Map (Int, Int) (S.Set T.Text)+    newOptDeps = M.alter (Just . S.insert package . fromMaybe S.empty)+                         pyVer oldOptDeps++unionInstallRequires :: InstallRequires -> InstallRequires -> InstallRequires+unionInstallRequires a b =+    a { dependencies = S.union (dependencies a) (dependencies b)+      , optionalDependencies = M.unionWith S.union (optionalDependencies a)+                                                   (optionalDependencies b)+      }++compileModule :: Source -> Either CompileError (InstallRequires, Code)+compileModule source =+    case code' of+        CodeGenError errMsg -> Left errMsg+        CodeGen {} -> codeWithDeps $ [qq|+{imports $ standardImports code'}++{fromImports $ localImports code'}++{fromImports $ thirdPartyImports code'}++{code code'}+    |]+  where+    code' :: CodeGen T.Text+    code' = compileModuleBody source+    imports :: S.Set T.Text -> T.Text+    imports importSet =+        if S.null importSet+        then ""+        else "import " `T.append` T.intercalate "," (S.elems importSet)+    fromImports :: M.Map T.Text (S.Set T.Text) -> T.Text+    fromImports importMap =+        T.intercalate "\n"+            [ [qq|from $from import {T.intercalate ", " $ S.elems vars}|]+            | (from, vars) <- M.assocs importMap+            ]+    has :: S.Set T.Text -> T.Text -> Bool+    has set module' = module' `S.member` set ||+                      any (T.isPrefixOf $ module' `T.snoc` '.') set+    require :: T.Text -> T.Text -> S.Set T.Text -> S.Set T.Text+    require pkg module' set =+        if set `has` module' then S.singleton pkg else S.empty+    deps :: S.Set T.Text+    deps = require "nirum" "nirum" $ M.keysSet $ thirdPartyImports code'+    optDeps :: M.Map (Int, Int) (S.Set T.Text)+    optDeps = [ ((3, 4), require "enum34" "enum" $ standardImports code')+              , ((3, 5), require "typing" "typing" $ standardImports code')+              ]+    codeWithDeps :: Code -> Either CompileError (InstallRequires, Code)+    codeWithDeps c = Right (InstallRequires deps optDeps, c)++compilePackageMetadata :: Package -> InstallRequires -> Code+compilePackageMetadata package (InstallRequires deps optDeps) = [qq|+import sys++from setuptools import setup, __version__ as setuptools_version++install_requires = [$pInstallRequires]+polyfill_requires = \{$pPolyfillRequires}++if polyfill_requires:+    # '<' operator for environment markers are supported since setuptools 17.1.+    # Read PEP 496 for details of environment markers.+    setup_requires = ['setuptools >= 17.1']+    if tuple(map(int, setuptools_version.split('.'))) < (17, 1):+        extras_require = \{}+        if 'bdist_wheel' not in sys.argv:+            for (major, minor), deps in polyfill_requires.items():+                if sys.version_info < (major, minor):+                    install_requires.extend(deps)+        envmarker = ":python_version=='\{0}.\{1}'"+        python_versions = [(2, 6), (2, 7),+                           (3, 3), (3, 4), (3, 5), (3, 6)]  # FIXME+        for pyver in python_versions:+            extras_require[envmarker.format(*pyver)] = list(\{+                d+                for v, vdeps in polyfill_requires.items()+                if pyver < v+                for d in vdeps+            })+    else:+        extras_require = \{+            ":python_version<'\{0}.\{1}'".format(*pyver): deps+            for pyver, deps in polyfill_requires.items()+        }+else:+    setup_requires = []+    extras_require = \{}++# TODO: description, long_description, url, author, author_email, license,+#       keywords, classifiers+setup(+    name='{pName}',+    version='{pVersion}',+    packages=[$pPackages],+    provides=[$pPackages],+    requires=[$pInstallRequires],+    setup_requires=setup_requires,+    install_requires=install_requires,+    extras_require=extras_require,+)+|]+  where+    pName :: Code+    pName = "TestPackage"  -- FIXME+    pVersion :: Code+    pVersion = "0.1.0"  -- FIXME+    strings :: [Code] -> Code+    strings values = T.intercalate ", " . L.sort $ [[qq|'{v}'|] | v <- values]+    pPackages :: Code+    pPackages = strings $ map toImportPath $ M.keys $ modules package+    pInstallRequires :: Code+    pInstallRequires = strings $ S.toList deps+    pPolyfillRequires :: Code+    pPolyfillRequires = T.intercalate ", "+        [ [qq|($major, $minor): [{strings $ S.toList deps'}]|]+        | ((major, minor), deps') <- M.toList optDeps+        ]++compilePackage :: Package+               -> M.Map FilePath (Either CompileError Code)+compilePackage package =+    M.fromList $+        initFiles +++        [ ( f+          , case cd of+                Left e -> Left e+                Right (_, cd') -> Right cd'+          )+        | (f, cd) <- modules'+        ] +++        [("setup.py", Right $ compilePackageMetadata package installRequires)]+  where+    toFilename :: ModulePath -> FilePath+    toFilename mp =+        joinPath $ [ T.unpack (toAttributeName i)+                   | i <- toList mp+                   ] ++ ["__init__.py"]+    initFiles :: [(FilePath, Either CompileError Code)]+    initFiles = [ (toFilename mp', Right "")+                | mp <- M.keys (modules package)+                , mp' <- S.elems (ancestors mp)+                ]+    modules' :: [(FilePath, Either CompileError (InstallRequires, Code))]+    modules' =+        [ ( toFilename modulePath'+          , compileModule $ Source package boundModule+          )+        | (modulePath', _) <- M.assocs (modules package)+        , Just boundModule <- [resolveBoundModule modulePath' package]+        ]+    installRequires :: InstallRequires+    installRequires = foldl unionInstallRequires+                            (InstallRequires [] [])+                            [deps | (_, Right (deps, _)) <- modules']
+ src/Nirum/Version.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+-- | Inquiry to Nirum version.+module Nirum.Version (version, versionString, versionText) where++import Data.Maybe (mapMaybe)+import Data.Version (versionBranch, versionTags)++import qualified Data.SemVer as SV+import Data.Text (Text, pack)++import qualified Paths_nirum as P+-- Special module provided by Cabal+-- See also: http://stackoverflow.com/a/2892624/383405++-- | The semantic version of the running Nirum.+version :: SV.Version+version = case branch of+    [major, minor, patch] ->+        if length relTags == length tags+        then SV.version major minor patch relTags []+        else error ("invalid release identifiers: " ++ show relTags)+    [_, _] -> error ("patch version is missing: " ++ show branch)+    [_] -> error ("minor version is missing: " ++ show branch)+    [] -> error "major version is missing"+    _ -> error ("too precise version for semver: " ++ show branch)+  where+    branch :: [Int]+    branch = versionBranch P.version+    tags :: [String]+    tags = versionTags P.version+    relTags :: [SV.Identifier]+    relTags = mapMaybe (SV.textual . pack) tags++-- | The string representation of 'version'.+versionString :: String+versionString = SV.toString version++-- | The text representation of 'version'.+versionText :: Text+versionText = SV.toText version
+ test/HLint.hs view
@@ -0,0 +1,12 @@+import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++arguments :: [String]+arguments = ["src", "test"]++main :: IO ()+main = do+    hlints <- hlint arguments+    case hlints of+        [] -> exitSuccess+        _ -> exitFailure
+ test/Nirum/CliSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.CliSpec where++import Control.Monad (forM_)++import qualified Data.Map.Strict as M+import Data.List (sort)+import Data.Text (Text)+import qualified Data.Text.IO as TI+import System.Directory (listDirectory)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec.Meta++import Nirum.Cli (writeFiles)++expectWriteFiles :: FilePath -> [(FilePath, Text)] -> IO [FilePath]+expectWriteFiles tmpDir files = do+    writeFiles tmpDir $ M.fromList [(f, Right c) | (f, c) <- files]+    forM_ files $ \(f, expectedContent) -> do+        content <- TI.readFile (tmpDir </> f)+        content `shouldBe` expectedContent+    fileList <- listDirectory tmpDir+    return $ sort fileList++spec :: Spec+spec =+    describe "writeFiles" $ do+        it "writes root files" $+            withSystemTempDirectory "writeFiles-rootFiles" $ \tmpDir -> do+                let files = [ ("a.txt", "content A")+                            , ("b.txt", "content B")+                            ]+                fileList <- expectWriteFiles tmpDir files+                fileList `shouldBe` sort [f | (f, _) <- files]+        it "makes directories if necessary" $+            withSystemTempDirectory "writeFiles-directories" $ \tmpDir -> do+                let files = [ ("a.txt", "content A")+                            , ("b.txt", "content B")+                            , ("d/a.txt", "content d/a")+                            , ("d/b/c.txt", "content d/b/c")+                            , ("d2/a.txt", "content d2/a")+                            ]+                fileList <- expectWriteFiles tmpDir files+                fileList `shouldBe` ["a.txt", "b.txt", "d", "d2"]+                dFileList <- listDirectory $ tmpDir </> "d"+                sort dFileList `shouldBe` ["a.txt", "b"]+                dBFileList <- listDirectory $ tmpDir </> "d" </> "b"+                dBFileList `shouldBe` ["c.txt"]+                d2FileList <- listDirectory $ tmpDir </> "d2"+                d2FileList `shouldBe` ["a.txt"]
+ test/Nirum/Constructs/AnnotationSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.AnnotationSpec where++import Test.Hspec.Meta+import qualified Data.Map.Strict as M++import Nirum.Constructs.Annotation+    ( Annotation (Annotation)+    , AnnotationSet (AnnotationSet)+    , NameDuplication (AnnotationNameDuplication)+    , empty+    , fromList+    , toCode+    , toList+    )++spec :: Spec+spec = do+    let annotation = Annotation "foo" Nothing+        loremAnno = Annotation "lorem" (Just "ipsum")+        withEscapeChar = Annotation "quote" (Just "\"")+    describe "Annotation" $+        describe "toCode Annotation" $+            it "prints annotation properly" $ do+                toCode annotation `shouldBe` "@foo"+                toCode loremAnno `shouldBe` "@lorem(\"ipsum\")"+                toCode withEscapeChar `shouldBe` "@quote(\"\\\"\")"+    describe "AnnotationSet" $ do+        it "empty" $ empty `shouldBe` AnnotationSet M.empty+        describe "fromList" $ do+            it "success" $ do+                fromList [] `shouldBe` Right (AnnotationSet M.empty)+                fromList [annotation] `shouldBe` Right+                    (AnnotationSet $ M.fromList [("foo", annotation)])+            it "name duplication" $ do+                let duplicationAnnotations = fromList [ annotation+                                                      , loremAnno+                                                      , annotation+                                                      ]+                duplicationAnnotations `shouldBe`+                    Left (AnnotationNameDuplication "foo")+        let annotationSet = case fromList [annotation, loremAnno] of+                                Right set -> set+                                Left _ -> empty+        it "toList" $+            fromList (toList annotationSet) `shouldBe` Right annotationSet
+ test/Nirum/Constructs/DeclarationSetSpec.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.Constructs.DeclarationSetSpec (SampleDecl(..), spec) where++import Control.Exception.Base (evaluate)+import Data.String (IsString(..))++import Test.Hspec.Meta++import Nirum.Constructs (Construct(..))+import Nirum.Constructs.Declaration (Declaration(..), Docs)+import Nirum.Constructs.DeclarationSet ( DeclarationSet+                                       , NameDuplication(..)+                                       , empty+                                       , fromList+                                       , lookup'+                                       , null'+                                       , size+                                       , toList+                                       , union+                                       , (!)+                                       )+import Nirum.Constructs.Name (Name(Name))++data SampleDecl = SampleDecl Name (Maybe Docs) deriving (Eq, Ord, Show)++instance Construct SampleDecl where+    toCode _ = "(do not impl)"++instance Declaration SampleDecl where+    name (SampleDecl name' _) = name'+    docs (SampleDecl _ docs') = docs'++instance IsString SampleDecl where+    fromString s = SampleDecl (fromString s) Nothing++type SampleDeclSet = DeclarationSet SampleDecl++spec :: Spec+spec =+    describe "DeclarationSet" $ do+        let sd fname bname = SampleDecl (Name fname bname) Nothing+        context "fromList" $ do+            let fl = fromList :: [SampleDecl]+                              -> Either NameDuplication SampleDeclSet+            it ("returns Left FacialNameDuplication "+                ++ "if duplicated facial name exists") $ do+                fl ["foo", "bar", "foo"] `shouldBe`+                    Left (FacialNameDuplication "foo")+                fl ["foo", "bar", "bar"] `shouldBe`+                    Left (FacialNameDuplication "bar")+                fl ["foo", "bar", sd "foo" "baz"] `shouldBe`+                    Left (FacialNameDuplication $ Name "foo" "baz")+            it ("returns Left BehindNameDuplication "+                ++ "if duplicated behind name exists") $ do+                fl ["foo", "bar", sd "baz" "foo"] `shouldBe`+                    Left (BehindNameDuplication $ Name "baz" "foo")+                fl [sd "foo" "bar", "bar", "baz"] `shouldBe`+                    Left (BehindNameDuplication "bar")+            it "returns Right DeclarationSet if there are no duplications" $ do+                let Right dset = fl ["foo", "bar", "baz"]+                toList dset `shouldBe` ["foo", "bar", "baz"]+        let dset = ["foo", "bar", sd "baz" "asdf"] :: SampleDeclSet+        context "toList" $+            it "returns [Declaration]" $ do+                toList dset `shouldBe` ["foo", "bar", sd "baz" "asdf"]+                toList (empty :: SampleDeclSet) `shouldBe` []+        context "size" $+            it "returns its cardinality" $ do+                size dset `shouldBe` 3+                size (empty :: SampleDeclSet) `shouldBe` 0+        context "null" $ do+            it "returns True if the set is empty" $ do+                ([] :: SampleDeclSet) `shouldSatisfy` null'+                (empty :: SampleDeclSet) `shouldSatisfy` null'+            it "returns False if the set is not empty" $+                dset `shouldNotSatisfy` null'+        context "lookup" $ do+            it "returns Nothing if there is no such facial name" $+                lookup' "not-exists" dset `shouldBe` Nothing+            it "returns Just Declaration if the name exists" $ do+                lookup' "foo" dset `shouldBe` Just "foo"+                lookup' "bar" dset `shouldBe` Just "bar"+                lookup' "baz" dset `shouldBe` Just (sd "baz" "asdf")+        context "DeclarationSet ! Identifier" $ do+            it "returns Declaration if the name exists" $ do+                dset ! "foo" `shouldBe` "foo"+                dset ! "bar" `shouldBe` "bar"+                dset ! "baz" `shouldBe` sd "baz" "asdf"+            it "fails if there is no such facial name" $+                evaluate (dset ! "not-exists") `shouldThrow` anyException+        context "union" $ do+            it "returns Right DeclarationSet if there aren't no duplications" $+                union dset ["apple", "banana"] `shouldBe`+                    Right ["foo" , "bar" , sd "baz" "asdf", "apple", "banana"]+            it "returns Left FacialNameDuplication if facial names are dup" $+                union dset [sd "foo" "xyz"] `shouldBe`+                    Left (FacialNameDuplication $ Name "foo" "xyz")+            it "returns Left BehindNameDuplication if behind names are dup" $+                union dset [sd "xyz" "foo"] `shouldBe`+                    Left (BehindNameDuplication $ Name "xyz" "foo")
+ test/Nirum/Constructs/DeclarationSpec.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.DeclarationSpec where++import Test.Hspec.Meta++import Nirum.Constructs (Construct(..))+import Nirum.Constructs.Declaration (Docs(Docs), toCodeWithPrefix)++spec :: Spec+spec =+    describe "Docs" $ do+        context "toCode" $ do+            it "has leading sharps every line" $ do+                toCode (Docs "test") `shouldBe` "# test"+                toCode (Docs "test\ntest2") `shouldBe` "# test\n# test2"+            specify "... except of the last EOL" $ do+                toCode (Docs "test\n") `shouldBe` "# test"+                toCode (Docs "test\ntest2\n") `shouldBe` "# test\n# test2"+        context "toCodeWithPrefix" $ do+            it "simply returns an empty string if input is Nothing" $ do+                toCodeWithPrefix "\n" Nothing `shouldBe` ""+                toCodeWithPrefix "(prefix)" Nothing `shouldBe` ""+            it "prepends the given prefix if input is Just Docs" $ do+                toCodeWithPrefix "\n" (Just "docs") `shouldBe` "\n# docs"+                toCodeWithPrefix "(prefix)" (Just "doc\ndoc")+                    `shouldBe` "(prefix)# doc\n# doc"+        context "fromString" $ do+            it "is equivalent to Docs data constructor" $ do+                ("test\n" :: Docs) `shouldBe` Docs "test\n"+                ("test\ntest2\n" :: Docs) `shouldBe` Docs "test\ntest2\n"+            specify "... except it automatically appends EOL if omitted" $ do+                ("test" :: Docs) `shouldBe` Docs "test\n"+                ("test\ntest2" :: Docs) `shouldBe` Docs "test\ntest2\n"
+ test/Nirum/Constructs/IdentifierSpec.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.IdentifierSpec where++import Control.Exception (evaluate)+import Control.Monad (forM_)+import Data.Maybe (fromJust)++import Data.Text (Text)+import Test.Hspec.Meta++import Nirum.Constructs.Identifier ( Identifier+                                   , fromText+                                   , normalize+                                   , toCamelCaseText+                                   , toCode+                                   , toLispCaseText+                                   , toNormalizedString+                                   , toNormalizedText+                                   , toPascalCaseText+                                   , toSnakeCaseText+                                   , toString+                                   , toText+                                   , tokens+                                   )++fromText' :: Text -> Identifier+fromText' = fromJust . fromText++getIdentifier :: Text -> Text+getIdentifier = toText . fromText'++getCode :: Text -> Text+getCode = toCode . fromText'++getNormalizedIdentifier :: Text -> Text+getNormalizedIdentifier = toText . normalize . fromText'++spec :: Spec+spec = do+    describe "fromText" $ do+        it "returns Nothing if identifier text is invalid" $ do+            fromText "" `shouldBe` Nothing+            fromText "-" `shouldBe` Nothing+            fromText "1dentifier-cannot-start-with-digits" `shouldBe` Nothing+            fromText "-identifier-cannot-start-with-hyphen" `shouldBe` Nothing+            fromText "_identifier_cannot_start_with_underscore"+                `shouldBe` Nothing+            fromText "identifier-cannot-end-with-hyphen-" `shouldBe` Nothing+            fromText "identifier_cannot_end_with_underscore_"+                `shouldBe` Nothing+            fromText "identifier-cannot-have-two--or---more---continued-hyphens"+                `shouldBe` Nothing+            fromText "identifier_cannot_have_two__or_more_continued_underscores"+                `shouldBe` Nothing+            fromText "무효한-식별자" `shouldBe` Nothing+            fromText "invalid-식별자" `shouldBe` Nothing+            fromText "identifier cannot contain whitepsaces" `shouldBe` Nothing+        it "returns Just Identifier if nothing goes wrong" $ do+            toText "datetime" `shouldBe` "datetime"+            toText "person-name" `shouldBe` "person-name"+    describe "tokens" $ do+        it "returns tokens behind" $ do+            tokens (fromText' "name") `shouldBe` ["name"]+            tokens (fromText' "a-name") `shouldBe` ["a", "name"]+        it "returns normalized tokens" $ do+            tokens (fromText' "Name") `shouldBe` ["name"]+            tokens (fromText' "A-Name") `shouldBe` ["a", "name"]+    describe "normalize" $+        it "returns normalized Identifier" $ do+            getNormalizedIdentifier "name" `shouldBe` "name"+            getNormalizedIdentifier "Name" `shouldBe` "name"+            getNormalizedIdentifier "normalize_test" `shouldBe` "normalize-test"+    describe "Identifier == Identifier" $ do+        it "returns True if words are all the same" $ do+            fromText "name" `shouldBe` fromText "name"+            fromText "valid-name" `shouldBe` fromText "valid-name"+        it "returns False if any word does not match" $ do+            fromText "name" `shouldNotBe` fromText "nam"+            fromText "a-name" `shouldNotBe` fromText "an-ame"+        it "is case-insensitive" $ do+            fromText "name" `shouldBe` fromText "Name"+            fromText "Valid-Name" `shouldBe` fromText "valid-name"+            fromText "valid_name" `shouldBe` fromText "valid-name"+    describe "compare Identifier Identifier" $ do+        it "returns Ordering in lexicographical order" $ do+            compare ("aaaab" :: Identifier) "aaaac" `shouldBe` LT+            compare ("aaaab" :: Identifier) "aaaaa" `shouldBe` GT+        it "is case-insensitive" $ do+            compare ("AAAAB" :: Identifier) "aaaac" `shouldBe` LT+            compare ("aaaab" :: Identifier) "AAAAC" `shouldBe` LT+            compare ("AAAAB" :: Identifier) "aaaaa" `shouldBe` GT+            compare ("aaaab" :: Identifier) "AAAAA" `shouldBe` GT+    describe "toCode Identifier" $ do+        it "returns its code representation" $ do+            getCode "name" `shouldBe` "name"+            getCode "person-name" `shouldBe` "person-name"+        it "quotes identifier if the identifier is a reserved keyword" $+            getCode "enum" `shouldBe` "`enum`"+    describe "fromString" $ do+        it "overrides strings if it's a valid identifier" $ do+            "name" `shouldBe` fromText' "name"+            "valid-name" `shouldBe` fromText' "valid-name"+        it "errors if it's a invalid identifier" $+            evaluate ("-" :: Identifier) `shouldThrow`+                errorCall "invalid identifier: -"+    describe "toString" $+        it "behaves same as toText except its return type is [Char]" $+            toString (fromText' "asdf") `shouldBe` ("asdf" :: String)+    describe "toNormalizedText Identifier" $ do+        let normalizers = [ toNormalizedText+                          , toLispCaseText+                          ] :: [Identifier -> Text]+        forM_ normalizers $ \normalizer -> do+            it "returns lowercased identifier text" $ do+                normalizer "IDENTIFIER" `shouldBe` "identifier"+                normalizer "Identifier" `shouldBe` "identifier"+            it "replaces underscores with hyphens" $ do+                normalizer "valid_identifier" `shouldBe` "valid-identifier"+                normalizer "Valid_Identifier" `shouldBe` "valid-identifier"+    describe "toNormalizedString Identifier" $ do+        it "returns lowercased identifier string" $ do+            toNormalizedString "IDENTIFIER" `shouldBe` "identifier"+            toNormalizedString "Identifier" `shouldBe` "identifier"+        it "replaces underscores with hyphens" $ do+            toNormalizedString "valid_identifier" `shouldBe` "valid-identifier"+            toNormalizedString "Valid_Identifier" `shouldBe` "valid-identifier"+    describe "toPascalCaseText Identifier" $+        it "returns PascalCase-ed identifier string" $ do+            toPascalCaseText (fromText' "pascal-case") `shouldBe` "PascalCase"+            toPascalCaseText (fromText' "PASCAL-CASE") `shouldBe` "PascalCase"+            toPascalCaseText (fromText' "pascal_case") `shouldBe` "PascalCase"+            toPascalCaseText (fromText' "PASCAL_CASE") `shouldBe` "PascalCase"+    describe "toCamelCaseText Identifier" $+        it "returns camelCase-ed identifier string" $ do+            toCamelCaseText (fromText' "camel-case") `shouldBe` "camelCase"+            toCamelCaseText (fromText' "CAMEL-CASE") `shouldBe` "camelCase"+            toCamelCaseText (fromText' "camel_case") `shouldBe` "camelCase"+            toCamelCaseText (fromText' "CAMEL_CASE") `shouldBe` "camelCase"+    describe "toSnakeCaseText Identifier" $+        it "returns snake_case-ed identifier string" $ do+            toSnakeCaseText (fromText' "snake-case") `shouldBe` "snake_case"+            toSnakeCaseText (fromText' "SNAKE-CASE") `shouldBe` "snake_case"+            toSnakeCaseText (fromText' "snake_case") `shouldBe` "snake_case"+            toSnakeCaseText (fromText' "SNAKE_CASE") `shouldBe` "snake_case"
+ test/Nirum/Constructs/ModulePathSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.Constructs.ModulePathSpec where++import Control.Exception (evaluate)+import GHC.Exts (IsList(fromList, toList))++import System.FilePath ((</>))+import Test.Hspec.Meta++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.ModulePath ( ModulePath(ModuleName, ModulePath)+                                   , ancestors+                                   , fromFilePath+                                   , fromIdentifiers+                                   )++spec :: Spec+spec =+    describe "ModulePath" $ do+        let foo = ModuleName "foo"+            fooBar = ModulePath (ModuleName "foo") "bar"+            fooBarBaz = ModulePath (ModulePath (ModuleName "foo") "bar") "baz"+            fooBarBaz2 = ModulePath (ModuleName "foo") "bar-baz2"+        specify "fromIdentifiers" $ do+            fromIdentifiers [] `shouldBe` Nothing+            fromIdentifiers ["foo"] `shouldBe` Just foo+            fromIdentifiers ["Foo"] `shouldBe` Just foo+            fromIdentifiers ["FOO"] `shouldBe` Just foo+            fromIdentifiers ["foo", "bar"] `shouldBe` Just fooBar+            fromIdentifiers ["foo", "bar", "baz"] `shouldBe` Just fooBarBaz+            fromIdentifiers ["Foo", "BAR", "baZ"] `shouldBe` Just fooBarBaz+            fromIdentifiers ["foo", "bar-baz2"] `shouldBe` Just fooBarBaz2+            fromIdentifiers ["FOO", "bar_baz2"] `shouldBe` Just fooBarBaz2+        specify "fromFilePath" $ do+            fromFilePath "" `shouldBe` Nothing+            fromFilePath "foo.nrm" `shouldBe` Just foo+            fromFilePath "FOO.NRM" `shouldBe` Just foo+            fromFilePath "Foo.Nrm" `shouldBe` Just foo+            fromFilePath ("foo" </> "bar.nrm") `shouldBe` Just fooBar+            fromFilePath ("FOO" </> "bar.NRM") `shouldBe` Just fooBar+            fromFilePath ("foo" </> "bar" </> "baz.nrm") `shouldBe`+                Just fooBarBaz+            fromFilePath ("foo" </> "BAR" </> "baz.nrm") `shouldBe`+                Just fooBarBaz+            fromFilePath ("foo" </> "bar-baz2.nrm") `shouldBe` Just fooBarBaz2+            fromFilePath ("foo" </> "bar_baz2.NRM") `shouldBe` Just fooBarBaz2+        specify "ancestors" $ do+            ancestors ["foo", "bar", "baz"] `shouldBe`+                [ ["foo"]+                , ["foo", "bar"]+                , ["foo", "bar", "baz"]+                ]+            ancestors ["foo"] `shouldBe` [["foo"]]+        context "Construct" $+            specify "toCode" $ do+                toCode foo `shouldBe` "foo"+                toCode fooBar `shouldBe` "foo.bar"+                toCode fooBarBaz `shouldBe` "foo.bar.baz"+                toCode fooBarBaz2 `shouldBe` "foo.bar-baz2"+        context "IsList" $ do+            specify "fromList" $ do+                evaluate (fromList [] :: ModulePath) `shouldThrow`+                    errorCall "ModulePath cannot be empty"+                fromList ["foo"] `shouldBe` foo+                fromList ["foo", "bar"] `shouldBe` fooBar+                fromList ["foo", "bar", "baz"] `shouldBe` fooBarBaz+                fromList ["foo", "bar-baz2"] `shouldBe` fooBarBaz2+            specify "toList" $ do+                toList foo `shouldBe` ["foo"]+                toList fooBar `shouldBe` ["foo", "bar"]+                toList fooBarBaz `shouldBe` ["foo", "bar", "baz"]+                toList fooBarBaz2 `shouldBe` ["foo", "bar-baz2"]
+ test/Nirum/Constructs/ModuleSpec.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings, QuasiQuotes #-}+module Nirum.Constructs.ModuleSpec where++import Test.Hspec.Meta+import Text.InterpolatedString.Perl6 (q)++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Annotation (empty)+import Nirum.Constructs.DeclarationSet (DeclarationSet)+import Nirum.Constructs.Module (Module(..), imports)+import Nirum.Constructs.TypeDeclaration ( Type(..)+                                        , TypeDeclaration( Import+                                                         , TypeDeclaration+                                                         )+                                        )++spec :: Spec+spec =+    describe "Module" $ do+        let pathT = TypeDeclaration "path" (Alias "text")+                                    (Just "path string") empty+            offsetT =+                TypeDeclaration "offset" (BoxedType "float64") Nothing empty+            decls = [ Import ["foo", "bar"] "baz"+                    , Import ["foo", "bar"] "qux"+                    , Import ["zzz"] "qqq"+                    , Import ["zzz"] "ppp"+                    , Import ["xyz"] "asdf"+                    , pathT+                    , offsetT+                    ] :: DeclarationSet TypeDeclaration+            mod1 = Module decls Nothing+            mod2 = Module decls $ Just "module level docs...\nblahblah"+        specify "imports" $ do+            imports mod1 `shouldBe` [ (["foo", "bar"], ["baz", "qux"])+                                    , (["xyz"], ["asdf"])+                                    , (["zzz"], ["qqq", "ppp"])+                                    ]+            imports mod2 `shouldBe` imports mod1+        specify "toCode" $ do+            toCode mod1 `shouldBe` [q|import foo.bar (baz, qux);+import xyz (asdf);+import zzz (ppp, qqq);++type path = text;+# path string++boxed offset (float64);+|]+            toCode mod2 `shouldBe` [q|# module level docs...+# blahblah+import foo.bar (baz, qux);+import xyz (asdf);+import zzz (ppp, qqq);++type path = text;+# path string++boxed offset (float64);+|]
+ test/Nirum/Constructs/NameSpec.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.NameSpec where++import Test.Hspec.Meta++import Nirum.Constructs.Name (Name(Name), isComplex, isSimple, toCode)++spec :: Spec+spec =+    describe "Name" $ do+        describe "toCode Name" $ do+            it "prints only its facialName if its behindName is the same" $+                toCode (Name "a" "a") `shouldBe` "a"+            it "prints only facialName with behindName if they are not same" $+                toCode (Name "a" "b") `shouldBe` "a/b"+        specify "fromString" $+            ("foo" :: Name) `shouldBe` Name "foo" "foo"+        specify "isSimple" $ do+            Name "foo" "foo" `shouldSatisfy` isSimple+            Name "foo" "bar" `shouldNotSatisfy` isSimple+        specify "isComplex" $ do+            Name "foo" "bar" `shouldSatisfy` isComplex+            Name "foo" "foo" `shouldNotSatisfy` isComplex
+ test/Nirum/Constructs/TypeDeclarationSpec.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.Constructs.TypeDeclarationSpec where++import Data.Either (rights)+import qualified Data.Text as T+import Test.Hspec.Meta++import Nirum.Constructs (Construct(toCode))+import Nirum.Constructs.Annotation ( Annotation (Annotation)+                                   , AnnotationSet+                                   ,  fromList+                                   , empty+                                   )+import Nirum.Constructs.Declaration (Declaration(name, docs))+import Nirum.Constructs.DeclarationSet (DeclarationSet)+import Nirum.Constructs.Service (Method(Method), Service(Service))+import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember)+                                        , Field(Field)+                                        , JsonType(String)+                                        , PrimitiveTypeIdentifier(Text)+                                        , Tag(Tag)+                                        , Type(..)+                                        , TypeDeclaration(..)+                                        )++barAnnotationSet :: AnnotationSet+barAnnotationSet = head $ rights [fromList [Annotation "bar" (Just "baz")]]++spec :: Spec+spec = do+    describe "TypeDeclaration" $ do+        context "Alias" $ do+            let alias = Alias "text"+                a = TypeDeclaration { typename = "path"+                                    , type' = alias+                                    , typeDocs = Nothing+                                    , typeAnnotations = empty+                                    }+                b = a { typeDocs = Just "docs"}+            specify "name" $ do+                name a `shouldBe` "path"+                name b `shouldBe` "path"+            specify "docs" $ do+                docs a `shouldBe` Nothing+                docs b `shouldBe` Just "docs"+            specify "toCode" $ do+                toCode a `shouldBe` "type path = text;"+                toCode b `shouldBe` "type path = text;\n# docs"+        context "BoxedType" $ do+            let boxed = BoxedType "float64"+                a = TypeDeclaration { typename = "offset"+                                    , type' = boxed+                                    , typeDocs = Nothing+                                    , typeAnnotations = empty+                                    }+                b = a { typeDocs = Just "docs" }+            specify "name" $ do+                name a `shouldBe` "offset"+                name b `shouldBe` "offset"+            specify "docs" $ do+                docs a `shouldBe` Nothing+                docs b `shouldBe` Just "docs"+            specify "toCode" $ do+                toCode a `shouldBe` "boxed offset (float64);"+                toCode b `shouldBe` "boxed offset (float64);\n# docs"+        context "EnumType" $ do+            let enumMembers = [ EnumMember "kr" Nothing+                              , EnumMember "jp" $ Just "Japan"+                              , EnumMember "us" $ Just "United States"+                              ] :: DeclarationSet EnumMember+                enum = EnumType enumMembers+                a = TypeDeclaration { typename = "country"+                                    , type' = enum+                                    , typeDocs = Nothing+                                    , typeAnnotations = empty+                                    }+                b = a { typeDocs = Just "country codes" }+            specify "toCode" $ do+                toCode a `shouldBe` "enum country\n\+                                    \    = kr\n\+                                    \    | jp\n\+                                    \    # Japan\n\+                                    \    | us\n\+                                    \    # United States\n\+                                    \    ;"+                toCode b `shouldBe` "enum country\n\+                                    \    # country codes\n\+                                    \    = kr\n\+                                    \    | jp\n\+                                    \    # Japan\n\+                                    \    | us\n\+                                    \    # United States\n\+                                    \    ;"+        context "RecordType" $ do+            let fields' = [ Field "name" "text" Nothing+                          , Field "dob" "date" $ Just "date of birth"+                          , Field "gender" "gender" Nothing+                          ] :: DeclarationSet Field+                record = RecordType fields'+                a = TypeDeclaration { typename = "person"+                                    , type' = record+                                    , typeDocs = Nothing+                                    , typeAnnotations = empty+                                    }+                b = a { typeDocs = Just "person record type" }+            specify "toCode" $ do+                toCode a `shouldBe` "record person (\n\+                                    \    text name,\n\+                                    \    date dob,\n\+                                    \    # date of birth\n\+                                    \    gender gender,\n\+                                    \);"+                toCode b `shouldBe` "record person (\n\+                                    \    # person record type\n\n\+                                    \    text name,\n\+                                    \    date dob,\n\+                                    \    # date of birth\n\+                                    \    gender gender,\n\+                                    \);"+        context "UnionType" $ do+            let circleFields = [ Field "origin" "point" Nothing+                               , Field "radius" "offset" Nothing+                               ]+                rectangleFields = [ Field "upper-left" "point" Nothing+                                  , Field "lower-right" "point" Nothing+                                  ]+                tags' = [ Tag "circle" circleFields Nothing+                        , Tag "rectangle" rectangleFields Nothing+                        , Tag "none" [] Nothing+                        ]+                union = UnionType tags'+                a = TypeDeclaration { typename = "shape"+                                    , type' = union+                                    , typeDocs = Nothing+                                    , typeAnnotations = empty+                                    }+                b = a { typeDocs = Just "shape type" }+            specify "toCode" $ do+                toCode a `shouldBe` "union shape\n\+                                    \    = circle (point origin, \+                                                  \offset radius,)\n\+                                    \    | rectangle (point upper-left, \+                                                     \point lower-right,)\n\+                                    \    | none\n\+                                    \    ;"+                toCode b `shouldBe` "union shape\n\+                                    \    # shape type\n\+                                    \    = circle (point origin, \+                                                  \offset radius,)\n\+                                    \    | rectangle (point upper-left, \+                                                     \point lower-right,)\n\+                                    \    | none\n\+                                    \    ;"+        context "PrimitiveType" $ do+            let primitiveType = PrimitiveType Text String+                decl = TypeDeclaration "text" primitiveType Nothing empty+            specify "toCode" $+                T.lines (toCode decl) `shouldSatisfy`+                    all (T.isPrefixOf "//" . T.stripStart)+        context "ServiceDeclaration" $ do+            let nullService = Service []+                nullDecl = ServiceDeclaration "null-service" nullService Nothing+                                              empty+                nullDecl' =+                    ServiceDeclaration "null-service" nullService+                                       (Just "Null service declaration.")+                                       empty+                pingService = Service [ Method "ping" [] "bool" Nothing Nothing empty ]+                pingDecl = ServiceDeclaration "ping-service" pingService Nothing+                                              empty+                pingDecl' =+                    ServiceDeclaration "ping-service" pingService+                                       (Just "Ping service declaration.")+                                       empty+                annoDecl = ServiceDeclaration "anno-service" pingService+                                              Nothing barAnnotationSet+            specify "toCode" $ do+                toCode nullDecl `shouldBe` "service null-service ();"+                toCode nullDecl' `shouldBe` "service null-service (\n\+                                            \    # Null service declaration.\n\+                                            \);"+                toCode pingDecl `shouldBe`+                    "service ping-service (bool ping ());"+                toCode pingDecl' `shouldBe`+                    "service ping-service (\n\+                    \    # Ping service declaration.\n\+                    \    bool ping ()\n\+                    \);"+                toCode annoDecl `shouldBe`+                    "@bar(\"baz\")\n\+                    \service anno-service (bool ping ());"+                -- TODO: more tests+        context "Import" $ do+            let import' = Import ["foo", "bar"] "baz"+            specify "name" $+                name import' `shouldBe` "baz"+            specify "docs" $+                docs import' `shouldBe` Nothing+            specify "toCode" $+                toCode import' `shouldBe` "import foo.bar (baz);\n"+    describe "EnumMember" $ do+        let kr = EnumMember "kr" Nothing+            jp = EnumMember "jp" $ Just "Japan"+        specify "toCode" $ do+            toCode kr `shouldBe` "kr"+            toCode jp `shouldBe` "jp\n# Japan"+        specify "fromString" $+            "test" `shouldBe` EnumMember "test" Nothing+    describe "Field" $+        specify "toCode" $ do+            toCode (Field "name" "text" Nothing) `shouldBe` "text name,"+            toCode (Field "dob" "date" $ Just "date of birth") `shouldBe`+                "date dob,\n# date of birth"+    describe "Tag" $+        specify "toCode" $ do+            let fields' = [ Field "origin" "point" Nothing+                          , Field "radius" "offset" Nothing+                          ]+            toCode (Tag "circle" fields' Nothing)+                `shouldBe` "circle (point origin, offset radius,)"+            toCode (Tag "circle" fields' $ Just "docs")+                `shouldBe` "circle (point origin, offset radius,)\n# docs"+            toCode (Tag "unit" [] Nothing) `shouldBe` "unit"+            toCode (Tag "unit" [] $ Just "docs") `shouldBe` "unit\n# docs"
+ test/Nirum/Constructs/TypeExpressionSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.Constructs.TypeExpressionSpec where++import Test.Hspec.Meta++import Nirum.Constructs.TypeExpression (TypeExpression(..), toCode)++spec :: Spec+spec =+    describe "toCode TypeExpression" $ do+        context "TypeIdentifier" $+            it "reverses the given tree to the code string" $ do+                toCode (TypeIdentifier "text") `shouldBe` "text"+                toCode (TypeIdentifier "enum") `shouldBe` "`enum`"+        context "OptionModifier" $+            it "reverses the given tree to the code string" $ do+                toCode (OptionModifier "text") `shouldBe` "text?"+                toCode (OptionModifier $ SetModifier "text")+                    `shouldBe` "{text}?"+        context "SetModifier" $+            it "reverses the given tree to the code string" $ do+                toCode (SetModifier "text") `shouldBe` "{text}"+                toCode (SetModifier $ OptionModifier "text")+                    `shouldBe` "{text?}"+        context "ListModifier" $+            it "reverses the given tree to the code string" $+                toCode (ListModifier "text") `shouldBe` "[text]"+        context "MapModifier" $+            it "reverses the given tree to the code string" $ do+                toCode (MapModifier "uuid" "text") `shouldBe` "{uuid: text}"+                toCode (MapModifier "uuid" $ ListModifier "text")+                    `shouldBe` "{uuid: [text]}"
+ test/Nirum/PackageSpec.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module Nirum.PackageSpec where++import qualified Data.Map.Strict as M+import System.FilePath ((</>))+import Test.Hspec.Meta++import Nirum.Constructs.Annotation (empty)+import Nirum.Constructs.Module (Module(Module), coreModulePath)+import Nirum.Constructs.ModulePath (ModulePath)+import Nirum.Constructs.TypeDeclaration ( JsonType(String)+                                        , PrimitiveTypeIdentifier(Text)+                                        , Type(Alias, PrimitiveType)+                                        , TypeDeclaration ( Import+                                                          , TypeDeclaration+                                                          )+                                        )+import Nirum.Package ( BoundModule(boundPackage, modulePath)+                     , ImportError ( CircularImportError+                                   , MissingImportError+                                   , MissingModulePathError+                                   )+                     , Package+                     , PackageError (ImportError)+                     , TypeLookup(Imported, Local, Missing)+                     , docs+                     , lookupType+                     , makePackage+                     , resolveBoundModule+                     , resolveModule+                     , scanModules+                     , scanPackage+                     , types+                     )+import Nirum.Parser (parseFile)++createPackage :: M.Map ModulePath Module -> Package+createPackage modules' =+    case makePackage modules' of+        Right pkg -> pkg+        Left e -> error $ "errored: " ++ show e++validPackage :: Package+validPackage =+    createPackage [ (["foo", "bar"], Module [] $ Just "foo.bar")+                  , (["foo", "baz"], Module [] $ Just "foo.baz")+                  , (["foo"],        Module [] $ Just "foo")+                  , (["qux"],        Module [] $ Just "qux")+                  , ( ["abc"]+                    , Module [TypeDeclaration "a" (Alias "text") Nothing empty]+                             Nothing+                    )+                  , ( ["xyz"]+                    , Module [ Import ["abc"] "a"+                             , TypeDeclaration "x" (Alias "text") Nothing empty+                             ] Nothing+                    )+                  ]++missingImportsModules :: M.Map ModulePath Module+missingImportsModules =+    [ (["foo"], Module [ Import ["foo", "bar"] "xyz" -- MissingModulePathError+                       , Import ["foo", "bar"] "zzz" -- MissingModulePathError+                       , Import ["baz"] "qux"+                       ] Nothing)+    , ( ["baz"]+      , Module [ TypeDeclaration "qux" (Alias "text") Nothing empty ] Nothing+      )+    , (["qux"], Module [ Import ["foo"] "abc" -- MissingImportError+                       , Import ["foo"] "def" -- MissingImportError+                       ] Nothing)+    ]++circularImportsModules :: M.Map ModulePath Module+circularImportsModules =+    [ (["asdf"], Module [ Import ["asdf"] "foo"+                        , TypeDeclaration "bar" (Alias "text") Nothing empty+                        ] Nothing)+    , (["abc", "def"], Module [ Import ["abc", "ghi"] "bar"+                              , TypeDeclaration+                                    "foo" (Alias "text") Nothing empty+                              ] Nothing)+    , (["abc", "ghi"], Module [ Import ["abc", "xyz"] "baz"+                              , TypeDeclaration+                                    "bar" (Alias "text") Nothing empty+                              ] Nothing)+    , (["abc", "xyz"], Module [ Import ["abc", "def"] "foo"+                              , TypeDeclaration+                                    "baz" (Alias "text") Nothing empty+                              ] Nothing)+    ]++spec :: Spec+spec = do+    describe "Package" $ do+        specify "resolveModule" $ do+            resolveModule ["foo"] validPackage `shouldBe`+                Just (Module [] $ Just "foo")+            resolveModule ["foo", "bar"] validPackage `shouldBe`+                Just (Module [] $ Just "foo.bar")+            resolveModule ["qux"] validPackage `shouldBe`+                Just (Module [] $ Just "qux")+            resolveModule ["baz"] validPackage `shouldBe` Nothing+        specify "resolveBoundModule" $ do+            let Just bm = resolveBoundModule ["foo"] validPackage+            boundPackage bm `shouldBe` validPackage+            modulePath bm `shouldBe` ["foo"]+            resolveBoundModule ["baz"] validPackage `shouldBe` Nothing+        specify "detectMissingImports" $+            makePackage missingImportsModules `shouldBe`+                Left [ MissingModulePathError ["foo"] ["foo", "bar"]+                     , MissingImportError ["qux"] ["foo"] "abc"+                     , MissingImportError ["qux"] ["foo"] "def"+                     ]+        specify "detectCircularImports" $+            makePackage circularImportsModules `shouldBe`+                Left [ CircularImportError [["asdf"], ["asdf"]]+                     , MissingImportError ["asdf"] ["asdf"] "foo"+                     , CircularImportError [ ["abc", "def"]+                                           , ["abc", "ghi"]+                                           , ["abc", "xyz"]+                                           , ["abc", "def"]+                                           ]+                     , CircularImportError [ ["abc", "ghi"]+                                           , ["abc", "xyz"]+                                           , ["abc", "def"]+                                           , ["abc", "ghi"]+                                           ]+                     , CircularImportError [ ["abc", "xyz"]+                                           , ["abc", "def"]+                                           , ["abc", "ghi"]+                                           , ["abc", "xyz"]+                                           ]+                     ]+        specify "scanPackage" $ do+            let path = "." </> "examples"+            Right package <- scanPackage path+            Right builtinsM <- parseFile (path </> "builtins.nrm")+            Right productM <- parseFile (path </> "product.nrm")+            Right shapesM <- parseFile (path </> "shapes.nrm")+            Right countriesM <- parseFile (path </> "countries.nrm")+            Right addressM <- parseFile (path </> "address.nrm")+            Right pdfServiceM <- parseFile (path </> "pdf-service.nrm")+            let modules = [ (["builtins"], builtinsM)+                          , (["product"], productM)+                          , (["shapes"], shapesM)+                          , (["countries"], countriesM)+                          , (["address"], addressM)+                          , (["pdf-service"], pdfServiceM)+                          ] :: M.Map ModulePath Module+            package `shouldBe` createPackage modules+            Left error' <- scanPackage $ "." </> "test" </> "import_error"+            error' `shouldBe`+                ImportError [MissingModulePathError ["import_error"] ["foo"]]+        specify "scanModules" $ do+            let path = "." </> "examples"+            mods <- scanModules "."+            mods `shouldBe`+                [ (["examples", "builtins"], path </> "builtins.nrm")+                , (["examples", "product"], path </> "product.nrm")+                , (["examples", "shapes"], path </> "shapes.nrm")+                , (["examples", "countries"], path </> "countries.nrm")+                , (["examples", "address"], path </> "address.nrm")+                , (["examples", "pdf-service"], path </> "pdf-service.nrm")+                , ( ["test", "import_error", "import_error"]+                  , "." </> "test" </> "import_error" </> "import_error.nrm"+                  )+                ]+            mods' <- scanModules path+            mods' `shouldBe` [ (["builtins"], path </> "builtins.nrm")+                             , (["product"], path </> "product.nrm")+                             , (["shapes"], path </> "shapes.nrm")+                             , (["countries"], path </> "countries.nrm")+                             , (["address"], path </> "address.nrm")+                             , (["pdf-service"], path </> "pdf-service.nrm")+                             ]+    describe "BoundModule" $ do+        let Just bm = resolveBoundModule ["foo", "bar"] validPackage+            Just abc = resolveBoundModule ["abc"] validPackage+            Just xyz = resolveBoundModule ["xyz"] validPackage+        specify "docs" $ do+            docs bm `shouldBe` Just "foo.bar"+            let Just bm' = resolveBoundModule ["foo"] validPackage+            docs bm' `shouldBe` Just "foo"+        specify "types" $ do+            types bm `shouldBe` []+            types abc `shouldBe` [TypeDeclaration+                                      "a" (Alias "text") Nothing empty]+            types xyz `shouldBe` [ Import ["abc"] "a"+                                 , TypeDeclaration+                                       "x" (Alias "text") Nothing empty+                                 ]+        specify "lookupType" $ do+            lookupType "a" bm `shouldBe` Missing+            lookupType "a" abc `shouldBe` Local (Alias "text")+            lookupType "a" xyz `shouldBe` Imported ["abc"] (Alias "text")+            lookupType "x" bm `shouldBe` Missing+            lookupType "x" abc `shouldBe` Missing+            lookupType "x" xyz `shouldBe` Local (Alias "text")+            lookupType "text" bm `shouldBe`+                Imported coreModulePath (PrimitiveType Text String)+            lookupType "text" abc `shouldBe` lookupType "text" bm+            lookupType "text" xyz `shouldBe` lookupType "text" bm
+ test/Nirum/ParserSpec.hs view
@@ -0,0 +1,896 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings, TypeFamilies #-}+module Nirum.ParserSpec where++import Control.Monad (forM_)+import Data.Either (isLeft, isRight, lefts, rights)+import Data.List (isSuffixOf)+import Data.Maybe (fromJust)+import Prelude hiding (readFile)+import System.Directory (getDirectoryContents)++import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Data.Text.IO (readFile)+import Test.Hspec.Meta+import Text.Megaparsec (eof, runParser)+import Text.Megaparsec.Char (string)+import Text.Megaparsec.Error (errorPos, parseErrorPretty)+import Text.Megaparsec.Pos (Pos, SourcePos(sourceColumn, sourceLine), mkPos)+import Text.Megaparsec.Text (Parser)++import qualified Nirum.Parser as P+import Nirum.Constructs (Construct (toCode))+import Nirum.Constructs.Annotation ( Annotation (Annotation)+                                   , AnnotationSet+                                   , empty+                                   , fromList+                                   )+import Nirum.Constructs.Declaration (Docs (Docs))+import Nirum.Constructs.DeclarationSet (DeclarationSet)+import Nirum.Constructs.DeclarationSetSpec (SampleDecl(..))+import Nirum.Constructs.Identifier (fromText)+import Nirum.Constructs.Module (Module (Module))+import Nirum.Constructs.Name (Name(..))+import Nirum.Constructs.Service ( Method (Method)+                                , Parameter (Parameter)+                                , Service (Service)+                                )+import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)+                                        , Field (Field)+                                        , Tag (Tag)+                                        , Type (..)+                                        , TypeDeclaration (..)+                                        )+import Nirum.Constructs.TypeExpression (TypeExpression (..))++shouldBeRight :: (Eq l, Eq r, Show l, Show r) => Either l r -> r -> Expectation+shouldBeRight actual expected = actual `shouldBe` Right expected++erroredPos :: Either P.ParseError a -> (Pos, Pos)+erroredPos left =+    (sourceLine pos, sourceColumn pos)+  where+    error' = head $ lefts [left] :: P.ParseError+    pos = NE.head (errorPos error') :: SourcePos++helperFuncs :: (Show a)+            => Parser a+            -> ( T.Text -> Either P.ParseError a+               , T.Text -> Int -> Int -> Expectation+               )+helperFuncs parser =+    (parse', expectError)+  where+    parserAndEof = do+        r <- parser+        eof+        return r+    parse' = runParser parserAndEof ""+    expectError inputString line col = do+        line' <- mkPos line+        col' <- mkPos col+        let parseResult = parse' inputString+        parseResult `shouldSatisfy` isLeft+        erroredPos parseResult `shouldBe` (line', col')+++fooAnnotationSet :: AnnotationSet+fooAnnotationSet = head $ rights [fromList [Annotation "foo" (Just "bar")]]++bazAnnotationSet :: AnnotationSet+bazAnnotationSet = head $ rights [fromList [Annotation "baz" Nothing]]+++spec :: Spec+spec = do+    describe "identifier" $ do+        let (parse', expectError) = helperFuncs P.identifier+        it "fails to parse an empty string" $+            expectError "" 1 1+        it "fails to parse an identifier starting with hyphen/underscore" $ do+            expectError "-ident" 1 1+            expectError "-ident-ifier" 1 1+            expectError "_ident" 1 1+            expectError "_ident_ifier" 1 1+            expectError "_ident-ifier" 1 1+            expectError "-ident_ifier" 1 1+        it "fails to parse an identifier ending with hyphen/underscore" $ do+            expectError "ident-" 1 7+            expectError "ident-ifier-" 1 13+            expectError "ident_" 1 7+            expectError "ident_ifier_" 1 13+            expectError "ident_ifier-" 1 13+            expectError "ident-ifier_" 1 13+        it "fails to parse an identifier with double hyphens/underscores" $ do+            expectError "ident--ifier" 1 7+            expectError "ident__ifier" 1 7+            expectError "ident-_ifier" 1 7+            expectError "ident_-ifier" 1 7+        it "fails to parse an identifier containing disallowed chars" $ do+            expectError "무효한-식별자" 1 1+            expectError "invalid-식별자" 1 9+        let keywords = [ "boxed", "enum", "record", "type", "union"+                       , "BOXED", "Enum", "rEcord", "tyPE", "unioN"+                       ] :: [T.Text]+        it "fails to parse bare identifier if it's a reserved keyword" $+            forM_ keywords $ \kwd ->+                expectError kwd 1 1+        let identifier' = fromJust . fromText+        it "emits Identifier if succeeded to parse" $ do+            parse' "identifier" `shouldBeRight` identifier' "identifier"+            parse' "valid-identifier" `shouldBeRight`+                identifier' "valid-identifier"+            parse' "valid_identifier" `shouldBeRight`+                identifier' "valid_identifier"+        it "can parse reserved keywords iff they are quoted" $+            forM_ keywords $ \kwd ->+                parse' ('`' `T.cons` kwd `T.snoc` '`') `shouldBeRight`+                    identifier' kwd++    describe "name" $ do+        let (parse', expectError) = helperFuncs P.name+        it "fails to parse an empty string" $+            expectError "" 1 1+        it "fails to parse if the name is not a valid identifier" $ do+            expectError "-ident" 1 1+            expectError "-ident-ifier" 1 1+            expectError "ident-" 1 7+            expectError "ident-ifier-" 1 13+            expectError "ident--ifier" 1 7+            expectError "ident__ifier" 1 7+            expectError "무효한-식별자" 1 1+            expectError "invalid-식별자" 1 9+        it "fails to parse if the facial name is not a valid identifier" $ do+            expectError "-ident/valid" 1 1+            expectError "-ident-ifier/valid" 1 1+            expectError "ident-/valid" 1 7+            expectError "ident-ifier-/valid" 1 13+            expectError "ident--ifier/valid" 1 7+            expectError "ident__ifier/valid" 1 7+            expectError "무효한-식별자/valid" 1 1+            expectError "invalid-식별자/valid" 1 9+        it "fails to parse if the behind name is not a valid identifier" $ do+            expectError "valid/-ident" 1 6+            expectError "valid/-ident-ifier" 1 6+            expectError "valid/ident-" 1 6+            expectError "valid/ident-ifier-" 1 6+            expectError "valid/ident--ifier" 1 6+            expectError "valid/ident__ifier" 1 6+            expectError "valid/무효한-식별자" 1 6+            expectError "valid/invalid-식별자" 1 6+        it "emits Name if succeeded to parse" $ do+            parse' "name" `shouldBeRight` Name "name" "name"+            parse' "`enum`" `shouldBeRight` Name "enum" "enum"+            parse' "facial/behind" `shouldBeRight` Name "facial" "behind"+            parse' "facial / behind" `shouldBeRight` Name "facial" "behind"+            parse' "`enum`/`boxed`" `shouldBeRight` Name "enum" "boxed"+            parse' "`enum` / `boxed`" `shouldBeRight` Name "enum" "boxed"++    describe "annotation" $ do+        let (parse', expectError) = helperFuncs P.annotation+        context "with single argument" $ do+            let rightAnnotaiton = Annotation "name-abc" (Just "wo\"rld")+            it "success" $ do+                parse' "@name-abc(\"wo\\\"rld\")" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc( \"wo\\\"rld\")" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc(\"wo\\\"rld\" )" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc( \"wo\\\"rld\" )" `shouldBeRight` rightAnnotaiton+                parse' "@ name-abc ( \"wo\\\"rld\")" `shouldBeRight`+                    rightAnnotaiton+                parse' "@name-abc ( \"wo\\\"rld\")" `shouldBeRight` rightAnnotaiton+            it "fails to parse if annotation name start with hyphen" $ do+                expectError "@-abc(\"helloworld\")" 1 2+                expectError "@-abc-d(\"helloworld\")" 1 2+            it "fails to parse without parentheses" $+                expectError "@foobar \"helloworld\"" 1 9+            it "fails to parse without double quotes" $+                expectError "@foobar(helloworld)" 1 9+        context "without arguments" $ do+            let rightAnnotaiton = Annotation "name-abc" Nothing+            it "success" $ do+                parse' "@name-abc" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc " `shouldBeRight` rightAnnotaiton+                parse' "@ name-abc" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc()" `shouldBeRight` rightAnnotaiton+                parse' "@name-abc ( )" `shouldBeRight` rightAnnotaiton+                parse' "@ name-abc ( )" `shouldBeRight` rightAnnotaiton+            it "fails to parse if annotation name start with hyphen" $ do+                expectError "@-abc" 1 2+                expectError "@-abc-d" 1 2++    describe "annotationSet" $ do+        let (parse', expectError) = helperFuncs P.annotationSet+            annotationSet = head $ rights [fromList [ Annotation "a" (Just "b")+                                                    , Annotation "c" Nothing+                                                    ]+                                          ]+        it "success" $ do+            parse' "@a(\"b\")@c" `shouldBeRight` annotationSet+            parse' "@a(\"b\") @c" `shouldBeRight` annotationSet+            parse' "@a(\"b\") @c() " `shouldBeRight` annotationSet+        it "fails to parse if has duplicated name" $+            expectError "@a(\"b\")@a" 1 10++    describe "typeIdentifier" $ do+        let (parse', expectError) = helperFuncs P.typeIdentifier+        it "fails to parse if the input is not a valid identifier" $+            expectError "-invalid-type-identifier" 1 1+        it "emits TypeIdentifier if succeeded to parse" $ do+            parse' "text" `shouldBeRight` TypeIdentifier "text"+            parse' "uuid" `shouldBeRight` TypeIdentifier "uuid"++    describe "optionModifier" $ do+        let (_, expectError') = helperFuncs P.optionModifier+        it "fails to parse if the input lacks a question mark" $+            expectError' "lacks-qmark" 1 12+        let parsers = [ P.optionModifier+                      , P.typeExpression+                      ] :: [Parser TypeExpression]+        forM_ parsers $ \parser' -> do+            let (parse', expectError) = helperFuncs parser'+            it "cannot append two or more option modifiers" $ do+                expectError "text??" 1 6+                expectError "text???" 1 6+                expectError "text????" 1 6+            it "emits OptionModifier if succeeded to parse" $ do+                parse' "text?" `shouldBeRight`+                    OptionModifier (TypeIdentifier "text")+                parse' "uuid ?" `shouldBeRight`+                    OptionModifier (TypeIdentifier "uuid")+                parse' "{text}?" `shouldBeRight`+                    OptionModifier (SetModifier $ TypeIdentifier "text")+            it "can be appended to set modifier" $+                parse' "{text}?" `shouldBeRight`+                    OptionModifier (SetModifier $ TypeIdentifier "text")++    describe "setModifier" $ do+        let parsers = [ (1, P.setModifier)+                      , (29, P.typeExpression)+                      ] :: [(Int, Parser TypeExpression)]+        forM_ parsers $ \(beginErrorPos, parser') -> do+            let (parse', expectError) = helperFuncs parser'+            it "fails to parse if input doesn't start with a curly bracket" $+                expectError "not-start-with-curly-bracket}" 1 beginErrorPos+            it "fails to parse if input doesn't end with a curly bracket" $+                expectError "{not-end-with-curly-bracket" 1 28+            it "emits SetModifier if succeeded to parse" $ do+                parse' "{text}" `shouldBeRight`+                    SetModifier (TypeIdentifier "text")+                parse' "{ uuid }" `shouldBeRight`+                    SetModifier (TypeIdentifier "uuid")+            it "can be nested to represent 2d set" $ do+                parse' "{{text}}" `shouldBeRight`+                    SetModifier (SetModifier $ TypeIdentifier "text")+                parse' "{[text]}" `shouldBeRight`+                    SetModifier (ListModifier $ TypeIdentifier "text")+            it "can consist of optional elements" $+                parse' "{uuid?}" `shouldBeRight`+                    SetModifier (OptionModifier $ TypeIdentifier "uuid")++    describe "listModifier" $ do+        let parsers = [ (1, P.listModifier)+                      , (30, P.typeExpression)+                      ] :: [(Int, Parser TypeExpression)]+        forM_ parsers $ \(beginErrorPos, parser') -> do+            let (parse', expectError) = helperFuncs parser'+            it "fails to parse if input doesn't start with a square bracket" $+                expectError "not-start-with-square-bracket]" 1 beginErrorPos+            it "fails to parse if input doesn't end with a square bracket" $+                expectError "[not-end-with-square-bracket" 1 29+            it "emits ListModifier if succeeded to parse" $ do+                parse' "[text]" `shouldBeRight`+                    ListModifier (TypeIdentifier "text")+                parse' "[ uuid ]" `shouldBeRight`+                    ListModifier (TypeIdentifier "uuid")+            it "can be nested to represent 2d list" $ do+                parse' "[[text]]" `shouldBeRight`+                    ListModifier (ListModifier $ TypeIdentifier "text")+                parse' "[{text}]" `shouldBeRight`+                    ListModifier (SetModifier $ TypeIdentifier "text")+            it "can consist of optional elements" $+                parse' "[uuid?]" `shouldBeRight`+                    ListModifier (OptionModifier $ TypeIdentifier "uuid")++    describe "mapModifier" $ do+        let parsers = [ (1, P.mapModifier)+                      , (15, P.typeExpression)+                      ] :: [(Int, Parser TypeExpression)]+        forM_ parsers $ \(beginErrorPos, parser') -> do+            let (parse', expectError) = helperFuncs parser'+            it "fails to parse if input doesn't start with a curly bracket" $+                expectError "not-start-with: curly-bracket}" 1 beginErrorPos+            it "fails to parse if input doesn't end with a curly bracket" $+                expectError "{not-end-with: curly-bracket" 1 29+            it "emits MapModifier if succeeded to parse" $ do+                parse' "{uuid: text}" `shouldBeRight`+                    MapModifier (TypeIdentifier "uuid") (TypeIdentifier "text")+                parse' "{ text : uuid }" `shouldBeRight`+                    MapModifier (TypeIdentifier "text") (TypeIdentifier "uuid")+            it "can be nested to represent 2d map" $ do+                parse' "{uuid: {uuid: text}}" `shouldBeRight`+                    MapModifier (TypeIdentifier "uuid")+                                (MapModifier (TypeIdentifier "uuid")+                                             (TypeIdentifier "text"))+                parse' "{uuid: [text]}" `shouldBeRight`+                    MapModifier (TypeIdentifier "uuid")+                                (ListModifier $ TypeIdentifier "text")++    describe "typeExpression" $ do+        let (_, expectError) = helperFuncs P.typeExpression+        it "cannot append two or more option modifiers" $ do+            expectError "text??" 1 6+            expectError "text???" 1 6+            expectError "text????" 1 6++    describe "docs" $ do+        let (parse', expectError) = helperFuncs P.docs+        it "emits Docs if succeeded to parse" $ do+            parse' "#docs" `shouldBeRight` Docs "docs\n"+            parse' "#docs\n#docs..." `shouldBeRight` Docs "docs\ndocs...\n"+        it "may ignore a leading space" $ do+            parse' "# docs" `shouldBeRight` Docs "docs\n"+            parse' "# docs\n# docs..." `shouldBeRight` Docs "docs\ndocs...\n"+            parse' "#  docs" `shouldBeRight` Docs " docs\n"+            parse' "#  docs\n#  docs..." `shouldBeRight`+                Docs " docs\n docs...\n"+        it "may be mixed with whitespaces" $ do+            parse' "# docs\n\n# docs..." `shouldBeRight` Docs "docs\ndocs...\n"+            parse' "# docs\n    # docs..." `shouldBeRight`+                Docs "docs\ndocs...\n"+        it "differs from comment" $+            expectError "// comment" 1 1++    let descTypeDecl label parser spec' =+            let parsers = [ (label, parser)+                          , (label ++ " (typeDescription)", P.typeDeclaration)+                          ] :: [(String, Parser TypeDeclaration)]+            in forM_ parsers $ \(label', parser') ->+                describe label' $+                    spec' $ helperFuncs parser'++    describe "handleNameDuplication" $ do+        let cont dset = do _ <- string "a"+                           return dset :: Parser (DeclarationSet SampleDecl)+        it "fails if there are any duplication on facial names" $ do+            let ds = [ "a"+                     , "b"+                     , SampleDecl (Name "b" "c") Nothing+                     ] :: [SampleDecl]+                p = P.handleNameDuplication "LABEL" ds cont+                (parse', expectError) = helperFuncs p+            expectError "a" 1 1+            let (Left e) = parse' "a"+            parseErrorPretty e `shouldBe`+                "1:1:\nthe facial LABEL name `b` is duplicated\n"+        it "fails if there are any duplication on behind names" $ do+            let ds = [ "a"+                     , "b"+                     , SampleDecl (Name "c" "b") Nothing+                     ] :: [SampleDecl]+                p = P.handleNameDuplication "LABEL" ds cont+                (parse', expectError) = helperFuncs p+            expectError "a" 1 1+            let (Left e) = parse' "a"+            parseErrorPretty e `shouldBe`+                "1:1:\nthe behind LABEL name `b` is duplicated\n"+        it "continues using the given DeclarationSet if there are no dups" $ do+            let ds = ["a", "b", "c"] :: [SampleDecl]+                p = P.handleNameDuplication "LABEL" ds cont+                (parse', _) = helperFuncs p+            parse' "a" `shouldBeRight`+                (["a", "b", "c"] :: DeclarationSet SampleDecl)++    descTypeDecl "aliasTypeDeclaration" P.aliasTypeDeclaration $ \helpers -> do+        let (parse', expectError) = helpers+        it "emits (TypeDeclaration (Alias ...)) if succeeded to parse" $ do+            parse' "type path = text;" `shouldBeRight`+                TypeDeclaration "path" (Alias "text") Nothing empty+            parse' "type path = text;\n# docs" `shouldBeRight`+                TypeDeclaration "path" (Alias "text")+                                (Just $ Docs "docs\n") empty+            parse' "type path = text;\n# docs\n# docs..." `shouldBeRight`+                TypeDeclaration "path" (Alias "text")+                                (Just $ Docs "docs\ndocs...\n")+                                empty+            parse' "@foo ( \"bar\" ) type path = text;\n# docs\n# docs..."+                `shouldBeRight`+                TypeDeclaration "path" (Alias "text")+                                (Just $ Docs "docs\ndocs...\n")+                                fooAnnotationSet+            parse' "@baz  type path = text;\n# docs\n# docs..."+                `shouldBeRight`+                TypeDeclaration "path" (Alias "text")+                                (Just $ Docs "docs\ndocs...\n")+                                bazAnnotationSet+        specify "its name can't have behind name since \+                \its canonical type's behind name would be used instead" $+            expectError "type path/error = text;" 1 10++    descTypeDecl "boxedTypeDeclaration" P.boxedTypeDeclaration $ \helpers -> do+        let (parse', expectError) = helpers+        it "emits (TypeDeclaration (BoxedType ...)) if succeeded to parse" $ do+            parse' "boxed offset (float64);" `shouldBeRight`+                TypeDeclaration "offset" (BoxedType "float64") Nothing empty+            parse' "boxed offset (float64);\n# docs" `shouldBeRight`+                TypeDeclaration "offset" (BoxedType "float64")+                                (Just $ Docs "docs\n")+                                empty+            parse' "boxed offset (float64);\n# docs\n# docs..." `shouldBeRight`+                TypeDeclaration "offset" (BoxedType "float64")+                                (Just $ Docs "docs\ndocs...\n")+                                empty+            parse' "@foo(\"bar\")\nboxed offset (float64);\n# docs\n# docs..."+                `shouldBeRight`+                    TypeDeclaration "offset" (BoxedType "float64")+                                    (Just $ Docs "docs\ndocs...\n")+                                    fooAnnotationSet+            parse' "@baz\nboxed offset (float64);\n# docs\n# docs..."+                `shouldBeRight`+                    TypeDeclaration "offset" (BoxedType "float64")+                                    (Just $ Docs "docs\ndocs...\n")+                                    bazAnnotationSet+            expectError "boxed offset/behind (float64);" 1 13++    descTypeDecl "enumTypeDeclaration" P.enumTypeDeclaration $ \helpers -> do+        let (parse', expectError) = helpers+        it "emits (TypeDeclaration (EnumType ...)) if succeeded to parse" $ do+            let members' = [ "male"+                           , "female"+                           , "unknown"+                           ] :: DeclarationSet EnumMember+                membersWithDocs = [ EnumMember "male" (Just "docs\n")+                                  , "female"+                                  , EnumMember "unknown" (Just "docs2\n")+                                  ] :: DeclarationSet EnumMember+                expected = TypeDeclaration "gender" (EnumType members') Nothing+                                           empty+            parse' "enum gender = male | female | unknown;"+                `shouldBeRight` expected+            parse' "enum gender=male|female|unknown;" `shouldBeRight` expected+            -- forward docs of enum type+            parse' "enum gender\n# gender type\n= male | female | unknown;"+                `shouldBeRight` expected { typeDocs = Just "gender type\n" }+            -- backward docs of enum type+            parse' "enum gender =\n# gender type\nmale | female | unknown;"+                `shouldBeRight` expected { typeDocs = Just "gender type\n" }+            parse' "enum gender = male # docs\n| female | unknown # docs2\n;"+                `shouldBeRight` TypeDeclaration "gender"+                                                (EnumType membersWithDocs)+                                                Nothing+                                                empty+            parse' "@foo (\"bar\")\nenum gender=male|female|unknown;"+                `shouldBeRight`+                    TypeDeclaration "gender" (EnumType members')+                                    Nothing fooAnnotationSet+            parse' "@baz\nenum gender=male|female|unknown;"+                `shouldBeRight`+                    TypeDeclaration "gender" (EnumType members')+                                    Nothing bazAnnotationSet+        it "fails to parse if there are duplicated facial names" $+            expectError "enum dup = a/b\n\+                        \         | b/c\n\+                        \         | a/d\n\+                        \         ;" 4 10+        it "fails to parse if there are duplicated behind names" $+            expectError "enum dup = a/b\n\+                        \         | b/c\n\+                        \         | c/b\n\+                        \         ;" 4 10++    descTypeDecl "recordTypeDeclaration" P.recordTypeDeclaration $ \helpers -> do+        let (parse', expectError) = helpers+        it "emits (TypeDeclaration (RecordType ...)) if succeeded to parse" $ do+            let fields' = [ Field "name" "text" Nothing+                          , Field "dob" "date" $ Just "date of birth"+                          , Field "gender" "gender" Nothing+                          ] :: DeclarationSet Field+                record = RecordType fields'+                a = TypeDeclaration "person" record Nothing empty+                b = a { typeDocs = Just "person record type" }+            -- without docs, last field with trailing comma+            parse' "record person (\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender,\n\+                   \);" `shouldBeRight` a+            -- without docs, last field without trailing comma+            parse' "record person (\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender\n\+                   \);" `shouldBeRight` a+            -- with docs, last field with trailing comma+            parse' "record person (\n\+                   \    # person record type\n\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender,\n\+                   \);" `shouldBeRight` b+            -- with docs, last field without trailing comma+            parse' "record person (\n\+                   \    # person record type\n\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender\n\+                   \);" `shouldBeRight` b+            -- without docs, last field with trailing comma,+            -- with annotation with single argument+            parse' "@foo(\"bar\")\n\+                   \record person (\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender,\n\+                   \);"+                `shouldBeRight`+                TypeDeclaration "person" record Nothing fooAnnotationSet+            -- without docs, last field with trailing comma,+            -- with annotation without arguments+            parse' "@baz\n\+                   \record person (\n\+                   \    text name,\n\+                   \    date dob,\n\+                   \    # date of birth\n\+                   \    gender gender,\n\+                   \);"+                `shouldBeRight`+                TypeDeclaration "person" record Nothing bazAnnotationSet+        it "should have one or more fields" $ do+            expectError "record unit ();" 1 14+            expectError "record unit (\n# docs\n);" 3 1+        it "fails to parse if there are duplicated facial names" $+            expectError "record dup (\n\+                        \    text a/b,\n\+                        \    text b/c,\n\+                        \    text a/d,\n\+                        \);" 5 1+        it "fails to parse if there are duplicated behind names" $+            expectError "record dup (\n\+                        \    text a/b,\n\+                        \    text b/c,\n\+                        \    text c/b,\n\+                        \);" 5 1+        it "fails to parse if there's no space between field type and name" $ do+            expectError "record a (typename);" 1 11+            expectError "record a (typename\n#docs\n);" 1 11++    descTypeDecl "unionTypeDeclaration" P.unionTypeDeclaration $ \helpers -> do+        let (parse', expectError) = helpers+        it "emits (TypeDeclaration (UnionType ...)) if succeeded to parse" $ do+            let circleFields = [ Field "origin" "point" Nothing+                               , Field "radius" "offset" Nothing+                               ]+                rectangleFields = [ Field "upper-left" "point" Nothing+                                  , Field "lower-right" "point" Nothing+                                  ]+                tags' = [ Tag "circle" circleFields Nothing+                        , Tag "rectangle" rectangleFields Nothing+                        , Tag "none" [] Nothing+                        ]+                union = UnionType tags'+                a = TypeDeclaration "shape" union Nothing empty+                b = a { typeDocs = Just "shape type" }+            parse' "union shape\n\+                   \    = circle (point origin, \+                                 \offset radius,)\n\+                   \    | rectangle (point upper-left, \+                                    \point lower-right,)\n\+                   \    | none\n\+                   \    ;" `shouldBeRight` a+            parse' "union shape\n\+                   \    # shape type\n\+                   \    = circle (point origin, \+                                 \offset radius,)\n\+                   \    | rectangle (point upper-left, \+                                    \point lower-right,)\n\+                   \    | none\n\+                   \    ;" `shouldBeRight` b+        it "fails to parse if there are duplicated facial names" $ do+            expectError "union dup\n\+                        \    = a/b\n\+                        \    | b/c\n\+                        \    | a/d\n\+                        \    ;" 5 6+            expectError "union dup\n\+                        \    = a (text a/b, text b/c, text a/d)\n\+                        \    | b\n\+                        \    ;" 2 38+        it "fails to parse if there are duplicated behind names" $ do+            expectError "union dup\n\+                        \    = a/b\n\+                        \    | b/c\n\+                        \    | c/b\n\+                        \    ;" 5 6+            expectError "union dup\n\+                        \    = a (text a/b, text b/c, text c/b)\n\+                        \    | b\n\+                        \    ;" 2 38++    describe "method" $ do+        let (parse', expectError) = helperFuncs P.method+            httpGetAnnotation =+                head $ rights [fromList [Annotation "http-get" (Just "/get-name/")]]+        it "emits Method if succeeded to parse" $ do+            parse' "text get-name()" `shouldBeRight`+                Method "get-name" [] "text" Nothing Nothing empty+            parse' "text get-name (person user)" `shouldBeRight`+                Method "get-name" [Parameter "user" "person" Nothing]+                       "text" Nothing Nothing empty+            parse' "text get-name  ( person user,text default )" `shouldBeRight`+                Method "get-name"+                       [ Parameter "user" "person" Nothing+                       , Parameter "default" "text" Nothing+                       ]+                       "text" Nothing Nothing empty+            parse' "@http-get(\"/get-name/\") text get-name  ( person user,text default )" `shouldBeRight`+                Method "get-name"+                       [ Parameter "user" "person" Nothing+                       , Parameter "default" "text" Nothing+                       ]+                       "text" Nothing Nothing httpGetAnnotation+            parse' "text get-name() throws name-error" `shouldBeRight`+                Method "get-name" [] "text" (Just "name-error") Nothing empty+            parse' "text get-name  ( person user,text default )\n\+                   \               throws get-name-error" `shouldBeRight`+                Method "get-name"+                       [ Parameter "user" "person" Nothing+                       , Parameter "default" "text" Nothing+                       ]+                       "text" (Just "get-name-error") Nothing empty+            parse' "@http-get(\"/get-name/\")\n\+                   \text get-name  ( person user,text default )\n\+                   \               throws get-name-error" `shouldBeRight`+                Method "get-name"+                       [ Parameter "user" "person" Nothing+                       , Parameter "default" "text" Nothing+                       ]+                       "text" (Just "get-name-error")+                       Nothing+                       httpGetAnnotation+        it "can have docs" $ do+            parse' "text get-name (\n\+                   \  # Gets the name.\n\+                   \)" `shouldBeRight`+                Method "get-name" [] "text"+                       Nothing (Just "Gets the name.") empty+            parse' "text get-name (\n\+                   \  # Gets the name.\n\+                   \)throws name-error  " `shouldBeRight`+                Method "get-name" [] "text"+                       (Just "name-error")+                       (Just "Gets the name.")+                       empty+            parse' "text get-name (\n\+                   \  # Gets the name of the user.\n\+                   \  person user,\n\+                   \)" `shouldBeRight`+                Method "get-name"+                       [Parameter "user" "person" Nothing]+                       "text"+                       Nothing+                       (Just "Gets the name of the user.")+                       empty+            parse' "text get-name (\n\+                   \  # Gets the name of the user.\n\+                   \  person user,\n\+                   \) throws get-name-error" `shouldBeRight`+                Method "get-name"+                       [Parameter "user" "person" Nothing]+                       "text"+                       (Just "get-name-error")+                       (Just "Gets the name of the user.")+                       empty+            parse' "text get-name (\n\+                   \  # Gets the name of the user.\n\+                   \  person user,\n\+                   \  # The person to find their name.\n\+                   \  text default\n\+                   \  # The default name used when the user has no name.\n\+                   \)" `shouldBeRight`+                Method "get-name"+                       [ Parameter "user" "person" $+                                   Just "The person to find their name."+                       , Parameter "default" "text" $+                                   Just "The default name used when \+                                        \the user has no name."+                       ]+                       "text"+                       Nothing+                       (Just "Gets the name of the user.")+                       empty+        it "fails to parse if there are parameters of the same facial name" $ do+            expectError "bool pred(text a, text a/b)" 1 11+            expectError "bool pred(text a/b, text a)" 1 11+            expectError "bool pred(text c/a, text c/b)" 1 11+        it "fails to parse if there are parameters of the same behind name" $ do+            expectError "bool pred(text a, text b/a)" 1 11+            expectError "bool pred(text a/b, text b)" 1 11+            expectError "bool pred(text a/c, text b/c)" 1 11++    describe "serviceDeclaration" $ do+        let (parse', expectError) = helperFuncs P.serviceDeclaration+        it "emits ServiceDeclaration if succeeded to parse" $ do+            parse' "service null-service();" `shouldBeRight`+                ServiceDeclaration "null-service" (Service []) Nothing empty+            parse' "service null-service (\n\+                   \  # Service having no methods.\n\+                   \);" `shouldBeRight`+                ServiceDeclaration "null-service"+                                   (Service [])+                                   (Just "Service having no methods.")+                                   empty+            parse' "service one-method-service(\n\+                   \  user get-user(uuid user-id)\n\+                   \);" `shouldBeRight`+                ServiceDeclaration+                    "one-method-service"+                    (Service [ Method "get-user"+                                      [Parameter "user-id" "uuid" Nothing]+                                      "user"+                                      Nothing+                                      Nothing+                                      empty+                             ])+                    Nothing+                    empty+            parse' "service one-method-service (\n\+                   \  # Service having only one method.\n\+                   \  user get-user (\n\+                   \    # Gets an user by its id.\n\+                   \    uuid user-id\n\+                   \  ) throws get-user-error,\n\+                   \);" `shouldBeRight`+                ServiceDeclaration+                    "one-method-service"+                    (Service [ Method "get-user"+                                      [Parameter "user-id" "uuid" Nothing]+                                      "user"+                                      (Just "get-user-error")+                                      (Just "Gets an user by its id.")+                                      empty+                             ])+                    (Just "Service having only one method.")+                    empty+            parse' "service user-service (\n\+                   \  # Service having multiple methods.\n\+                   \  user create-user (\n\+                   \    # Creates a new user\n\+                   \    user user\n\+                   \  ),\n\+                   \  user get-user (\n\+                   \    # Gets an user by its id.\n\+                   \    uuid user-id\n\+                   \  ),\n\+                   \);" `shouldBeRight`+                ServiceDeclaration+                    "user-service"+                    (Service [ Method "create-user"+                                      [Parameter "user" "user" Nothing]+                                      "user"+                                      Nothing+                                      (Just "Creates a new user")+                                      empty+                             , Method "get-user"+                                      [Parameter "user-id" "uuid" Nothing]+                                      "user"+                                      Nothing+                                      (Just "Gets an user by its id.")+                                      empty+                             ])+                    (Just "Service having multiple methods.")+                    empty+            parse' "@foo(\"bar\")\n\+                   \service null-service (\n\+                   \  # Service having no methods.\n\+                   \);" `shouldBeRight`+                ServiceDeclaration "null-service"+                                   (Service [])+                                   (Just "Service having no methods.")+                                   fooAnnotationSet+            parse' "@baz\n\+                   \service null-service (\n\+                   \  # Service having no methods.\n\+                   \);" `shouldBeRight`+                ServiceDeclaration "null-service"+                                   (Service [])+                                   (Just "Service having no methods.")+                                   bazAnnotationSet+        it "fails to parse if there are methods of the same facial name" $ do+            expectError "service method-dups (\n\+                        \  bool same-name ()\n\+                        \  text same-name (uuid id)\n\+                        \);" 3 3+            expectError "service method-dups (\n\+                        \  bool same-name ()\n\+                        \  text same-name/different-behind-name (uuid id)\n\+                        \);" 3 3+            expectError "service method-dups (\n\+                        \  bool same-name/unique-behind-name ()\n\+                        \  text same-name/different-behind-name (uuid id)\n\+                        \);" 3 3+        it "fails to parse if there are methods of the same behind name" $ do+            expectError "service method-dups (\n\+                        \  bool same-name ()\n\+                        \  text same-name (uuid id)\n\+                        \);" 3 3+            expectError "service method-dups (\n\+                        \  bool same-name ()\n\+                        \  text unique-name/same-name (uuid id)\n\+                        \);" 3 3+            expectError "service method-dups (\n\+                        \  bool unique-name/same-name ()\n\+                        \  text different-facial-name/same-name (uuid id)\n\+                        \);" 3 3+    let moduleParsers = [ ("module'", P.module')+                        , ("file", P.file)+                        ] :: [(String, Parser Module)]+    forM_ moduleParsers $ \(label, parser') ->+        describe label $ do+            let (parse', expectError) = helperFuncs parser'+            it "emits Module if succeeded to parse" $ do+                let decls = [ TypeDeclaration "path" (Alias "text") Nothing+                                              empty+                            , TypeDeclaration "offset"+                                              (BoxedType "float64") Nothing+                                              empty+                            ]+                parse' "type path = text; boxed offset (float64);"+                    `shouldBeRight` Module decls Nothing+                parse' "#docs\n#...\ntype path = text; boxed offset (float64);"+                    `shouldBeRight` Module decls (Just "docs\n...")+            it "may have no type declarations" $ do+                parse' "" `shouldBeRight` Module [] Nothing+                parse' "# docs" `shouldBeRight` Module [] (Just "docs")+            it "errors if there are any duplicated facial names" $+                expectError "type a = text;\ntype a/b = text;" 2 1+            it "errors if there are any duplicated behind names" $+                expectError "type b = text;\ntype a/b = text;" 2 1++    describe "modulePath" $ do+        let (parse', expectError) = helperFuncs P.modulePath+        it "emits ModulePath if succeeded to parse" $ do+            parse' "foo" `shouldBeRight` ["foo"]+            parse' "foo.bar" `shouldBeRight` ["foo", "bar"]+            parse' "foo.bar.baz" `shouldBeRight` ["foo", "bar", "baz"]+        it "errors if it's empty" $+            expectError "" 1 1+        it "errors if it starts with period" $ do+            expectError "." 1 1+            expectError ".foo" 1 1+            expectError ".foo.bar" 1 1+            expectError ".foo.bar.baz" 1 1+        it "errors if it ends with period" $ do+            expectError "." 1 1+            expectError "foo." 1 5+            expectError "foo.bar." 1 9+            expectError "foo.bar.baz." 1 13++    describe "imports" $ do+        let (parse', expectError) = helperFuncs P.imports+        it "emits Import values if succeeded to parse" $+            parse' "import foo.bar (a, b);" `shouldBeRight`+                [ Import ["foo", "bar"] "a"+                , Import ["foo", "bar"] "b"+                ]+        it "errors if parentheses have nothing" $+            expectError "import foo.bar ();" 1 17++    specify "parse & parseFile" $ do+        files <- getDirectoryContents "examples"+        let examples = map ("examples/" ++) $ filter (isSuffixOf ".nrm") files+        forM_ examples $ \filePath -> do+            sourceCode <- readFile filePath+            let parseResult = P.parse (filePath ++ " (text)") sourceCode+            parseResult `shouldSatisfy` isRight+            let Right module' = parseResult+            P.parse (filePath ++ " (text inverse)") (toCode module')+                `shouldBeRight` module'+            parseFileResult <- P.parseFile filePath+            parseFileResult `shouldSatisfy` isRight+            parseFileResult `shouldBe` parseResult++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
+ test/Nirum/Targets/PythonSpec.hs view
@@ -0,0 +1,905 @@+{-# LANGUAGE OverloadedLists, OverloadedStrings, QuasiQuotes,+             ScopedTypeVariables #-}+{-|+This unit test module optionally depends on Python interpreter.+It internally tries to popen python3 executable, and import nirum Python+package.  If any of these prerequisites are not satisfied, tests depending+on Python interpreter are skipped instead of marked failed.++To make Python interpreter possible to import nirum package, you need to+install the nirum package to your Python site-packages using pip command.+We recommend to install the package inside a virtualenv (pyvenv) and+run this unit test in the virtualenv (pyvenv).  E.g.:++> $ pyvenv env+> $ . env/bin/activate+> (env)$ pip install git+git://github.com/spoqa/nirum-python.git+> (env)$ cabal test  # or: stack test+-}+module Nirum.Targets.PythonSpec where++import Control.Monad (forM_, void, unless)+import Data.Char (isSpace)+import Data.Maybe (fromJust, isJust)+import System.IO.Error (catchIOError)++import Data.List (dropWhileEnd)+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import qualified Data.Text.IO as TI+import System.Directory (createDirectoryIfMissing)+import System.Exit (ExitCode(ExitSuccess))+import System.FilePath (isValid, takeDirectory, (</>))+import System.Info (os)+import System.IO.Temp (withSystemTempDirectory)+import System.Process ( CreateProcess(cwd)+                      , proc+                      , readCreateProcess+                      , readCreateProcessWithExitCode+                      )+import Test.Hspec.Meta+import Text.InterpolatedString.Perl6 (q, qq)+import Text.Megaparsec (char, digitChar, runParser, some, space, string')+import Text.Megaparsec.String (Parser)++import Nirum.Constructs.Annotation (empty)+import Nirum.Constructs.DeclarationSet (DeclarationSet)+import Nirum.Constructs.Identifier (Identifier)+import Nirum.Constructs.Module (Module(Module))+import Nirum.Constructs.ModulePath (ModulePath, fromIdentifiers)+import Nirum.Constructs.Name (Name(Name))+import Nirum.Constructs.Service ( Method (Method)+                                , Parameter (Parameter)+                                , Service (Service)+                                )+import Nirum.Constructs.TypeDeclaration ( Field(Field)+                                        , EnumMember(EnumMember)+                                        , PrimitiveTypeIdentifier(..)+                                        , Tag(Tag)+                                        , Type( Alias+                                              , BoxedType+                                              , EnumType+                                              , RecordType+                                              , UnionType+                                              )+                                        , TypeDeclaration ( Import+                                                          , ServiceDeclaration+                                                          , TypeDeclaration+                                                          )+                                        )+import Nirum.Constructs.TypeExpression ( TypeExpression( ListModifier+                                                       , MapModifier+                                                       , OptionModifier+                                                       , SetModifier+                                                       , TypeIdentifier+                                                       )+                                       )+import Nirum.Package (BoundModule(modulePath), Package, resolveBoundModule)+import Nirum.PackageSpec (createPackage)+import Nirum.Targets.Python ( Source (Source)+                            , Code+                            , CodeGen( code+                                     , localImports+                                     , standardImports+                                     , thirdPartyImports+                                     )+                            , CompileError+                            , InstallRequires ( InstallRequires+                                              , dependencies+                                              , optionalDependencies+                                              )+                            , addDependency+                            , addOptionalDependency+                            , compileError+                            , compilePackage+                            , compilePrimitiveType+                            , compileTypeExpression+                            , hasError+                            , toAttributeName+                            , toClassName+                            , toImportPath+                            , toNamePair+                            , unionInstallRequires+                            , withLocalImport+                            , withStandardImport+                            , withThirdPartyImports+                            )++codeGen :: a -> CodeGen a+codeGen = return++windows :: Bool+windows = os `elem` (["mingw32", "cygwin32", "win32"] :: [String])++data PyVersion = PyVersion Int Int Int deriving (Eq, Ord, Show)++installedPythonPaths :: Maybe FilePath -> IO [FilePath]+installedPythonPaths cwd' = do+    (exitCode, stdOut, _) <- readCreateProcessWithExitCode proc' ""+    return $ case exitCode of+        ExitSuccess -> filter isValid $ lines' stdOut+        _ -> []+  where+    proc' :: CreateProcess+    proc' = (if windows then proc "where.exe" ["python"] else proc "which" ["python3"]) { cwd = cwd' }+    lines' :: String -> [String]+    lines' = map T.unpack . filter (not . T.null) . map T.strip . T.lines . T.pack++getPythonVersion :: Maybe FilePath -> FilePath -> IO (Maybe PyVersion)+getPythonVersion cwd' path' = do+    let proc' = (proc path' ["-V"]) { cwd = cwd' }+    pyVersionStr <- readCreateProcess proc' ""+    return $ case runParser pyVersionParser "<python3>" pyVersionStr of+            Left _ -> Nothing+            Right v -> Just v+  where+    pyVersionParser :: Parser PyVersion+    pyVersionParser = do+        void $ string' "python"+        space+        major <- integer+        void $ char '.'+        minor <- integer+        void $ char '.'+        micro <- integer+        return $ PyVersion major minor micro+    integer :: Parser Int+    integer = do+        digits <- some digitChar+        return (read digits :: Int)++findPython :: Maybe FilePath -> IO (Maybe FilePath)+findPython cwd' = installedPythonPaths cwd' >>= findPython'+  where+    findPython' :: [FilePath] -> IO (Maybe FilePath)+    findPython' (x:xs) = do+        pyVerM <- getPythonVersion cwd' x+        case pyVerM of+            Nothing -> findPython' xs+            Just version -> if version >= PyVersion 3 3 0+                            then return $ Just x+                            else findPython' xs+    findPython' [] = return Nothing++runPython' :: Maybe FilePath -> [String] -> String -> IO (Maybe String)+runPython' cwd' args stdinStr = do+    pyPathM <- findPython cwd'+    case pyPathM of+        Nothing -> do+            putStrLn "Python 3 seems not installed; skipping..."+            return Nothing+        Just path -> execute cwd' path args stdinStr+  where+    execute :: Maybe FilePath+            -> FilePath+            -> [String]+            -> String+            -> IO (Maybe String)+    execute cwdPath pyPath args' stdinStr' = do+        let proc' = (proc pyPath args') { cwd = cwdPath }+        result <- readCreateProcess proc' stdinStr'+        return $ Just result++runPython :: Maybe FilePath -> String -> IO (Maybe String)+runPython cwd' code' =+    catchIOError (runPython' cwd' [] code') $ \e -> do+        putStrLn "\nThe following IO error was raised:\n"+        putStrLn $ indent "  " $ show e+        putStrLn "\n... while the following code was executed:\n"+        putStrLn $ indent "  " code'+        ioError e+  where+    indent :: String -> String -> String+    indent spaces content = unlines [spaces ++ l | l <- lines content]++testPythonSuit :: Maybe FilePath -> String -> T.Text -> IO ()+testPythonSuit cwd' suitCode testCode = do+    nirumPackageInstalledM <-+        runPython cwd' [q|+try: import nirum+except ImportError: print('F')+else: print('T')+            |]+    case nirumPackageInstalledM of+        Just nirumPackageInstalled ->+            case strip nirumPackageInstalled of+                "T" -> do+                    resultM <- runPython cwd' suitCode+                    case resultM of+                        Just result ->+                            unless (strip result == "True") $+                                expectationFailure $+                                T.unpack ("Test failed: " `T.append` testCode)+                        Nothing -> return ()+                _ -> putStrLn "The nirum Python package cannot be imported; \+                              \skipped..."+        Nothing -> return ()+  where+    strip :: String -> String+    strip = dropWhile isSpace . dropWhileEnd isSpace++testPython :: Maybe FilePath -> T.Text -> T.Text -> IO ()+testPython cwd' defCode testCode = testPythonSuit cwd' code' testCode'+  where+    -- to workaround hlint's "Eta reduce" warning+    -- hlint seems unable to look inside qq string literal...+    testCode' :: T.Text+    testCode' = testCode+    code' :: String+    code' = [qq|$defCode++if __name__ == '__main__':+    print(bool($testCode'))+|]++testRaisePython :: Maybe FilePath -> T.Text -> T.Text -> T.Text -> IO ()+testRaisePython cwd' errorClassName defCode testCode =+    testPythonSuit cwd' code' testCode''+  where+    -- to workaround hlint's "Eta reduce" warning+    -- hlint seems unable to look inside qq string literal...+    testCode'' :: T.Text+    testCode'' = testCode+    code' :: String+    code' = [qq|$defCode++if __name__ == '__main__':+    try:+        $testCode''+    except $errorClassName:+        print(True)+    else:+        print(False)+|]++makeDummySource' :: [Identifier] -> Module -> Source+makeDummySource' pathPrefix m =+    Source pkg $ fromJust $ resolveBoundModule ["foo"] pkg+  where+    mp :: [Identifier] -> ModulePath+    mp identifiers = fromJust $ fromIdentifiers (pathPrefix ++ identifiers)+    pkg :: Package+    pkg = createPackage+            [ (mp ["foo"], m)+            , ( mp ["foo", "bar"]+              , Module [ Import (mp ["qux"]) "path"+                       , TypeDeclaration "path-box" (BoxedType "path") Nothing+                                         empty+                       , TypeDeclaration "int-box" (BoxedType "bigint")+                                         Nothing empty+                       , TypeDeclaration "point"+                                         (RecordType [ Field "x" "int64" Nothing+                                                     , Field "y" "int64" Nothing+                                                     ])+                                         Nothing+                                         empty+                       ] Nothing+              )+            , ( mp ["qux"]+              , Module+                  [ TypeDeclaration "path" (Alias "text") Nothing empty+                  , TypeDeclaration "name" (BoxedType "text") Nothing empty+                  ]+                  Nothing+              )+            ]++makeDummySource :: Module -> Source+makeDummySource = makeDummySource' []++spec :: Spec+spec = parallel $ do+    describe "CodeGen" $ do+        let v = 123 :: Int+            cg = return v :: CodeGen Int+            f = return . g :: Int -> CodeGen Int+            f' = return . h :: Int -> CodeGen Int+            g = (+ 5) :: Int -> Int+            h = (* 2) :: Int -> Int+            g' = pure g :: CodeGen (Int -> Int)+            h' = pure h :: CodeGen (Int -> Int)+            id' x = x+        context "Functor" $ do+            specify "identity morphisms" $+                fmap id' (return 123 :: CodeGen Int) `shouldBe` id' (return 123)+            specify "composition of morphisms" $ do+                fmap (g . h) cg `shouldBe` (fmap g . fmap h) cg+                fmap (h . g) cg `shouldBe` (fmap h . fmap g) cg+        context "Applicative" $ do+            specify "identity law" $+                (pure id' <*> cg) `shouldBe` cg+            specify "homomorphism" $ do+                let pure' = pure :: a -> CodeGen a+                (pure g <*> pure v) `shouldBe` pure' (g v)+                (pure h <*> pure v) `shouldBe` pure' (h v)+            specify "interchange" $ do+                (g' <*> pure v) `shouldBe` (pure ($ v) <*> g')+                (h' <*> pure v) `shouldBe` (pure ($ v) <*> h')+            specify "composition" $ do+                (g' <*> (h' <*> cg)) `shouldBe` (pure (.) <*> g' <*> h' <*> cg)+                (h' <*> (g' <*> cg)) `shouldBe` (pure (.) <*> h' <*> g' <*> cg)+        context "Monad" $ do+            specify "left identity" $ do+                (return v >>= f) `shouldBe` f v+                (return v >>= f') `shouldBe` f' v+            specify "right identity" $+                (cg >>= return) `shouldBe` cg+            specify "associativity" $ do+                ((cg >>= f) >>= f') `shouldBe` (cg >>= (\x -> f x >>= f'))+                ((cg >>= f') >>= f) `shouldBe` (cg >>= (\x -> f' x >>= f))+            specify "packages and imports" $ do+                let (c :: CodeGen Int) = do+                        a <- withStandardImport "sys" cg+                        b <- withThirdPartyImports+                            [("nirum", ["serialize_boxed_type"])]+                            cg+                        c' <- withLocalImport ".." "Gender" cg+                        d <- withStandardImport "os" cg+                        e <- withThirdPartyImports+                            [("nirum", ["serialize_enum_type"])]+                            cg+                        f'' <- withLocalImport ".." "Path" cg+                        return $ sum ([a, b, c', d, e, f''] :: [Int])+                c `shouldSatisfy` (not . hasError)+                standardImports c `shouldBe` ["os", "sys"]+                thirdPartyImports c `shouldBe`+                    [("nirum", ["serialize_boxed_type", "serialize_enum_type"])]+                localImports c `shouldBe` [("..", ["Gender", "Path"])]+                code c `shouldBe` (123 * 6)+        specify "withStandardImport" $ do+            let codeGen1 = withStandardImport "sys" (pure True)+            codeGen1 `shouldSatisfy` (not . hasError)+            standardImports codeGen1 `shouldBe` ["sys"]+            thirdPartyImports codeGen1 `shouldBe` []+            localImports codeGen1 `shouldBe` []+            code codeGen1 `shouldBe` True+            compileError codeGen1 `shouldBe` Nothing+            let codeGen2 = withStandardImport "os" codeGen1+            codeGen2 `shouldSatisfy` (not . hasError)+            standardImports codeGen2 `shouldBe` ["os", "sys"]+            thirdPartyImports codeGen2 `shouldBe` []+            localImports codeGen2 `shouldBe` []+            code codeGen2 `shouldBe` True+            compileError codeGen2 `shouldBe` Nothing+        specify "fail" $ do+            let codeGen' = do+                    val <- withStandardImport "sys" (pure True)+                    _ <- fail "test"+                    withStandardImport "sys" (pure val)+            compileError codeGen' `shouldBe` Just "test"++    specify "compilePrimitiveType" $ do+        code (compilePrimitiveType Bool) `shouldBe` "bool"+        code (compilePrimitiveType Bigint) `shouldBe` "int"+        let decimal = compilePrimitiveType Decimal+        code decimal `shouldBe` "decimal.Decimal"+        standardImports decimal `shouldBe` ["decimal"]+        code (compilePrimitiveType Int32) `shouldBe` "int"+        code (compilePrimitiveType Int64) `shouldBe` "int"+        code (compilePrimitiveType Float32) `shouldBe` "float"+        code (compilePrimitiveType Float64) `shouldBe` "float"+        code (compilePrimitiveType Text) `shouldBe` "str"+        code (compilePrimitiveType Binary) `shouldBe` "bytes"+        let date = compilePrimitiveType Date+        code date `shouldBe` "datetime.date"+        standardImports date `shouldBe` ["datetime"]+        let datetime = compilePrimitiveType Datetime+        code datetime `shouldBe` "datetime.datetime"+        standardImports datetime `shouldBe` ["datetime"]+        let uuid = compilePrimitiveType Uuid+        code uuid `shouldBe` "uuid.UUID"+        standardImports uuid `shouldBe` ["uuid"]+        code (compilePrimitiveType Uri) `shouldBe` "str"++    describe "compileTypeExpression" $ do+        let s = makeDummySource $ Module [] Nothing+        specify "TypeIdentifier" $ do+            let c = compileTypeExpression s (TypeIdentifier "bigint")+            c `shouldSatisfy` (not . hasError)+            standardImports c `shouldBe` []+            localImports c `shouldBe` []+            code c `shouldBe` "int"+        specify "OptionModifier" $ do+            let c' = compileTypeExpression s (OptionModifier "text")+            c' `shouldSatisfy` (not . hasError)+            standardImports c' `shouldBe` ["typing"]+            localImports c' `shouldBe` []+            code c' `shouldBe` "typing.Optional[str]"+        specify "SetModifier" $ do+            let c'' = compileTypeExpression s (SetModifier "text")+            c'' `shouldSatisfy` (not . hasError)+            standardImports c'' `shouldBe` ["typing"]+            localImports c'' `shouldBe` []+            code c'' `shouldBe` "typing.AbstractSet[str]"+        specify "ListModifier" $ do+            let c''' = compileTypeExpression s (ListModifier "text")+            c''' `shouldSatisfy` (not . hasError)+            standardImports c''' `shouldBe` ["typing"]+            localImports c''' `shouldBe` []+            code c''' `shouldBe` "typing.Sequence[str]"+        specify "MapModifier" $ do+            let c'''' = compileTypeExpression s (MapModifier "uuid" "text")+            c'''' `shouldSatisfy` (not . hasError)+            standardImports c'''' `shouldBe` ["uuid", "typing"]+            localImports c'''' `shouldBe` []+            code c'''' `shouldBe` "typing.Mapping[uuid.UUID, str]"++    describe "toClassName" $ do+        it "transform the facial name of the argument into PascalCase" $ do+            toClassName "test" `shouldBe` "Test"+            toClassName "hello-world" `shouldBe` "HelloWorld"+        it "appends an underscore to the result if it's a reserved keyword" $ do+            toClassName "true" `shouldBe` "True_"+            toClassName "false" `shouldBe` "False_"+            toClassName "none" `shouldBe` "None_"++    describe "toAttributeName" $ do+        it "transform the facial name of the argument into snake_case" $ do+            toAttributeName "test" `shouldBe` "test"+            toAttributeName "hello-world" `shouldBe` "hello_world"+        it "appends an underscore to the result if it's a reserved keyword" $ do+            toAttributeName "def" `shouldBe` "def_"+            toAttributeName "lambda" `shouldBe` "lambda_"+            toAttributeName "nonlocal" `shouldBe` "nonlocal_"++    describe "toNamePair" $ do+        it "transforms the name to a Python code string of facial/behind pair" $+            do toNamePair "text" `shouldBe` "('text', 'text')"+               toNamePair (Name "test" "hello") `shouldBe` "('test', 'hello')"+        it "replaces hyphens to underscores" $ do+            toNamePair "hello-world" `shouldBe` "('hello_world', 'hello_world')"+            toNamePair (Name "hello-world" "annyeong-sesang") `shouldBe`+                "('hello_world', 'annyeong_sesang')"+        it "appends an underscore if the facial name is a Python keyword" $ do+            toNamePair "def" `shouldBe` "('def_', 'def')"+            toNamePair "lambda" `shouldBe` "('lambda_', 'lambda')"+            toNamePair (Name "abc" "lambda") `shouldBe` "('abc', 'lambda')"+            toNamePair (Name "lambda" "abc") `shouldBe` "('lambda_', 'abc')"++    let test testRunner (Source pkg boundM) testCode =+            case errors of+                error':_ -> fail $ T.unpack error'+                [] -> withSystemTempDirectory "nirumpy." $ \dir -> do+                    forM_ codes $ \(filePath, code') -> do+                        let filePath' = dir </> filePath+                            dirName = takeDirectory filePath'+                        createDirectoryIfMissing True dirName+                        TI.writeFile filePath' code'+                    testRunner (Just dir) defCode testCode+          where+            files :: M.Map FilePath (Either CompileError Code)+            files = compilePackage pkg+            errors :: [CompileError]+            errors = [error' | (_, Left error') <- M.toList files]+            codes :: [(FilePath, Code)]+            codes = [(path, code') | (path, Right code') <- M.toList files]+            pyImportPath :: T.Text+            pyImportPath = toImportPath $ modulePath boundM+            defCode :: Code+            defCode = [qq|from $pyImportPath import *|]+        tM = test testPython+        tT' typeDecls = tM $ makeDummySource $ Module typeDecls Nothing+        tT typeDecl = tT' [typeDecl]+        tR source excType = test (`testRaisePython` excType) source+        tR'' typeDecls = tR $ makeDummySource $ Module typeDecls Nothing+        tR' typeDecl = tR'' [typeDecl]++    describe "compilePackage" $ do+        it "returns a Map of file paths and their contents to generate" $ do+            let (Source pkg _) = makeDummySource $ Module [] Nothing+                files = compilePackage pkg+            M.keysSet files `shouldBe`+                [ "foo" </> "__init__.py"+                , "foo" </> "bar" </> "__init__.py"+                , "qux" </> "__init__.py"+                , "setup.py"+                ]+        it "creates an emtpy Python package directory if necessary" $ do+            let (Source pkg _) = makeDummySource' ["test"] $ Module [] Nothing+                files = compilePackage pkg+            M.keysSet files `shouldBe`+                [ "test" </> "__init__.py"+                , "test" </> "foo" </> "__init__.py"+                , "test" </> "foo" </> "bar" </> "__init__.py"+                , "test" </> "qux" </> "__init__.py"+                , "setup.py"+                ]+        specify "setup.py" $ do+            let setupPyFields = [ ("--name", "TestPackage")+                                , ("--version", "0.1.0")+                                , ("--version", "0.1.0")+                                , ("--provides", "foo\nfoo.bar\nqux")+                                , ("--requires", "nirum")+                                ] :: [(String, T.Text)]+                source = makeDummySource $ Module [] Nothing+                testRunner cwd' _ _ =+                    {--  <- remove '{' to print debug log+                    do+                        let spath = case cwd' of+                                        Just c -> c </> "setup.py"+                                        Nothing -> "setup.py"+                        contents <- TI.readFile spath+                        TI.putStrLn "=========== setup.py ==========="+                        TI.putStrLn contents+                        TI.putStrLn "=========== /setup.py =========="+                    -- --}+                        forM_ setupPyFields $ \(option, expected) -> do+                            out <- runPython' cwd' ["setup.py", option] ""+                            out `shouldSatisfy` isJust+                            let Just result = out+                            T.strip (T.pack result) `shouldBe` expected+            test testRunner source T.empty+        specify "boxed type" $ do+            let decl = TypeDeclaration "float-box" (BoxedType "float64")+                                       Nothing empty+            tT decl "isinstance(FloatBox, type)"+            tT decl "FloatBox(3.14).value == 3.14"+            tT decl "FloatBox(3.14) == FloatBox(3.14)"+            tT decl "FloatBox(3.14) != FloatBox(1.0)"+            tT decl [q|{FloatBox(3.14), FloatBox(3.14), FloatBox(1.0)} ==+                       {FloatBox(3.14), FloatBox(1.0)}|]+            tT decl "FloatBox(3.14).__nirum_serialize__() == 3.14"+            tT decl "FloatBox.__nirum_deserialize__(3.14) == FloatBox(3.14)"+            tT decl "FloatBox.__nirum_deserialize__(3.14) == FloatBox(3.14)"+            tR' decl "TypeError" "FloatBox.__nirum_deserialize__('a')"+            tR' decl "TypeError" "FloatBox('a')"+            let decls = [ Import ["foo", "bar"] "path-box"+                        , TypeDeclaration "imported-type-box"+                                          (BoxedType "path-box") Nothing+                                          empty+                        ]+            tT' decls "isinstance(ImportedTypeBox, type)"+            tT' decls [q|ImportedTypeBox(PathBox('/path/string')).value.value ==+                         '/path/string'|]+            tT' decls [q|ImportedTypeBox(PathBox('/path/string')) ==+                         ImportedTypeBox(PathBox('/path/string'))|]+            tT' decls [q|ImportedTypeBox(PathBox('/path/string')) !=+                         ImportedTypeBox(PathBox('/other/path'))|]+            tT' decls [q|{ImportedTypeBox(PathBox('/path/string')),+                          ImportedTypeBox(PathBox('/path/string')),+                          ImportedTypeBox(PathBox('/other/path')),+                          ImportedTypeBox(PathBox('/path/string')),+                          ImportedTypeBox(PathBox('/other/path'))} ==+                         {ImportedTypeBox(PathBox('/path/string')),+                          ImportedTypeBox(PathBox('/other/path'))}|]+            tT' decls [q|+                ImportedTypeBox(PathBox('/path/string')).__nirum_serialize__()+                == '/path/string'+            |]+            tT' decls [q|+                ImportedTypeBox.__nirum_deserialize__('/path/string') ==+                ImportedTypeBox(PathBox('/path/string'))+            |]+            tR'' decls "TypeError" "ImportedTypeBox.__nirum_deserialize__(123)"+            tR'' decls "TypeError" "ImportedTypeBox(123)"+            let boxedAlias = [ Import ["qux"] "path"+                             , TypeDeclaration "way"+                                               (BoxedType "path") Nothing+                                               empty+                             ]+            tT' boxedAlias "Way('.').value == '.'"+            tT' boxedAlias "Way(Path('.')).value == '.'"+            tT' boxedAlias "Way.__nirum_deserialize__('.') == Way('.')"+            tT' boxedAlias "Way('.').__nirum_serialize__() == '.'"+            let aliasBoxed = [ Import ["qux"] "name"+                             , TypeDeclaration "irum" (Alias "name") Nothing+                                               empty+                             ]+            tT' aliasBoxed "Name('khj') == Irum('khj')"+            tT' aliasBoxed "Irum.__nirum_deserialize__('khj') == Irum('khj')"+            tT' aliasBoxed "Irum('khj').__nirum_serialize__() == 'khj'"+            tT' aliasBoxed "Irum.__nirum_deserialize__('khj') == Name('khj')"+            tT' aliasBoxed "Irum.__nirum_deserialize__('khj') == Irum('khj')"+        specify "enum type" $ do+            let members = [ "male"+                          , EnumMember (Name "female" "yeoseong") Nothing+                          ] :: DeclarationSet EnumMember+                decl = TypeDeclaration "gender" (EnumType members) Nothing+                                       empty+            tT decl "type(Gender) is enum.EnumMeta"+            tT decl "set(Gender) == {Gender.male, Gender.female}"+            tT decl "Gender.male.value == 'male'"+            tT decl "Gender.female.value == 'yeoseong'"+            tT decl "Gender.__nirum_deserialize__('male') == Gender.male"+            tT decl "Gender.__nirum_deserialize__('yeoseong') == Gender.female"+            tR' decl "ValueError" "Gender.__nirum_deserialize__('namja')"+            tT decl "Gender.male.__nirum_serialize__() == 'male'"+            tT decl "Gender.female.__nirum_serialize__() == 'yeoseong'"+            let members' = [ "soryu-asuka-langley"+                           , "ayanami-rei"+                           , "ikari-shinji"+                           , "katsuragi-misato"+                           , "nagisa-kaworu"+                           ] :: DeclarationSet EnumMember+                decl' = TypeDeclaration "eva-char" (EnumType members') Nothing+                                        empty+            tT decl' "type(EvaChar) is enum.EnumMeta"+            tT decl' "set(EvaChar) == {EvaChar.soryu_asuka_langley, \+                                     \ EvaChar.ayanami_rei, \+                                     \ EvaChar.ikari_shinji, \+                                     \ EvaChar.katsuragi_misato, \+                                     \ EvaChar.nagisa_kaworu}"+            tT decl' "EvaChar.soryu_asuka_langley.value=='soryu_asuka_langley'"+            tT decl' "EvaChar.soryu_asuka_langley.__nirum_serialize__() == \+                     \ 'soryu_asuka_langley'"+            tT decl' "EvaChar.__nirum_deserialize__('soryu_asuka_langley') == \+                     \ EvaChar.soryu_asuka_langley"+            tT decl' "EvaChar.__nirum_deserialize__('soryu-asuka-langley') == \+                     \ EvaChar.soryu_asuka_langley"  -- to be robust+        specify "record type" $ do+            let fields = [ Field (Name "left" "x") "bigint" Nothing+                         , Field "top" "bigint" Nothing+                         ]+                payload = "{'_type': 'point', 'x': 3, 'top': 14}" :: T.Text+                decl = TypeDeclaration "point" (RecordType fields) Nothing+                                       empty+            tT decl "isinstance(Point, type)"+            tT decl "Point(left=3, top=14).left == 3"+            tT decl "Point(left=3, top=14).top == 14"+            tT decl "Point(left=3, top=14) == Point(left=3, top=14)"+            tT decl "Point(left=3, top=14) != Point(left=3, top=15)"+            tT decl "Point(left=3, top=14) != Point(left=4, top=14)"+            tT decl "Point(left=3, top=14) != Point(left=4, top=15)"+            tT decl "Point(left=3, top=14) != 'foo'"+            tT decl [q|Point(left=3, top=14).__nirum_serialize__() ==+                       {'_type': 'point', 'x': 3, 'top': 14}|]+            tT decl [qq|Point.__nirum_deserialize__($payload) ==+                        Point(left=3, top=14)|]+            tR' decl "ValueError"+                "Point.__nirum_deserialize__({'x': 3, 'top': 14})"+            tR' decl "ValueError"+                "Point.__nirum_deserialize__({'_type': 'foo'})"+            tR' decl "TypeError" "Point(left=1, top='a')"+            tR' decl "TypeError" "Point(left='a', top=1)"+            tR' decl "TypeError" "Point(left='a', top='b')"+            let fields' = [ Field "left" "int-box" Nothing+                          , Field "top" "int-box" Nothing+                          ]+                decls = [ Import ["foo", "bar"] "int-box"+                        , TypeDeclaration "point" (RecordType fields') Nothing+                                          empty+                        ]+                payload' = "{'_type': 'point', 'left': 3, 'top': 14}" :: T.Text+            tT' decls "isinstance(Point, type)"+            tT' decls "Point(left=IntBox(3), top=IntBox(14)).left == IntBox(3)"+            tT' decls "Point(left=IntBox(3), top=IntBox(14)).top == IntBox(14)"+            tT' decls [q|Point(left=IntBox(3), top=IntBox(14)) ==+                         Point(left=IntBox(3), top=IntBox(14))|]+            tT' decls [q|Point(left=IntBox(3), top=IntBox(14)) !=+                         Point(left=IntBox(3), top=IntBox(15))|]+            tT' decls [q|Point(left=IntBox(3), top=IntBox(14)) !=+                         Point(left=IntBox(4), top=IntBox(14))|]+            tT' decls [q|Point(left=IntBox(3), top=IntBox(14)) !=+                         Point(left=IntBox(4), top=IntBox(15))|]+            tT' decls "Point(left=IntBox(3), top=IntBox(14)) != 'foo'"+            tT' decls [q|Point(left=IntBox(3),+                               top=IntBox(14)).__nirum_serialize__() ==+                         {'_type': 'point', 'left': 3, 'top': 14}|]+            tT' decls [qq|Point.__nirum_deserialize__($payload') ==+                          Point(left=IntBox(3), top=IntBox(14))|]+            tR'' decls "ValueError"+                 "Point.__nirum_deserialize__({'left': 3, 'top': 14})"+            tR'' decls "ValueError"+                 "Point.__nirum_deserialize__({'_type': 'foo'})"+            tR'' decls "TypeError" "Point(left=IntBox(1), top='a')"+            tR'' decls "TypeError" "Point(left=IntBox(1), top=2)"+            let fields'' = [ Field "xy" "point" Nothing+                           , Field "z" "int64" Nothing+                           ]+                decls' = [ Import ["foo", "bar"] "point"+                         , TypeDeclaration "point3d"+                                           (RecordType fields'')+                                           Nothing+                                           empty+                         ]+            tT' decls' "isinstance(Point3d, type)"+            tT' decls' [q|Point3d(xy=Point(x=1, y=2), z=3).xy ==+                          Point(x=1, y=2)|]+            tT' decls' "Point3d(xy=Point(x=1, y=2), z=3).xy.x == 1"+            tT' decls' "Point3d(xy=Point(x=1, y=2), z=3).xy.y == 2"+            tT' decls' "Point3d(xy=Point(x=1, y=2), z=3).z == 3"+            tT' decls' [q|Point3d(xy=Point(x=1, y=2), z=3).__nirum_serialize__()+                          == {'_type': 'point3d',+                              'xy': {'_type': 'point', 'x': 1, 'y': 2},+                              'z': 3}|]+            tT' decls' [q|Point3d.__nirum_deserialize__({+                              '_type': 'point3d',+                              'xy': {'_type': 'point', 'x': 1, 'y': 2},+                              'z': 3+                          }) == Point3d(xy=Point(x=1, y=2), z=3)|]+        specify "record type with one field" $ do+            let fields = [ Field "length" "bigint" Nothing ]+                payload = "{'_type': 'line', 'length': 3}" :: T.Text+                decl = TypeDeclaration "line" (RecordType fields) Nothing empty+            tT decl "isinstance(Line, type)"+            tT decl "Line(length=10).length == 10"+            tT decl "Line.__slots__ == ('length', )"+            tT decl [qq|Line(length=3).__nirum_serialize__() == $payload|]+        specify "union type" $ do+            let wasternNameTag =+                    Tag "western-name" [ Field "first-name" "text" Nothing+                                       , Field "middle-name" "text" Nothing+                                       , Field "last-name" "text" Nothing+                                       ] Nothing+                eastAsianNameTag =+                    Tag "east-asian-name" [ Field "family-name" "text" Nothing+                                          , Field "given-name" "text" Nothing+                                          ] Nothing+                cultureAgnosticNameTag =+                    Tag "culture-agnostic-name"+                        [ Field "fullname" "text" Nothing ]+                        Nothing+                tags = [ wasternNameTag+                       , eastAsianNameTag+                       , cultureAgnosticNameTag+                       ]+                decl = TypeDeclaration "name" (UnionType tags) Nothing empty+            tT decl "isinstance(Name, type)"+            tT decl "Name.Tag.western_name.value == 'western_name'"+            tT decl "Name.Tag.east_asian_name.value == 'east_asian_name'"+            tT decl [q|Name.Tag.culture_agnostic_name.value ==+                       'culture_agnostic_name'|]+            tT decl "isinstance(WesternName, type)"+            tT decl "issubclass(WesternName, Name)"+            tR' decl "NotImplementedError" "Name()"+            tT decl [q|WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz').first_name == 'foo'|]+            tT decl [q|WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz').middle_name == 'bar'|]+            tT decl [q|WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz').last_name == 'baz'|]+            tR' decl "TypeError" [q|WesternName(first_name=1,middle_name='bar',+                                                last_name='baz')|]+            tR' decl "TypeError" [q|WesternName(first_name='foo',+                                                middle_name=1,+                                                last_name='baz')|]+            tR' decl "TypeError" [q|WesternName(first_name='foo',+                                                middle_name='bar',+                                                last_name=1)|]+            tT decl [q|WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz') ==+                       WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz')+                    |]+            tT decl [q|WesternName(first_name='wrong',+                                   middle_name='bar', last_name='baz') !=+                       WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz')+                    |]+            tT decl [q|WesternName(first_name='foo', middle_name='wrong',+                                    last_name='baz') !=+                       WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz')+                    |]+            tT decl [q|WesternName(first_name='foo', middle_name='bar',+                                   last_name='wrong') !=+                       WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz')+                    |]+            tT decl [q|WesternName(first_name='wrong', middle_name='wrong',+                                   last_name='wrong') !=+                       WesternName(first_name='foo', middle_name='bar',+                                   last_name='baz')|]+            tT decl "isinstance(EastAsianName, type)"+            tT decl "issubclass(EastAsianName, Name)"+            tT decl [q|EastAsianName(family_name='foo',+                                     given_name='baz').family_name == 'foo'|]+            tT decl [q|EastAsianName(family_name='foo',+                                     given_name='baz').given_name == 'baz'|]+            tT decl [q|EastAsianName(family_name='foo', given_name='baz') ==+                       EastAsianName(family_name='foo', given_name='baz')|]+            tT decl [q|EastAsianName(family_name='foo',+                                     given_name='wrong') !=+                       EastAsianName(family_name='foo', given_name='baz')|]+            tT decl [q|EastAsianName(family_name='wrong', given_name='baz') !=+                       EastAsianName(family_name='foo', given_name='baz')|]+            tT decl [q|EastAsianName(family_name='wrong',+                                     given_name='wrong') !=+                       EastAsianName(family_name='foo', given_name='baz')|]+            tR'+                decl+                "TypeError"+                "EastAsianName(family_name=1, given_name='baz')"+            tR'+                decl+                "TypeError"+                "EastAsianName(family_name='foo', given_name=2)"+            tT decl "isinstance(CultureAgnosticName, type)"+            tT decl "issubclass(CultureAgnosticName, Name)"+            tT+                decl+                "CultureAgnosticName(fullname='foobar').fullname == 'foobar'"+            tT decl [q|CultureAgnosticName(fullname='foobar') ==+                       CultureAgnosticName(fullname='foobar')|]+            tT decl [q|CultureAgnosticName(fullname='wrong') !=+                       CultureAgnosticName(fullname='foobar')|]+            tR' decl "TypeError" "CultureAgnosticName(fullname=1)"+        specify "union type with one tag" $ do+            let cultureAgnosticNameTag =+                    Tag "pop"+                        [ Field "country" "text" Nothing ]+                        Nothing+                tags = [cultureAgnosticNameTag]+                decl = TypeDeclaration "music" (UnionType tags) Nothing empty+            tT decl "Pop(country='KR').country == 'KR'"+            tT decl "Pop(country='KR') == Pop(country='KR')"+            tT decl "Pop(country='US') != Pop(country='KR')"+            tR' decl "TypeError" "Pop(country=1)"+            tT decl "Pop.__slots__ == ('country', )"+        specify "union type with behind names" $ do+            let pop =+                    Tag (Name "pop" "popular_music")+                        [ Field "country" "text" Nothing ]+                        Nothing+                tags = [pop]+                decl = TypeDeclaration "music" (UnionType tags) Nothing empty+            tT decl "Pop(country='KR').__nirum_tag__.value == 'popular_music'"+        specify "service" $ do+            let null' = ServiceDeclaration "null-service" (Service [])+                                           Nothing empty+                pingService = Service [Method "ping"+                                              [Parameter "nonce" "text" Nothing]+                                              "bool"+                                              Nothing+                                              Nothing+                                              empty]+                ping' = ServiceDeclaration "ping-service" pingService+                                           Nothing empty+            tT null' "issubclass(NullService, __import__('nirum').rpc.Service)"+            tT ping' "issubclass(PingService, __import__('nirum').rpc.Service)"+            tT ping' "set(PingService.ping.__annotations__) == \+                     \    {'nonce', 'return'}"+            tT ping' "PingService.ping.__annotations__['nonce'] is str"+            tT ping' "PingService.ping.__annotations__['return'] is bool"+            tR' ping' "NotImplementedError" "PingService().ping('nonce')"+            tR' ping' "NotImplementedError" "PingService().ping(nonce='nonce')"+            tR' ping' "TypeError" "PingService().ping(wrongkwd='a')"++    describe "InstallRequires" $ do+        let req = InstallRequires [] []+            req2 = req { dependencies = ["six"] }+            req3 = req { optionalDependencies = [((3, 4), ["enum34"])] }+        specify "addDependency" $ do+            addDependency req "six" `shouldBe` req2+            addDependency req2 "six" `shouldBe` req2+            addDependency req "nirum" `shouldBe`+                req { dependencies = ["nirum"] }+            addDependency req2 "nirum" `shouldBe`+                req2 { dependencies = ["nirum", "six"] }+        specify "addOptionalDependency" $ do+            addOptionalDependency req (3, 4) "enum34" `shouldBe` req3+            addOptionalDependency req3 (3, 4) "enum34" `shouldBe` req3+            addOptionalDependency req (3, 4) "ipaddress" `shouldBe`+                req { optionalDependencies = [((3, 4), ["ipaddress"])] }+            addOptionalDependency req3 (3, 4) "ipaddress" `shouldBe`+                req { optionalDependencies = [ ((3, 4), ["enum34", "ipaddress"])+                                             ]+                    }+            addOptionalDependency req (3, 5) "typing" `shouldBe`+                req { optionalDependencies = [((3, 5), ["typing"])] }+            addOptionalDependency req3 (3, 5) "typing" `shouldBe`+                req3 { optionalDependencies = [ ((3, 4), ["enum34"])+                                              , ((3, 5), ["typing"])+                                              ]+                     }+        specify "unionInstallRequires" $ do+            (req `unionInstallRequires` req) `shouldBe` req+            (req `unionInstallRequires` req2) `shouldBe` req2+            (req2 `unionInstallRequires` req) `shouldBe` req2+            (req `unionInstallRequires` req3) `shouldBe` req3+            (req3 `unionInstallRequires` req) `shouldBe` req3+            let req4 = req3 { dependencies = ["six"] }+            (req2 `unionInstallRequires` req3) `shouldBe` req4+            (req3 `unionInstallRequires` req2) `shouldBe` req4+            let req5 = req { dependencies = ["nirum"]+                           , optionalDependencies = [((3, 4), ["ipaddress"])]+                           }+                req6 = addOptionalDependency (addDependency req4 "nirum")+                                             (3, 4) "ipaddress"+            (req4 `unionInstallRequires` req5) `shouldBe` req6+            (req5 `unionInstallRequires` req4) `shouldBe` req6++{-# ANN module ("HLint: ignore Functor law" :: String) #-}+{-# ANN module ("HLint: ignore Monad law, left identity" :: String) #-}+{-# ANN module ("HLint: ignore Monad law, right identity" :: String) #-}+{-# ANN module ("HLint: ignore Use >=>" :: String) #-}
+ test/Nirum/VersionSpec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+module Nirum.VersionSpec where++import Data.Text (unpack)+import qualified Data.SemVer as SV+import Test.Hspec.Meta++import Nirum.Version (version, versionString, versionText)++spec :: Spec+spec = do+    describe "version" $ do+        it "must not error" $+            SV.toText version `shouldBe` versionText+            -- assertion is meaningless; it's just for testing whether+            -- `version` is evaluated without error+        it "is development version yet" $+            version `shouldSatisfy` SV.isDevelopment+        it "is the proper version" $+            -- is it a necessary test?+            version `shouldBe` SV.version 0 1 0 [] []+    describe "versionText" $ do+        it "is equivalent to version" $+            versionText `shouldBe` SV.toText version+        it "is equivalent to versionString" $+            unpack versionText `shouldBe` versionString+    describe "versionString" $+        it "is equivalent to version" $+            versionString `shouldBe` SV.toString version
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}