packages feed

turncoat (empty) → 1.0

raw patch · 35 files changed

+5214/−0 lines, 35 filesdep +QuickCheckdep +asyncdep +base

Dependencies added: QuickCheck, async, base, bookhound, classy-prelude, composition, containers, derive-storable, errors, hspec, mtl, newtype, random, split, text, time, turncoat, unbounded-delays, vector

Files

+ LICENSE view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <https://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 <https://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+<https://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+<https://www.gnu.org/licenses/why-not-lgpl.html>.
+ README.md view
@@ -0,0 +1,58 @@+# turncoat++A minimalistic bitboard based UCI chess engine written in Haskell with a strong focus on a clear and modular implementation with adequate performance when compared with other open source engines. ++It relies heavily on GHC as well as strictness annotations in order to optimize a high level program that leverages laziness in key areas (such as staged move generation and ordering) producing an efficient binary that can compete in a field where lower level languages (C, C++, Rust) are usually employed.++Turncoat has an official account on Lichess: https://lichess.org/@/TurncoatEngine+++## Characteristics++### Move Generation++- Legal Move Generation+- Specialized Static Exchanges Move Generator+- Staged Move Generation (captures & promotions, quiet moves)+++### Search++- Negamax+- Alpha Beta Pruning+- Principal Variation Search+- Quiescence Search+- Iterative Deepening+- Transposition Table+- Null Move Pruning+- Futility Pruning+- Check Extensions+- Single move extensions+- Late Move Reductions+++### Move Ordering++- Staged Move Ordering +- Static Exchange Evaluation+- Killer Moves+- Static Evaluation Ordering (for quiet moves)+++### Evaluation++- Hand Tuned Evaluation+- Tapered Evaluation+- Material+- Piece Square Tables+- King Safety+- Mobility+- Passed Pawns+- Pawn King Shield+- Isolated & Doubled Pawns+- Knight Outposts+- Bishop Pair+- Rooks on Open Files+- Piece Threats++
+ app/Main.hs view
@@ -0,0 +1,37 @@+module Main where++import           AppPrelude++import           Models.Command+import           Parsers.Command     (parseCommand)+import           Uci                 (executeCommand, initialEngineState,+                                      putStrLnFlush)++import           Control.Monad.State+import qualified Data.Char           as Char+++main :: IO ()+main = do+  printHeader+  st <- initialEngineState+  evalStateT (forever repl) st+  where+    repl = do+      input <- getLine+      unless (all Char.isSpace input)+             (eval input)+    eval =+      either (const $ putStrLnFlush parseErrorMsg) executeCommand+      . parseCommand+++printHeader :: IO ()+printHeader =+  putStrLnFlush (name <> " " <> version <> " by " <> author)+  where+    EngineInfo {..} = engineInfo+++parseErrorMsg :: Text+parseErrorMsg = "Error when parsing command"
+ app/Uci.hs view
@@ -0,0 +1,324 @@+module Uci (executeCommand, initialEngineState, putStrLnFlush) where++import           AppPrelude++import           Evaluation.Evaluation+import           Models.Command+import           Models.Move+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove+import           Search.Perft+import           Search.Search+import           Search.TimeManagement+import qualified Utils.KillersTable              as KillersTable+import           Utils.KillersTable              (KillersTable)+import qualified Utils.TranspositionTable        as TTable+import           Utils.TranspositionTable        (TTable)++import           Control.Concurrent.Thread.Delay+import           Control.Monad.State+import           Data.Composition+import qualified Data.Map                        as Map+import           Data.Time.Clock.System+import           System.Exit+++executeCommand :: Command -> CommandM ()+executeCommand = \case+  Uci              -> handleStart+  UciNewGame       -> handleNewGame+  IsReady          -> printReady+  Search opts      -> whenAvailable $ runSearch opts+  Perft  depth     -> whenAvailable $ runPerft  depth+  Divide depth     -> whenAvailable $ runDivide depth+  Ponderhit        -> handlePonderhit+  Stop             -> stop+  Quit             -> quit+  SetPosition pos  -> setPosition pos+  SetOption option -> setOption   option+  MakeMoves mvs    -> makeMoves   mvs+  Evaluate         -> printStaticEval+  Display          -> displayBoard+  Flip             -> flipPosition+++runSearch :: SearchOptions -> CommandM ()+runSearch searchOpts = do+  EngineState{..} <- get+  killersTable   <- liftIO KillersTable.create+  let ?opts         = options+      ?tTable       = tTable+      ?killersTable = killersTable+      ?age          = age+  runTask $ printSearch searchOpts position+  startTime <- liftIO getSystemTime+  modify' \st -> st { searchStart = startTime, searchOptions = searchOpts }+  incrementAge+++runPerft :: Depth -> CommandM ()+runPerft depth = do+  EngineState{..} <- get+  runTask $ printPerft depth position+++runDivide :: Depth -> CommandM ()+runDivide depth = do+  EngineState{..} <- get+  runTask $ printDivide depth position+++printSearch+  :: (?opts :: EngineOptions, ?tTable :: TTable,+     ?killersTable :: KillersTable, ?age :: Age)+  => SearchOptions -> Position -> IO ()+printSearch searchOpts pos = do+  bracket acquire release go+  where+    acquire =+      newIORef $ emptySearchResult 0++    release searchResultRef =+      printBestMove =<< readIORef searchResultRef++    go searchResultRef =+      search searchOpts searchResultRef pos+++printPerft :: Depth -> Position -> IO ()+printPerft = putStrLnFlush . tshow .: perft+++printDivide :: Depth -> Position -> IO ()+printDivide =+  void+  . Map.traverseWithKey (\k v -> putStrLnFlush (tshow k <> ": " <> tshow v))+  .: divide+++printStaticEval :: CommandM ()+printStaticEval = withPosition go+  where+    go = putStrLnFlush+         . ("\n" <>)+         . tshow+         . evaluatePositionBreakdown+++handlePonderhit :: CommandM ()+handlePonderhit = do+  EngineState {..} <- get+  now <- liftIO getSystemTime+  let elapsedTime = now |-| searchStart+  case getMoveTime searchOptions position of+    Just moveTime+      | elapsedTime > moveTime -> stop+      | otherwise -> liftIO $ void $ async do+          delay $ fromIntegral (moveTime - elapsedTime)+          stopTask taskRef+    Nothing -> pure ()+++stop :: CommandM ()+stop = do+  st <- get+  liftIO $ stopTask st.taskRef+++quit :: CommandM ()+quit = do+  stop+  liftIO exitSuccess+++handleNewGame :: CommandM ()+handleNewGame = do+  EngineState {tTable} <- get+  liftIO $ TTable.reset tTable+  updatePosition $ Just startPosition+  modify' \st -> st {age = 0}+++handleStart :: CommandM ()+handleStart = do+  printEngineInfo+  putStrLnFlush mempty+  printEngineOptions+  printUciReady+++setPosition :: PositionSpec -> CommandM ()+setPosition PositionSpec {..} =+  updatePosition+    $ foldM (flip makeUnknownMove) initialPosition moves+++setOption :: OptionSpec -> CommandM ()+setOption = \case+  Ponder ponder ->+    modifyOptions \x -> x { ponder = ponder }++  HashSize size -> do+    modifyOptions \x -> x { hashSize = fromIntegral size }+    EngineState {options} <- get+    newTTable <- liftIO $ TTable.create options+    modify' \st -> st { tTable = newTTable }++  ClearHash -> do+    EngineState {tTable} <- get+    liftIO $ TTable.reset tTable+++printBestMove :: MonadIO m => SearchResult -> m ()+printBestMove SearchResult {..}+  | Just mv  <- bestMove+  , Just mv2 <- ponderMove+    = putStrLnFlush ("bestmove " <> tshow mv <> " ponder " <> tshow mv2)+  | Just mv  <- bestMove+    = putStrLnFlush ("bestmove " <> tshow mv)+  | otherwise+    = putStrLnFlush mempty+++printUciReady :: CommandM ()+printUciReady = putStrLnFlush "uciok"+++printReady :: CommandM ()+printReady = putStrLnFlush "readyok"+++printEngineInfo :: CommandM ()+printEngineInfo = do+  go "name"  (name <> " " <> version)+  go "author" author+  where+    EngineInfo {..} = engineInfo+    go param value =+      putStrLnFlush ("id" <> " " <> param <> " " <> value)+++printEngineOptions :: CommandM ()+printEngineOptions = do+  go "Hash"       (SpinOption hashSize 1 maxBound)+  go "Clear Hash" ButtonOption+  go "Ponder"     (CheckOption ponder)+  where+    EngineOptions {..} = defaultEngineOptions+    go param option =+      putStrLnFlush ("option name " <> param <> " " <> tshow option)+++makeMoves :: [UnknownMove] -> CommandM ()+makeMoves mvs = do+  st <- get+  setPosition $ PositionSpec st.position mvs+++flipPosition :: CommandM ()+flipPosition =+  modifyPosition makeNullMove+++displayBoard :: CommandM ()+displayBoard = do+  putStrLnFlush mempty+  withPosition print+  putStrLnFlush mempty+++updatePosition :: Maybe Position -> CommandM ()+updatePosition = \case+  Just pos -> modifyPosition $ const pos+  Nothing  -> putStrLnFlush "Error: Invalid Position"+++makeUnknownMove :: UnknownMove -> Position -> Maybe Position+makeUnknownMove UnknownMove {..} pos =+  (`makeMove` pos) <$> find isSameMove (allMoves pos)+  where+    isSameMove mv =+      mv.start == start && mv.end == end && mv.promotion == promotion+++whenAvailable :: CommandM () -> CommandM ()+whenAvailable action = do+  task <- getTask+  when (isNothing task) action+++runTask :: IO () -> CommandM ()+runTask action = do+  st <- get+  task        <- liftIO $ async (action *> writeIORef st.taskRef Nothing)+  writeIORef st.taskRef $ Just task+++stopTask :: IORef (Maybe Task) -> IO ()+stopTask taskRef = do+  task <- readIORef taskRef+  traverse_ cancel task+  writeIORef taskRef Nothing+++getTask :: CommandM (Maybe Task)+getTask = do+  st <- get+  readIORef st.taskRef+++withPosition :: (Position -> CommandM a) -> CommandM a+withPosition f = do+  st <- get+  f st.position+++modifyOptions :: (EngineOptions -> EngineOptions) -> CommandM ()+modifyOptions f =+  modify' \st -> st { options = f st.options }+++modifyPosition :: (Position -> Position) -> CommandM ()+modifyPosition f =+  modify' \st -> st { position = f st.position }+++incrementAge :: CommandM ()+incrementAge =+  modify' \st -> st {age = if st.age == 127 then 0 else st.age + 1}+++data EngineState = EngineState+  { position      :: Position+  , options       :: EngineOptions+  , taskRef       :: IORef (Maybe Task)+  , searchStart   :: SystemTime+  , searchOptions :: SearchOptions+  , tTable        :: TTable+  , age           :: Word8+  }+++initialEngineState :: IO EngineState+initialEngineState = do+  taskRef <- newIORef Nothing+  tTable  <- TTable.create defaultEngineOptions+  pure EngineState+    { position      = startPosition+    , options       = defaultEngineOptions+    , taskRef       = taskRef+    , searchStart   = MkSystemTime 0 0+    , searchOptions = defaultSearchOptions+    , tTable        = tTable+    , age           = 0+    }+++putStrLnFlush :: MonadIO m => Text -> m ()+putStrLnFlush message = do+  putStrLn message+  hFlush stdout+++type CommandM = StateT EngineState IO
+ src/AppPrelude.hs view
@@ -0,0 +1,64 @@+module AppPrelude (module ClassyPrelude, module Data.Ord, Vector, (!!), (/), (%), inRange, maybeFilter, findTraverseIndex, untilM, elem, notElem) where++import           ClassyPrelude        hiding (Vector, elem, mask, notElem, (/), (>>), (^))++import           Data.Foldable        (elem, notElem)+import           Data.Int             (Int16)+import           Data.Ord+import           Data.Vector.Storable (Vector)+++{-# SPECIALIZE (!!) :: Vector Int16 -> Int -> Int16 #-}+{-# SPECIALIZE (!!) :: Vector Word64 -> Int -> Word64 #-}+{-# INLINE (!!)  #-}+infixl 9 !!+(!!) :: Storable a => Vector a -> Int -> a+(!!) !x !y = unsafeIndex x y+++{-# SPECIALIZE (/) :: Int16 -> Int16 -> Int16 #-}+{-# SPECIALIZE (/) :: Int -> Int -> Int #-}+{-# INLINE (/)  #-}+infixl 7 /+(/) :: Integral a => a -> a -> a+(/) !x !y = quot x y++{-# SPECIALIZE (%) :: Int16 -> Int16 -> Int16 #-}+{-# SPECIALIZE (%) :: Int -> Int -> Int #-}+{-# SPECIALIZE (%) :: Word64 -> Word64 -> Word64 #-}+{-# INLINE (%)  #-}+infixl 7 %+(%) :: Integral a => a -> a -> a+(%) !x !y = rem x y+++inRange :: Int -> Int -> Int -> Bool+inRange lo hi x = lo <= x && x <= hi+++{-# INLINE maybeFilter  #-}+maybeFilter :: (a -> Bool) -> Maybe a -> Maybe a+maybeFilter !predicate ma = do+  !a <- ma+  if predicate a+    then ma+    else Nothing+++{-# INLINE findTraverseIndex  #-}+findTraverseIndex :: Monad m => (Int -> a -> m (Maybe b)) -> [a] -> m (Maybe b)+findTraverseIndex !f = go 0+  where+    go !i (!x : xs) = do+      result <- f i x+      maybe (go (i + 1) xs) (pure . Just) result+    go _ [] =+      pure Nothing+++{-# INLINE untilM  #-}+untilM :: Monad m => (a -> m Bool) -> [a] -> m ()+untilM !f = go+  where+    go (!x : xs) = unlessM (f x) (go xs)+    go []        = pure ()
+ src/Evaluation/Evaluation.hs view
@@ -0,0 +1,386 @@+module Evaluation.Evaluation (evaluatePosition, evaluatePositionBreakdown, evaluateExchange, evaluateMvvLva)+where++import           AppPrelude++import           Evaluation.Material+import           Evaluation.Parameters+import           Evaluation.ScoreBreakdown+import           Models.Move+import           Models.Piece+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove+import           MoveGen.PieceAttacks+import           MoveGen.PieceCaptures+import           MoveGen.PositionQueries+import           Utils.Board++++evaluatePosition :: Position -> Score+evaluatePosition =+ evalScore . evaluatePositionBreakdown+++evaluatePositionBreakdown :: Position -> ScoreBreakdown+evaluatePositionBreakdown pos =+  let+    !enemyPos         = makeNullMove pos+    !scoresBatch      = getScoresBatch pos+    !enemyScoresBatch = getScoresBatch enemyPos+    !playerBreakdown =+      evaluatePlayerBreakdown scoresBatch enemyScoresBatch pos+    !enemyBreakdown  =+      evaluatePlayerBreakdown enemyScoresBatch scoresBatch enemyPos+    !materialScore   =+         evalScore playerBreakdown.materialBreakdown+       - evalScore enemyBreakdown.materialBreakdown+    !materialTradesScore =+      evaluateMaterialTrades materialScore pos+  in+    ScoreBreakdown {..}+  where+    ?phase       = pos.phase+    ?colorToMove = pos.color+++evaluatePlayerBreakdown :: (?phase :: Phase, ?colorToMove :: Color)+  => ScoresBatch -> ScoresBatch -> Position -> PlayerScoreBreakdown+evaluatePlayerBreakdown scoresBatch enemyScoresBatch pos =+  PlayerScoreBreakdown {+    materialBreakdown =+      evaluatePlayerMaterial pos pos.player pos.color+  , bonusBreakdown    =+      evaluatePositionBonuses scoresBatch pos+  , penaltyBreakdown  =+      evaluatePositionPenalties scoresBatch enemyScoresBatch pos+  }+++evaluatePositionBonuses :: (?phase :: Phase, ?colorToMove :: Color)+  => ScoresBatch -> Position -> BonusBreakdown+evaluatePositionBonuses ScoresBatch {..} pos =+  BonusBreakdown {+    mobility        = mobility+  , passedPawns     = evaluatePassedPawns      pos+  , bishopPair      = evaluateBishopPair       pos+  , knightOutposts  = evaluateKnightOutposts   pos+  , rooksOnOpenFile = evaluateRooksOnOpenFiles pos+  , kingPawnShield  = evaluateKingPawnShield   pos+  , castlingRights  = evaluateCastlingRights   pos+  }+++evaluatePositionPenalties+  :: ScoresBatch -> ScoresBatch -> Position -> PenaltyBreakdown+evaluatePositionPenalties+  ScoresBatch {threats} ScoresBatch {kingThreats} Position {player, pawns} =+  PenaltyBreakdown {+    threats        = threats+  , kingThreats    = kingThreats+  , isolatedPawns  = evaluateIsolatedPawns (player & pawns)+  , doubledPawns   = evaluateDoubledPawns  (player & pawns)+  }+++evaluateBishopPair :: (?phase :: Phase) => Position -> Score+evaluateBishopPair Position {player, bishops} =+   bishopPairBonus+   * fromIntegral (clamp (0, 1) (popCount (player & bishops) - 1))+++evaluateKnightOutposts :: (?phase :: Phase) => Position -> Score+evaluateKnightOutposts Position {..} =+  knightOutpostBonus+  * fromIntegral (foldlBoard 0 (+) mapFn+    (knights&player & defended & ranks & knightOupostFiles))+  where+    defended = pawnAttacks color (player&pawns)+    mapFn !n = toReverseCondition (attackersVec !! n & enemy&pawns)+    (!ranks, !attackersVec) = case color of+      White -> (whiteKnightOutpostRanks , whiteKnightOutpostAttackersVec)+      Black -> (blackKnightOutpostRanks , blackKnightOutpostAttackersVec)+++evaluateRooksOnOpenFiles :: (?phase :: Phase) => Position -> Score+evaluateRooksOnOpenFiles Position {..} =+  rookOnSemiOpenFileBonus+  * (eval file_A + eval file_B + eval file_C + eval file_D+   + eval file_E + eval file_F + eval file_G + eval file_H)+  where+    eval fileBoard+      | playerRooksInFile == 0                                          = 0+      | pawnsInFile       == 0 || lastPieceSquare pawnsInFile       <! n = 2+      | playerPawnsInFile == 0 || lastPieceSquare playerPawnsInFile <! n = 1+      | otherwise                                                      = 0+      where+        playerRooksInFile = player & rooks & fileBoard+        playerPawnsInFile = player & pawnsInFile+        pawnsInFile       = pawns  & fileBoard+        n                 = lastPieceSquare playerRooksInFile++    (!(<!), !lastPieceSquare) = case color of+      White -> ((<), msb)+      Black -> ((>), lsb)+++evaluatePassedPawns ::+  (?phase :: Phase, ?colorToMove :: Color) => Position -> Score+evaluatePassedPawns pos@Position {..} =+  eval file_A + eval file_B + eval file_C + eval file_D+  + eval file_E + eval file_F + eval file_G + eval file_H+  where+    eval fileBoard+      | pawnsInFile == 0 || blockersVec !! n & enemy&pawns /= 0 = 0+      | otherwise = passerScore + escortedPasserScore+      where+        passerScore+          | isUnstoppablePawn n = unstoppablePawnBonus+          | isFreePasser rank n = freePassedPawnTable !!% rank+          | otherwise           = passedPawnTable     !!% rank+        escortedPasserScore = kingEscortedPassedPawnBonus *+           fromIntegral (getSquareDistance n enemyKingSquare+                       - getSquareDistance n kingSquare)+        rank            = normalizeRank $ toRank n+        pawnsInFile     = player & pawns & fileBoard+        n               = lastPawnSquare pawnsInFile+        kingSquare      = lsb (player & kings)+        enemyKingSquare = lsb (enemy & kings)++    isFreePasser rank n =+      testSquare noPieces (nextRank n)+      && evaluateExchange (Move Pawn promotion n $ nextRank n) pos >= 0+      where+        promotion | rank == 7 = QueenProm+                  | otherwise = NoProm++    isUnstoppablePawn pawnSquare =+        enemy & (knights .| bishops .| rooks .| queens) == 0+      && kingDistance > pawnDistance+      where+        pawnDistance = getSquareDistance pawnSquare promotionSquare+        kingDistance =+          getSquareDistance kingSquare promotionSquare - kingDistanceOffset++        promotionSquare = 8 * promotionRank + pawnFile+        pawnFile        = toFile pawnSquare+        kingSquare      = lsb (enemy & kings)+        kingDistanceOffset+          | color /= ?colorToMove = 1+          | otherwise            = 0++    (!normalizeRank, !nextRank, !lastPawnSquare, !blockersVec,+     !promotionRank) =+      case color of+        White ->+          (id   , (+ 8)     , msb, whitePassedPawnBlockersVec, 7)+        Black ->+          ((7 -), \n -> n - 8, lsb, blackPassedPawnBlockersVec, 0)+    !noPieces = (~) (player .| enemy)+++evaluateKingPawnShield :: (?phase :: Phase) => Position -> Score+evaluateKingPawnShield Position {..} =+  maybe 0 go+    $ find ((`testSquare` kingSquare) . (kingRank &))+      [shortCastleFiles, longCastleFiles]+  where+    go board =+        pawnShield1RankBonus+        * popCountToScore (pawnShield1Rank & board & player & pawns)+      + pawnShield2RankBonus+        * popCountToScore (pawnShield2Rank & board & player & pawns)+    (kingRank, pawnShield1Rank, pawnShield2Rank) = case color of+      White -> (rank_1, rank_2, rank_3)+      Black -> (rank_8, rank_7, rank_6)+    kingSquare = lsb (player & kings)+++evaluateCastlingRights :: Position -> Score+evaluateCastlingRights Position{castling}+  | castling /= 0 = castlingRightsBonus+  | otherwise    = 0+++evaluateIsolatedPawns :: Board -> Score+evaluateIsolatedPawns pawns =+  isolatedPawnPenalty * fromIntegral isolatedPawnsCount+  where+    isolatedPawnsCount =+        popCountToBoard (file_B & pawns)+        * toReverseCondition (pawns & (file_A .| file_C))+      + popCountToBoard (file_C & pawns)+        * toReverseCondition (pawns & (file_B .| file_D))+      + popCountToBoard (file_D & pawns)+        * toReverseCondition (pawns & (file_C .| file_E))+      + popCountToBoard (file_E & pawns)+        * toReverseCondition (pawns & (file_D .| file_F))+      + popCountToBoard (file_F & pawns)+        * toReverseCondition (pawns & (file_E .| file_G))+      + popCountToBoard (file_G & pawns)+        * toReverseCondition (pawns & (file_F .| file_H))+++evaluateDoubledPawns :: Board -> Score+evaluateDoubledPawns pawns =+  doubledPawnPenalty * fromIntegral doubledPawnsCount+  where+    doubledPawnsCount =+        max 1 (popCount (file_A & pawns))+      + max 1 (popCount (file_B & pawns))+      + max 1 (popCount (file_C & pawns))+      + max 1 (popCount (file_D & pawns))+      + max 1 (popCount (file_E & pawns))+      + max 1 (popCount (file_F & pawns))+      + max 1 (popCount (file_G & pawns))+      + max 1 (popCount (file_H & pawns))+      - 8+++evaluateMaterialTrades :: Score -> Position -> Score+evaluateMaterialTrades materialScore Position {..} =+    convert (losingPenalty - winningPenalty)+  where+    losingPenalty =+      pieceTradesPenalty * losingMissingPieces * absoluteMaterialScore / 700+    winningPenalty =+      pawnTradesPenalty  * winningMissingPawns * absoluteMaterialScore / 800+    losingMissingPieces = max 0+      (7 - popCountToScore (losingBoard & (knights .| bishops .| rooks .| queens)))+    winningMissingPawns =+      8 - popCountToScore (winningBoard & pawns)+    absoluteMaterialScore = abs materialScore+    (winningBoard, losingBoard, convert)+      | materialScore > 0 = (player, enemy , id)+      | otherwise         = (enemy , player, negate)+++getScoresBatch :: (?phase :: Phase) => Position -> ScoresBatch+getScoresBatch pos+  | isKingInCheck pos = emptyScoresBatch+getScoresBatch Position {..} = ScoresBatch {..}+  where+    mobility =+      knightsMobility + bishopsMobility + rooksMobility + queensMobility++    kingThreats =+      (kingThreatPiecesTable !! piecesCount) * kingThreatScore / 100++    piecesCount =+      knightsCount + bishopsCount + rooksCount + queensCount++    threats =+      queenThreat+        * popCountToScore (player & queens & (minorDefended .| pawnDefended))+      + rookThreat+        * popCountToScore (player & rooks & pawnDefended)+      + minorPieceThreat+        * popCountToScore (player & (knights .| bishops) & pawnDefended)++    kingThreatScore =+        threatByMinorPenalty * fromIntegral+          (byKnightThreats + byBishopThreats)+      + threatByRookPenalty  * fromIntegral byRookThreats+      + threatByQueenPenalty * fromIntegral byQueenThreats++    (knightsMobility, byKnightThreats, knightsCount) =+      foldBoardScores knightMobilityTable+        knightAttacks+        pawnDefended+        (unpinned&knights)++    (bishopsMobility, byBishopThreats, bishopsCount) =+      foldBoardScores bishopMobilityTable+        (bishopMoves (allPieces .\ player & queens) pinnedPieces king)+        pawnDefended+        (player&bishops)++    (rooksMobility, byRookThreats, rooksCount) =+      foldBoardScores rookMobilityTable+        (rookMoves (allPieces .\ player & queens)+         pinnedPieces king)+        (pawnDefended .| minorDefended)+        (player&rooks)++    (queensMobility, byQueenThreats, queensCount) =+      foldBoardScores queenMobilityTable+        (queenMoves allPieces pinnedPieces king)+        (pawnDefended .| minorDefended .| rookDefended)+        (player&queens)+++    foldBoardScores !mobilityTable !movesFn !defended !board =+      foldlBoard (0, 0, 0) foldFn movesFn board+      where+        foldFn (!x, !y, !z) !attackArea =+          (x + mobilityTable+           !!% popCount (attackArea .\ (player .| defended)),+           y + threatenedSquares,+           z + toCondition threatenedSquares)+          where+            !threatenedSquares = popCount (enemyKingArea & attackArea)++    !king           = player & kings+    !unpinned       = player .\ pinnedPieces+    !allPieces      = player .| enemy++    !enemyKingArea  =+      kingAttacks (lsb (enemy&kings))+    !pawnDefended   =+      pawnAttacks (reverseColor color) (enemy&pawns)+    !minorDefended =+         foldBoardAttacks knightAttacks (enemy&knights)+      .| foldBoardAttacks (bishopAttacks allPieces) (enemy&bishops)+    !rookDefended =+       foldBoardAttacks (rookAttacks allPieces) (enemy&rooks)+++evaluateExchange :: Move -> Position -> Score+evaluateExchange initialMv initialPos =+  let ?phase = initialPos.phase+  in go initialMv initialPos+  where+    !square = initialMv.end+    go !mv !pos =+      let newPos = makeMove mv pos+      in evaluateCapturedPiece mv pos+      - case headMay $ staticExchangeCaptures square newPos of+        Just newMv -> max 0 $! go newMv newPos+        Nothing    -> 0+++{-# INLINE evaluateMvvLva #-}+evaluateMvvLva :: Move -> Position -> Word8+evaluateMvvLva Move {..} pos =+  promotionValue + maybe 0 exchangeValue (maybeCapturedPieceAt end pos)+  where+    exchangeValue capturedPiece =+      10 * (getPieceValue capturedPiece + 1)+      - getPieceValue piece+    promotionValue = 10 * (promotionPieceValue + 1)+    promotionPieceValue = case promotion of+      QueenProm  -> getPieceValue Queen+      KnightProm -> getPieceValue Knight+      BishopProm -> getPieceValue Bishop+      RookProm   -> getPieceValue Rook+      NoProm     -> 0+++data ScoresBatch = ScoresBatch {+    mobility    :: Score+  , threats     :: Score+  , kingThreats :: Score++}++emptyScoresBatch :: ScoresBatch+emptyScoresBatch = ScoresBatch {+    mobility    = 0+  , threats     = 0+  , kingThreats = 0+}+++popCountToScore :: Board -> Score+popCountToScore = fromIntegral . popCount
+ src/Evaluation/Material.hs view
@@ -0,0 +1,66 @@+module Evaluation.Material (evaluatePlayerMaterial, evaluateCapturedPiece) where++import           AppPrelude++import           Evaluation.Parameters+import           Evaluation.ScoreBreakdown+import           Models.Move+import           Models.Piece+import           Models.Position+import           Models.Score+import           Utils.Board+++evaluatePlayerMaterial+  :: (?phase :: Phase) => Position -> Board -> Color -> MaterialBreakdown+evaluatePlayerMaterial Position {..} !board = \case+    White -> MaterialBreakdown+          (boardScore queenScore                     (board & queens))+          (boardScore rookScore                      (board & rooks))+          (boardScore bishopScore                    (board & bishops))+          (boardScore knightScore                    (board & knights))+          (boardScore pawnScore                      (board & pawns))+          (ScorePair 0 (whiteKingSquareTable !!% lsb (board & kings)))+    Black -> MaterialBreakdown+          (boardScore queenScore                     (board & queens))+          (boardScore rookScore                      (board & rooks))+          (boardScore bishopScore                    (board & bishops))+          (boardScore knightScore                    (board & knights))+          (boardScore pawnScore                      (board & pawns))+          (ScorePair 0 (blackKingSquareTable !!% lsb (board & kings)))+++{-# INLINE  boardScore #-}+boardScore :: Score -> Board -> ScorePair+boardScore !pieceTypeScore !board =+  ScorePair materialScore 0+  where+    materialScore = pieceTypeScore * fromIntegral (popCount board)+++{-# INLINE  evaluateCapturedPiece #-}+evaluateCapturedPiece :: (?phase :: Phase) => Move -> Position -> Score+evaluateCapturedPiece Move {..} pos =+  evaluatePromotion promotion+  + maybe 0 evaluatePiece (maybeCapturedPieceAt end pos)+++{-# INLINE  evaluatePromotion #-}+evaluatePromotion :: (?phase :: Phase) => Promotion -> Score+evaluatePromotion = \case+  KnightProm -> knightScore+  BishopProm -> bishopScore+  RookProm   -> rookScore+  QueenProm  -> queenScore+  NoProm     -> 0+++{-# INLINE  evaluatePiece #-}+evaluatePiece :: (?phase :: Phase) => Piece -> Score+evaluatePiece = \case+  Pawn   -> pawnScore+  Knight -> knightScore+  Bishop -> bishopScore+  Rook   -> rookScore+  Queen  -> queenScore+  King   -> 0
+ src/Evaluation/Parameters.hs view
@@ -0,0 +1,162 @@+module Evaluation.Parameters where++import           AppPrelude+import           Data.List.Split           (chunksOf)+import           Evaluation.ScoreBreakdown+import           Models.Piece+import           Models.Score+import           Utils.Board++import qualified Data.Vector.Storable      as Vector+++-- Material scores+pawnScore :: Score+pawnScore = 100++bishopScore :: Score+bishopScore = 340++knightScore :: Score+knightScore = 340++rookScore :: (?phase :: Phase) => Score+rookScore = taperScore $ ScorePair 500 550++queenScore :: (?phase :: Phase) => Score+queenScore = taperScore $ ScorePair 1000 1050+++-- Bonuses+castlingRightsBonus :: Score+castlingRightsBonus = 20++bishopPairBonus :: (?phase :: Phase) => Score+bishopPairBonus = taperScore $ ScorePair 25 100++knightOutpostBonus :: (?phase :: Phase) => Score+knightOutpostBonus = taperScore $ ScorePair 50 0++rookOnSemiOpenFileBonus :: (?phase :: Phase) => Score+rookOnSemiOpenFileBonus = taperScore $ ScorePair 10 0++pawnShield1RankBonus :: (?phase :: Phase) => Score+pawnShield1RankBonus = taperScore $ ScorePair 10 0++pawnShield2RankBonus :: (?phase :: Phase) => Score+pawnShield2RankBonus = taperScore $ ScorePair 5 0++unstoppablePawnBonus :: Score+unstoppablePawnBonus = 700++kingEscortedPassedPawnBonus :: (?phase :: Phase) => Score+kingEscortedPassedPawnBonus = taperScore $ ScorePair 0 20++passedPawnTable :: Vector ScorePair+passedPawnTable = Vector.fromList $ map (uncurry ScorePair)+  [(0, 0), (0, 5), (5, 20), (20, 50),+   (30, 100), (40, 150), (50, 200)]++freePassedPawnTable :: Vector ScorePair+freePassedPawnTable = Vector.fromList $ map (uncurry ScorePair)+  [(0, 0), (0, 10), (5, 35), (20, 80),+   (30, 150), (40, 230), (50, 350)]+++knightMobilityTable :: Vector ScorePair+knightMobilityTable = Vector.fromList $ map (uncurry ScorePair)+  [(-15, -30), (-5, -10), (-1, -2), (2, 4), (5, 10),+   (8, 16), (11, 21), (13, 26), (15, 30)]++bishopMobilityTable :: Vector ScorePair+bishopMobilityTable = Vector.fromList $ map (uncurry ScorePair)+  [(-25, -75), (-11, -33), (-6, -18), (-1, -3),+   (3, 9), (6, 18), (9, 27), (12, 36), (14, 42),+   (17, 51), (19, 57), (21, 63), (23, 69), (25, 75)]++rookMobilityTable :: Vector ScorePair+rookMobilityTable = Vector.fromList $ map (uncurry ScorePair)+  [(-10, -50), (-4, -20), (-2, -10), (0, 0), (1, 5),+   (2, 10), (3, 15), (4, 20), (5, 25), (6, 30),+   (7, 34), (8, 38), (9, 42), (10, 46), (10, 50)]++queenMobilityTable :: Vector ScorePair+queenMobilityTable = Vector.fromList $ map (uncurry ScorePair)+  [(-10, -50), (-6, -30), (-5, -22), (-4, -16), (-2, -10),+   (-1, -5), (0, -1), (1, 3), (1, 7), (2, 11), (2, 14),+   (3, 17), (3, 20), (4, 23), (4, 26), (5, 28), (5, 30),+   (6, 32), (6, 34), (7, 36), (7, 38), (8, 40), (8, 42),+   (9, 44), (9, 46), (10, 48), (10, 49), (10, 50)]++++-- Penalties+threatByMinorPenalty :: Score+threatByMinorPenalty = 20++threatByRookPenalty :: Score+threatByRookPenalty = 40++threatByQueenPenalty :: Score+threatByQueenPenalty = 80++isolatedPawnPenalty :: Score+isolatedPawnPenalty = 25++doubledPawnPenalty :: Score+doubledPawnPenalty = 20++minorPieceThreat :: Score+minorPieceThreat = 20++rookThreat :: Score+rookThreat = 30++queenThreat :: Score+queenThreat = 40++pieceTradesPenalty :: Score+pieceTradesPenalty = 15++pawnTradesPenalty :: Score+pawnTradesPenalty = 30+++kingThreatPiecesTable :: Vector Score+kingThreatPiecesTable = Vector.fromList+  [0, 0, 0, 50, 75, 88, 94, 97, 99, 100,+   100, 100, 100, 100, 100, 100, 100]+++blackKingSquareTable :: Vector ScorePair+blackKingSquareTable = Vector.fromList $ map (`ScorePair` 0)+  [-30,-40,-40,-50,-50,-40,-40,-30,+   -30,-40,-40,-50,-50,-40,-40,-30,+   -30,-40,-40,-50,-50,-40,-40,-30,+   -30,-40,-40,-50,-50,-40,-40,-30,+   -20,-30,-30,-40,-40,-30,-30,-20,+   -10,-20,-20,-30,-30,-20,-20,-10,+     10, 10, 0, -10, -10, 0,  10, 10,+    30, 30, 30,  0,  0, 0, 30, 30]++whiteKingSquareTable :: Vector ScorePair+whiteKingSquareTable = reverseSquareTable blackKingSquareTable++infixl 9 !!%+(!!%) :: (?phase::Phase) => Vector ScorePair -> Int -> Score+(!!%) table idx = taperScore (table !! idx)+++taperScore :: (?phase :: Phase) => ScorePair -> Score+taperScore (ScorePair mgScore egScore) =+  (?phase * mgScore + (totalPhase - ?phase) * egScore) / totalPhase+++getSquareTableIndex :: Board -> Color -> Square+getSquareTableIndex board color =+  lsb board + 64 * fromIntegral color+++reverseSquareTable :: Storable a => Vector a -> Vector a+reverseSquareTable =+  fromList . fold . reverse . chunksOf 8 . toList
+ src/Evaluation/ScoreBreakdown.hs view
@@ -0,0 +1,160 @@+module Evaluation.ScoreBreakdown where++import           AppPrelude++import           Models.Score++import           Bookhound.Utils.Text+import           Foreign.Storable.Generic+++data ScoreBreakdown = ScoreBreakdown+  { playerBreakdown     :: PlayerScoreBreakdown+  , enemyBreakdown      :: PlayerScoreBreakdown+  , materialTradesScore :: Score+  }++data PlayerScoreBreakdown = PlayerScoreBreakdown+  { materialBreakdown :: MaterialBreakdown+  , bonusBreakdown    :: BonusBreakdown+  , penaltyBreakdown  :: PenaltyBreakdown+  }++data MaterialBreakdown = MaterialBreakdown+  { queens  :: ScorePair+  , rooks   :: ScorePair+  , bishops :: ScorePair+  , knights :: ScorePair+  , pawns   :: ScorePair+  , kings   :: ScorePair+  }++data BonusBreakdown = BonusBreakdown+  { mobility        :: Score+  , passedPawns     :: Score+  , bishopPair      :: Score+  , knightOutposts  :: Score+  , rooksOnOpenFile :: Score+  , kingPawnShield  :: Score+  , castlingRights  :: Score+  }++data PenaltyBreakdown = PenaltyBreakdown+  { threats       :: Score+  , kingThreats   :: Score+  , isolatedPawns :: Score+  , doubledPawns  :: Score+  }++data ScorePair = ScorePair Score Score+  deriving Generic++instance GStorable ScorePair++class EvalScore a where+  evalScore :: a -> Score+++instance EvalScore ScoreBreakdown where+  evalScore ScoreBreakdown {..} =+    evalScore playerBreakdown - evalScore enemyBreakdown+++instance EvalScore PlayerScoreBreakdown where+  evalScore PlayerScoreBreakdown {..} =+      evalScore materialBreakdown+    + evalScore bonusBreakdown+    - evalScore penaltyBreakdown++instance EvalScore MaterialBreakdown where+  evalScore MaterialBreakdown {..} =+      evalScore queens  + evalScore rooks+    + evalScore bishops + evalScore knights+    + evalScore pawns   + evalScore kings+++instance EvalScore BonusBreakdown where+  evalScore BonusBreakdown {..} =+      mobility        + passedPawns+    + bishopPair      + knightOutposts+    + rooksOnOpenFile + kingPawnShield+    + castlingRights+++instance EvalScore PenaltyBreakdown where+  evalScore PenaltyBreakdown {..} =+      threats       + kingThreats+    + isolatedPawns + doubledPawns++instance EvalScore ScorePair where+  evalScore (ScorePair x y) = x + y+++instance Show ScoreBreakdown where+  show breakdown@ScoreBreakdown {..} = unlines+    ["Player: " <> indentBreak (show playerBreakdown),+     "Enemy:  " <> indentBreak (show enemyBreakdown),+     totalScoreLine,+     "Total: "  <> show (evalScore breakdown),+     totalScoreLine]++++instance Show PlayerScoreBreakdown where+  show breakdown@PlayerScoreBreakdown {..} = unlines+    ["Material:       " <> indentBreak (show materialBreakdown),+     "Bonus Scores:   " <> indentBreak (show bonusBreakdown),+     "Penalty Scores: " <> indentBreak (show penaltyBreakdown),+     totalScoreLine,+     "Player Total: "   <> show (evalScore breakdown),+     totalScoreLine]++instance Show MaterialBreakdown where+  show breakdown@MaterialBreakdown {..} = unlines+    ["Queens:  "        <> show queens,+     "Rooks:   "        <> show rooks,+     "Bishops: "        <> show bishops,+     "Knights: "        <> show knights,+     "Pawns:   "        <> show pawns,+     "Kings:   "        <> show kings,+     totalScoreLine,+     "Material Total: " <> show (evalScore breakdown),+     totalScoreLine]+++instance Show BonusBreakdown where+  show breakdown@BonusBreakdown {..} = unlines+    ["Mobility:            " <> show mobility,+     "Passed Pawns:        " <> show passedPawns,+     "Bishop Pair:         " <> show bishopPair,+     "Knight Outposts:     " <> show knightOutposts,+     "Rooks On Open Files: " <> show rooksOnOpenFile,+     "King Pawn Shield:    " <> show kingPawnShield,+     "Castling Rights:     " <> show castlingRights,+     totalScoreLine,+     "Bonus Total: "         <> show (evalScore breakdown),+     totalScoreLine]+++instance Show PenaltyBreakdown where+  show breakdown@PenaltyBreakdown {..} = unlines+    ["Threats:        " <> show threats,+     "King Threats:   " <> show kingThreats,+     "Isolated pawns: " <> show isolatedPawns,+     "Doubled pawns:  " <> show doubledPawns,+     totalScoreLine,+     "Penalty Total: "  <> show (evalScore breakdown),+     totalScoreLine]++instance Show ScorePair where+  show (ScorePair x y) = "(" <> fill 4 (show x) <> ", " <> show y <> ")"+++fill :: Int -> String -> String+fill n str = replicate (n - length str) ' ' <> str++indentBreak :: String -> String+indentBreak str = "\n" <> indent 2 str++totalScoreLine :: String+totalScoreLine = replicate 20 '-'
+ src/Models/Command.hs view
@@ -0,0 +1,123 @@+module Models.Command where++import           AppPrelude++import           Models.Piece+import           Models.Position+import           Models.Score+import           Utils.Board++import           Data.Word+++data Command+  = Uci+  | UciNewGame+  | IsReady+  | Search SearchOptions+  | SetPosition PositionSpec+  | SetOption OptionSpec+  | Ponderhit+  | Stop+  | Quit+  | MakeMoves [UnknownMove]+  | Perft Depth+  | Divide Depth+  | Evaluate+  | Display+  | Flip+++data EngineInfo = EngineInfo+  { name    :: Text+  , version :: Text+  , author  :: Text+  }++data EngineOptions = EngineOptions+  { hashSize :: Word16+  , ponder   :: Bool+  }++data EngineOption = SpinOption+  { deflt :: Word16+  , lo    :: Word16+  , hi    :: Word16+  }+  | CheckOption Bool+  | ButtonOption+++data OptionSpec+  = HashSize Int+  | Ponder Bool+  | ClearHash++data SearchOptions = SearchOptions+  { searchMoves        :: [UnknownMove]+  , infinite           :: Bool+  , targetDepth        :: Depth+  , moveTime           :: Maybe Int+  , whiteTime          :: Maybe Int+  , whiteIncrement     :: Maybe Int+  , blackTime          :: Maybe Int+  , blackIncrement     :: Maybe Int+  , movesUntilNextTime :: Maybe Int+  , findMate           :: Maybe Int+  , maxNodes           :: Maybe Word64+  }+++data PositionSpec = PositionSpec+  { initialPosition :: Position,+    moves           :: [UnknownMove]+  }+++data UnknownMove = UnknownMove+  { start     :: Square,+    end       :: Square,+    promotion :: Promotion+  }+++engineInfo :: EngineInfo+engineInfo = EngineInfo+  { name    = "Turncoat"+  , version = "1.0"+  , author  = "Alberto Perez"+  }+++defaultEngineOptions :: EngineOptions+defaultEngineOptions = EngineOptions+  { hashSize = 16+  , ponder   = False+  }+++defaultSearchOptions :: SearchOptions+defaultSearchOptions = SearchOptions+  { searchMoves        = []+  , infinite           = False+  , targetDepth        = maxBound+  , findMate           = Nothing+  , whiteTime          = Nothing+  , whiteIncrement     = Nothing+  , blackTime          = Nothing+  , blackIncrement     = Nothing+  , movesUntilNextTime = Nothing+  , maxNodes           = Nothing+  , moveTime           = Nothing+  }+++instance Show EngineOption where+  show = \case+    SpinOption {..}    -> "type spin" <> " default " <> show deflt+                        <> " min " <> show lo <> " max " <> show hi+    CheckOption deflt -> "type check" <> " default " <> toLower (show deflt)+    ButtonOption      -> "type button"+++type Task = Async ()
+ src/Models/Move.hs view
@@ -0,0 +1,141 @@+module Models.Move (Move(..), StorableMove(..), encodeMove, decodeMove,  foldBoardAttacks, foldBoardMoves, foldBoardMovesConst, foldBoardPawnMovesConst, foldBoardSquares, foldlBoard, showBoard) where++import           AppPrelude+import           Models.Piece+import           Utils.Board++import           Data.Bits+import           Data.List            (iterate)+import qualified Data.Vector.Storable as Vector+import           Test.QuickCheck      (Arbitrary (..), chooseInt)+++data Move = Move {+  piece     :: Piece,+  promotion :: Promotion,+  start     :: Square,+  end       :: Square+} deriving (Eq, Ord, Generic)++instance Hashable Move++instance Arbitrary Move where+  arbitrary = Move+    <$> arbitrary <*> arbitrary+    <*> chooseInt (0, 63) <*> chooseInt (0, 63)++newtype StorableMove = StorableMove Word32+  deriving (Eq, Ord, Num, Bits, Generic, Storable)+++encodeMove :: Maybe Move -> StorableMove+encodeMove Nothing = bit 31+encodeMove (Just Move {..}) = StorableMove+  (fromIntegral start+  .|. (fromIntegral end << 8)+  .|. (fromIntegral pieceN << 16)+  .|. (fromIntegral promotionN << 24))+  where+    Piece pieceN = piece+    Promotion promotionN = promotion++decodeMove :: StorableMove -> Maybe Move+decodeMove (StorableMove n)+  | testBit n 31 = Nothing+  | otherwise = Just $! Move {+      start = start,+      end = end,+      piece = piece,+      promotion = promotion+    }+    where+      start = fromIntegral n .&. 63+      end = fromIntegral (n >> 8) .&. 63+      piece = Piece $ fromIntegral (n >> 16)+      promotion = Promotion $ fromIntegral ((n >> 24) .&. 7)+++{-# INLINE  foldBoardAttacks #-}+foldBoardAttacks :: (Square -> Board) -> Board -> Board+foldBoardAttacks !f !board = foldlBoard 0 (.|) f board+++{-# INLINE  foldBoardMoves #-}+foldBoardMoves :: Piece -> (Square -> Board) -> Board -> [Move] -> [Move]+foldBoardMoves !piece !f !board moves =+  foldlBoard moves (foldBoardSquares piece f) id board+++{-# INLINE  foldBoardMovesConst #-}+foldBoardMovesConst :: Piece -> Square -> Board -> [Move] -> [Move]+foldBoardMovesConst !piece !end !board moves =+  foldlBoard moves genMoves id board+  where+    genMoves xs start = Move piece NoProm start end : xs+++{-# INLINE  foldBoardPawnMovesConst #-}+foldBoardPawnMovesConst :: Square -> Board -> [Move] -> [Move]+foldBoardPawnMovesConst !end !board moves =+  foldlBoard moves genMoves id board+  where+    genMoves xs start = Move Pawn promotion start end : xs+    !promotion+      | testSquare (rank_1 .| rank_8) end = QueenProm+      | otherwise                         = NoProm+++{-# INLINE  foldBoardSquares #-}+foldBoardSquares :: Piece -> (Square -> Board) -> [Move] -> Square -> [Move]+foldBoardSquares Pawn !f moves !start =+    foldlBoard moves (flip $ genPawnMoves start) id $! f start++foldBoardSquares piece !f moves !start =+    foldlBoard moves (flip cons) (Move piece NoProm start) (f start)+++{-# INLINE  genPawnMoves #-}+genPawnMoves :: Square -> Square -> [Move] -> [Move]+genPawnMoves !start !end xs+  | testSquare (rank_1 .| rank_8) end =+    Move Pawn QueenProm start end+    : Move Pawn KnightProm start end+    : Move Pawn RookProm start end+    : Move Pawn BishopProm start end+    : xs+  | otherwise =+    Move Pawn NoProm start end : xs+++{-# INLINE  foldlBoard #-}+foldlBoard :: a -> (a -> b -> a) -> (Square -> b) -> Board -> a+foldlBoard !initial !foldFn !mapFn = go 0 initial+  where+    go  _ acc  0     = acc+    go !i !acc board = go (i' + 1) acc' board'+      where+        acc'    = foldFn acc $! mapFn i'+        i'      = i + current+        board'  = (board >> current) >> 1+        current = lsb board+++showBoard :: Board -> String+showBoard board = unlines $ map showBin+                          $ reverse $ take 8+                          $ iterate (>> 8) board+  where+    showBin w = intersperse ' ' [sb (testSquare w i) | i <- [0 .. 7]]+    sb False = '0'+    sb True  = 'X'+++showSquare :: Square -> String+showSquare n = [fileChars !! toFile n, rankChars !! toRank n]+  where+    fileChars = Vector.fromList ['a' .. 'h']+    rankChars = Vector.fromList ['1' .. '8']+++instance Show Move where+  show (Move {..}) = showSquare start <> showSquare end <> show promotion
+ src/Models/Piece.hs view
@@ -0,0 +1,130 @@+module Models.Piece where++import           AppPrelude+import           Data.Char                 (isUpper)+import qualified Data.Char                 as Char+import qualified Data.Set                  as Set+import           Test.QuickCheck           (Arbitrary, elements)+import           Test.QuickCheck.Arbitrary (Arbitrary (..))+++newtype Piece = Piece Word8+  deriving (Eq, Ord, Enum, Bounded, Hashable, Storable)++instance Arbitrary Piece where+  arbitrary =+    elements [Pawn, Knight, Bishop, Rook, Queen]+++newtype Promotion = Promotion Word8+  deriving (Eq, Ord, Enum, Hashable, Storable)++instance Arbitrary Promotion where+  arbitrary =+    elements [KnightProm, BishopProm, RookProm, QueenProm]++newtype Color = Color Word8+  deriving (Eq, Ord, Enum, Num, Real, Integral)++data CastlingRights = KingSide | QueenSide+++bestPromotions :: Set Promotion+bestPromotions = Set.fromList [NoProm, QueenProm]+++{-# COMPLETE Pawn, Knight, Bishop, Rook, Queen, King #-}+pattern Pawn, Knight, Bishop, Rook, Queen, King :: Piece+pattern Pawn   = Piece 0+pattern Knight = Piece 1+pattern Bishop = Piece 2+pattern Rook   = Piece 3+pattern Queen  = Piece 4+pattern King   = Piece 5++{-# COMPLETE  NoProm, KnightProm, BishopProm, RookProm, QueenProm #-}+pattern NoProm, KnightProm, BishopProm, RookProm, QueenProm :: Promotion+pattern NoProm     = Promotion 0+pattern KnightProm = Promotion 1+pattern BishopProm = Promotion 2+pattern RookProm   = Promotion 3+pattern QueenProm  = Promotion 4++{-# COMPLETE White, Black #-}+pattern White, Black :: Color+pattern White = Color 0+pattern Black = Color 1+++getPieceValue :: Piece -> Word8+getPieceValue (Piece n) = n++reverseColor :: Color -> Color+reverseColor (Color color) =+  Color (1 - color)++pieceToChar :: (Piece, Color) -> Char+pieceToChar (piece, color) =+  case color of+    White -> Char.toUpper char+    Black -> char+  where+    char = case piece of+      Pawn   -> 'p'+      Knight -> 'n'+      Bishop -> 'b'+      Rook   -> 'r'+      Queen  -> 'q'+      King   -> 'k'++charToPiece :: Char -> Maybe (Piece, Color)+charToPiece char = (,color) <$> piece+  where+    color | isUpper char = White+          | otherwise    = Black+    piece = case Char.toLower char of+      'p' -> Just Pawn+      'n' -> Just Knight+      'b' -> Just Bishop+      'r' -> Just Rook+      'q' -> Just Queen+      'k' -> Just King+      _   -> Nothing++charToColor :: Char -> Maybe Color+charToColor char = case char of+  'w' -> Just White+  'b' -> Just Black+  _   -> Nothing++charToCastlingRights :: Char -> Maybe (CastlingRights, Color)+charToCastlingRights char = (,color) <$> piece+  where+    color | isUpper char = White+          | otherwise    = Black+    piece = case Char.toLower char of+      'k' -> Just KingSide+      'q' -> Just QueenSide+      _   -> Nothing++instance Show Piece where+  show = \case+    Pawn -> "Pawn"+    Knight -> "Knight"+    Bishop -> "Bishop"+    Rook -> "Rook"+    Queen -> "Queen"+    King -> "King"++instance Show Promotion where+  show = \case+    NoProm -> mempty+    KnightProm -> "n"+    BishopProm -> "b"+    RookProm -> "r"+    QueenProm -> "q"++instance Show Color where+  show = \case+    White -> "White"+    Black -> "Black"
+ src/Models/Position.hs view
@@ -0,0 +1,170 @@+module Models.Position where+++import           AppPrelude+import           Models.Move        (foldlBoard)+import           Models.Piece+import           Models.Score+import           Utils.Board++import           Data.Bitraversable (bisequence)+import           Data.List.Split    (chunksOf)+import           Data.Maybe         (fromJust)+import           Test.QuickCheck    (Arbitrary (..))+++data Position = Position {+    previousPositions :: ~[ZKey]+  , halfMoveClock     :: Ply+  , phase             :: Phase+  , color             :: Color+  , player            :: Board+  , enemy             :: Board+  , pawns             :: Board+  , knights           :: Board+  , bishops           :: Board+  , rooks             :: Board+  , queens            :: Board+  , kings             :: Board+  , enPassant         :: Board+  , castling          :: Board+  , attacked          :: Board+  , leapingCheckers   :: Board+  , sliderCheckers    :: Board+  , pinnedPieces      :: Board+}++newtype ZKey = ZKey Word64+  deriving (Eq, Show, Generic, Ord, Num, Hashable, Storable, Arbitrary)+++startPosition :: Position+startPosition = emptyPosition {+    color    = White+  , phase    = totalPhase+  , player   = rank_1  .| rank_2+  , enemy    = rank_7  .| rank_8+  , pawns    = rank_2  .| rank_7+  , rooks    = (rank_1 .| rank_8) & (file_A .| file_H)+  , knights  = (rank_1 .| rank_8) & (file_B .| file_G)+  , bishops  = (rank_1 .| rank_8) & (file_C .| file_F)+  , queens   = (rank_1 .| rank_8) & file_D+  , kings    = (rank_1 .| rank_8) & file_E+  , castling = (rank_1 .| rank_8) & (file_A .| file_E .| file_H)+}+++emptyPosition :: Position+emptyPosition = Position {+    previousPositions = []+  , color             = White+  , halfMoveClock     = 0+  , phase             = 0+  , player            = 0+  , enemy             = 0+  , pawns             = 0+  , rooks             = 0+  , knights           = 0+  , bishops           = 0+  , queens            = 0+  , kings             = 0+  , castling          = 0+  , attacked          = 0+  , enPassant         = 0+  , leapingCheckers   = 0+  , sliderCheckers    = 0+  , pinnedPieces      = 0+}+++{-# INLINE  getZobristKey #-}+getZobristKey :: Position -> ZKey+getZobristKey pos@Position {..} = ZKey+  (piecesHash ^ castlingHash ^ enPassantHash ^ sideToMoveHash)+  where++    !piecesHash =+      foldlBoard 0 (^) getPieceHash (player .| enemy)++    !castlingHash = castlingRngVec !! idx+      where+      idx =   inBoard file_A + 2 * inBoard file_H+        + 4 * inBoard rank_1 + 8 * inBoard rank_8+      inBoard x = fromIntegral $ toCondition (castling & x)++    !enPassantHash = toCondition enPassant * enPassantRngVec !! idx+      where+        idx = toFile (lsb enPassant)++    !sideToMoveHash = fromIntegral colorN * sideToMoveRng+      where+        Color colorN = color++    getPieceHash n = pieceRngVec !! idx+      where+      idx = n + 64 * (fromIntegral piece + 6 * fromIntegral pieceColor)+      (Piece piece, Color pieceColor) = fromJust $ pieceAt n pos+++{-# INLINE  pieceAt #-}+pieceAt :: Square -> Position -> Maybe (Piece, Color)+pieceAt n (Position {..}) = bisequence (piece, color')+  where+    piece  | testSquare pawns n   = Just Pawn+           | testSquare knights n = Just Knight+           | testSquare bishops n = Just Bishop+           | testSquare rooks n   = Just Rook+           | testSquare queens n  = Just Queen+           | testSquare kings n   = Just King+           | otherwise            = Nothing++    color' | testSquare player n = Just color+           | testSquare enemy n  = Just $ reverseColor color+           | otherwise           = Nothing+++{-# INLINE  maybeCapturedPieceAt #-}+maybeCapturedPieceAt :: Square -> Position -> Maybe Piece+maybeCapturedPieceAt n (Position {..})+  | testSquare pawns n   = Just Pawn+  | testSquare knights n = Just Knight+  | testSquare bishops n = Just Bishop+  | testSquare rooks n   = Just Rook+  | testSquare queens n  = Just Queen+  | otherwise            = Nothing+++{-# INLINE  isPieceAt #-}+isPieceAt :: Piece -> Square -> Position -> Bool+isPieceAt piece n Position {..} =+  case piece of+    Pawn   -> testSquare pawns n+    Knight -> testSquare knights n+    Bishop -> testSquare bishops n+    Rook   -> testSquare rooks n+    Queen  -> testSquare queens n+    King   -> testSquare kings n+++{-# INLINE  isRepeatedPosition #-}+isRepeatedPosition :: ZKey -> Position -> Bool+isRepeatedPosition zKey Position {..} =+  zKey `elem` previousPositions+++{-# INLINE  getPhase #-}+getPhase :: Position -> Phase+getPhase Position {..} = min totalPhase+   (minorPiecePhase * fromIntegral (popCount (knights .| bishops))+  + rookPhase       * fromIntegral (popCount rooks)+  + queenPhase      * fromIntegral (popCount queens))+++instance Show Position where+  show pos =+    show pos.color <> " to play: \n\n" <> boardStr+    where+      boardStr = intercalate "\n" (intersperse ' ' <$> pieces)+      pieces = reverse $ chunksOf 8 do+        n <- toList squares+        pure $ maybe ' ' pieceToChar (pieceAt n pos)
+ src/Models/Score.hs view
@@ -0,0 +1,66 @@+module Models.Score where++import           AppPrelude++import           Data.Int        (Int16)+import           Models.Piece+import           Test.QuickCheck (Arbitrary (..), elements)+++type Score = Int16+type Phase = Int16+type Depth = Word8+type Ply   = Word8+type Age   = Word8+++newtype NodeType = NodeType Word8+  deriving (Eq, Ord, Num, Storable, Show)++instance Arbitrary NodeType where+  arbitrary = elements [PV, Cut, All]+++{-# COMPLETE PV, Cut, All #-}+pattern PV, Cut, All :: NodeType+pattern PV  = NodeType 0+pattern Cut = NodeType 1+pattern All = NodeType 2+++getNodeType :: Score -> Score -> Score -> NodeType+getNodeType !alpha !beta !score+  | score >= beta  = Cut+  | score > alpha = PV+  | otherwise     = All+++pieceToPhase :: Piece -> Phase+pieceToPhase = \case+  Knight -> minorPiecePhase+  Bishop -> minorPiecePhase+  Rook   -> rookPhase+  Queen  -> queenPhase+  _      -> 0+++minorPiecePhase :: Phase+minorPiecePhase = 1++rookPhase :: Phase+rookPhase = 2++queenPhase :: Phase+queenPhase = 4+++totalPhase :: Phase+totalPhase =+  minorPiecePhase * 8 + rookPhase * 4 + queenPhase * 2+++minScore :: Score+minScore = minBound + 1++maxScore :: Score+maxScore = maxBound - 1
+ src/MoveGen/MakeMove.hs view
@@ -0,0 +1,145 @@+module MoveGen.MakeMove (makeMove, makeNullMove) where++import           AppPrelude++import           Models.Move+import           Models.Piece+import           Models.Position+import           MoveGen.PieceAttacks+import           Utils.Board+++makeMove :: Move -> Position -> Position+makeMove Move {..} pos =+  makeNullMove+  $ movePiece piece promotion startBoard endBoard+  $ updatePlayerBoards startBoard endBoard pos+  where+    !startBoard = toBoard start+    !endBoard = toBoard end+++makeNullMove :: Position -> Position+makeNullMove pos@Position {color, player,  enemy, enPassant} =+  pos {+    color           = reverseColor color+  , phase           = getPhase pos+  , player          = enemy+  , enemy           = player+  , attacked        = allAttacks pos+  , enPassant       = toReverseCondition enPassantPinnedPawns * enPassant+  , leapingCheckers = getLeapingCheckers pos+  , sliderCheckers  = getSliderCheckers bishopCheckerRays rookCheckerRays+                                        pos+  , pinnedPieces    = getPinnedPieces bishopCheckerRays rookCheckerRays+                                      sliderRays        pos+  }+  where+    bishopCheckerRays    = getBishopCheckerRays    pos+    rookCheckerRays      = getRookCheckerRays      pos+    sliderRays           = getEnemyKingSliderRays  pos+    enPassantPinnedPawns = getEnPassantPinnedPawns pos+++updatePlayerBoards :: Board -> Board -> Position -> Position+updatePlayerBoards start end pos@Position {..} =+  pos {+      previousPositions    = getZobristKey pos+        : if halfMoveClock == 0 then [] else previousPositions+    , halfMoveClock        = fromIntegral+        (toReverseCondition (enemy & end)) * (halfMoveClock + 1)+    , player               = (player ^ start) .| end+    , enemy                = enemy .\ end+    , pawns                = pawns .\ end+    , knights              = knights .\ end+    , bishops              = bishops .\ end+    , rooks                = rooks .\ end+    , queens               = queens .\ end+  }+++movePiece :: Piece -> Promotion -> Board -> Board -> Position -> Position+movePiece Pawn NoProm start end pos@Position {..} =+  pos {+      halfMoveClock = 0+    , pawns         = (pawns ^ (start .| enPassantCapture)) .| end+    , enemy         = enemy ^ enPassantCapture+    , enPassant     = start <<! 8 & end !>> 8+  }+  where+    ((<<!), (!>>)) = case color of+      White -> ((<<), (>>))+      Black -> ((>>), (<<))+    enPassantCapture = (enPassant & end) !>> 8++movePiece Pawn KnightProm start end pos@Position {..} =+  pos {+      halfMoveClock = 0+    , pawns         = pawns ^ start+    , knights       = knights .| end+    , enPassant     = 0+  }++movePiece Pawn BishopProm start end pos@Position {..} =+  pos {+      halfMoveClock = 0+    , pawns         = pawns ^ start+    , bishops       = bishops .| end+    , enPassant     = 0+  }++movePiece Pawn RookProm !start !end pos@Position {..} =+  pos {+      halfMoveClock = 0+    , pawns         = pawns ^ start+    , rooks         = rooks .| end+    , enPassant     = 0+  }++movePiece Pawn QueenProm start end pos@Position {..} =+  pos {+      halfMoveClock = 0+    , pawns         = pawns ^ start+    , queens        = queens .| end+    , enPassant     = 0+  }++movePiece Knight _ start end pos@Position {..} =+  pos {+      knights   = (knights ^ start) .| end+    , enPassant = 0+  }++movePiece Bishop _ start end pos@Position {..} =+  pos {+      bishops   = (bishops ^ start) .| end+    , enPassant = 0+  }++movePiece Rook _ start end pos@Position {..} =+  pos {+      rooks     = (rooks ^ start) .| end+    , castling  = castling .\ start+    , enPassant = 0+  }++movePiece Queen _ start end pos@Position {..} =+  pos {+      queens    = (queens ^ start) .| end+    , enPassant = 0+  }++movePiece King _ start end pos@Position {..} =+  pos {+      kings     = (kings ^ start) .| end+    , castling  = castling .\ kingRank+    , player    = (player ^ rookStart) .| rookEnd+    , rooks     = (rooks ^ rookStart) .| rookEnd+    , enPassant = 0+  }+  where+    rookStart   = shortCastle << 1 .| longCastle >> 2+    rookEnd     = shortCastle >> 1 .| longCastle << 1+    shortCastle = (start << 2) & end+    longCastle  = (start >> 2) & end+    kingRank    = fileMovesVec !! lsb start
+ src/MoveGen/MoveQueries.hs view
@@ -0,0 +1,56 @@+module MoveGen.MoveQueries (isQuietMove, isLegalQuietMove, isWinningCapture, isCheckMove, isPromotionPush, isCastlingMove, isCapture) where++import           AppPrelude++import           Evaluation.Evaluation+import           Models.Move+import           Models.Piece+import           Models.Position+import           MoveGen.MakeMove+import           MoveGen.PieceQuietMoves (allQuietMoves)+import           MoveGen.PositionQueries+import           Utils.Board+++isCastlingMove :: Move -> Bool+isCastlingMove Move {..} =+  piece == King && abs (start - end) == 2+++isCheckMove :: Move -> Position -> Bool+isCheckMove mv pos =+  isKingInCheck $ makeMove mv pos+++isCapture :: Move -> Position -> Bool+isCapture Move {..} Position {..} =+  promotion /= NoProm+    || testSquare enemy end+    || piece == Pawn && testSquare enPassant end+++isWinningCapture :: Move -> Position -> Bool+isWinningCapture mv pos =+  isCapture mv pos+    && member mv.promotion bestPromotions+    && evaluateExchange mv pos >= 0+++isPromotionPush :: Move -> Bool+isPromotionPush Move{..} =+  piece == Pawn && toRank end `elem` [2, 7]+++isQuietMove :: Move -> Position -> Bool+isQuietMove mv pos =+  not (isCheckMove mv pos || isCapture mv pos)+++isLegalQuietMove :: Move -> Position -> Bool+isLegalQuietMove mv@Move {..} pos@Position {..} =+  testSquare player start+    && not (testSquare allPieces end)+    && isPieceAt piece start pos+    && elem mv (allQuietMoves pos)+  where+    allPieces = enemy .| player
+ src/MoveGen/PieceAttacks.hs view
@@ -0,0 +1,206 @@+module MoveGen.PieceAttacks (getLeapingCheckers, getSliderCheckers, getEnemyKingSliderRays, getBishopCheckerRays, getRookCheckerRays, getKingBishopRay, getPinnedPieces, getEnPassantPinnedPawns, getKingQueenRay, getKingRookRay, allAttacks, knightAttacks, bishopAttacks, rookAttacks, queenAttacks, kingAttacks, pawnAttacks, pawnDiagAttacks, pawnAntiDiagAttacks, bishopMoves, rookMoves, queenMoves) where++import           AppPrelude++import           Models.Move+import           Models.Piece+import           Models.Position+import           Utils.Board+++getLeapingCheckers :: Position -> Board+getLeapingCheckers Position {..} =+  player & checkers+  where+    checkers = pawns   & pawnAttacks   (reverseColor color) (enemy&kings)+            .| knights & knightAttacks (lsb (enemy&kings))+++getSliderCheckers :: Board -> Board -> Position -> Board+getSliderCheckers bishopCheckerRays rookCheckerRays Position {..} =+  player & checkers+  where+    checkers = bishopCheckerRays & bishops+            .| rookCheckerRays   & rooks+            .| (bishopCheckerRays .| rookCheckerRays) & queens+++getEnemyKingSliderRays :: Position -> Board+getEnemyKingSliderRays Position {..} =+  queenAttacks player (lsb (enemy&kings))+++getBishopCheckerRays :: Position -> Board+getBishopCheckerRays Position {..} =+  bishopAttacks (enemy .| player) (lsb (enemy&kings))+++getRookCheckerRays :: Position -> Board+getRookCheckerRays Position {..} =+  rookAttacks (enemy .| player) (lsb (enemy&kings))+++getPinnedPieces :: Board -> Board -> Board -> Position -> Board+getPinnedPieces !bishopCheckerRays !rookCheckerRays !sliderRays Position {..} =+  enemy &+  (foldBoardAttacks bishopPins (attackers & bishops)+  .| foldBoardAttacks rookPins (attackers & rooks)+  .| foldBoardAttacks queenPins (attackers & queens))+  where+    bishopPins n = getKingBishopRay king n+      & bishopCheckerRays+      & bishopAttacks allPieces n+    rookPins n = getKingRookRay king n+      & rookCheckerRays+      & rookAttacks allPieces n+    queenPins n = getKingQueenRay king n+      & (bishopCheckerRays .| rookCheckerRays)+      & queenAttacks allPieces n+    attackers = sliderRays & player+    !king     = enemy & kings+    allPieces = player .| enemy+++getEnPassantPinnedPawns :: Position -> Board+getEnPassantPinnedPawns pos@Position {..}+  | enPassant == 0 || enPassantRank & kingRank == 0 = 0+  | otherwise =+    enemy & pawns & getPinnedPieces 0 rookCheckerRays sliderRays pos'+    where+      rookCheckerRays = getRookCheckerRays pos' & kingRank+      sliderRays      = getEnemyKingSliderRays pos' & enPassantRank+      pos' = pos {+        pawns  = pawns  ^ enPassantPawn,+        player = player ^ enPassantPawn+      }+      enPassantPawn   = case color of+        White -> enPassant << 8+        Black -> enPassant >> 8+      enPassantSquare = lsb enPassantPawn+      kingRank        = fileMovesVec !! lsb (kings & enemy)+      enPassantRank   = fileMovesVec !! enPassantSquare+++getKingQueenRay :: Board -> Square -> Board+getKingQueenRay !king !n+  | file & king /= 0     = file+  | rank & king /= 0     = rank+  | diag & king /= 0     = diag+  | antiDiag & king /= 0 = antiDiag+  | otherwise           = 0+  where+    file     = rankMovesVec     !! n+    rank     = fileMovesVec     !! n+    diag     = antiDiagMovesVec !! n+    antiDiag = diagMovesVec     !! n+++getKingBishopRay :: Board -> Square -> Board+getKingBishopRay !king !n+  | diag & king /= 0     = diag+  | antiDiag & king /= 0 = antiDiag+  | otherwise           = 0+  where+    diag     = antiDiagMovesVec !! n+    antiDiag = diagMovesVec     !! n+++getKingRookRay :: Board -> Square -> Board+getKingRookRay !king !n+  | file & king /= 0 = file+  | rank & king /= 0 = rank+  | otherwise       = 0+  where+    file = rankMovesVec !! n+    rank = fileMovesVec !! n+++allAttacks :: Position -> Board+allAttacks Position {..} =+     pawnAttacks  color                         (player&pawns)+  .| foldBoardAttacks knightAttacks             (player&knights)+  .| foldBoardAttacks (bishopAttacks allPieces) (player&bishops)+  .| foldBoardAttacks (rookAttacks allPieces)   (player&rooks)+  .| foldBoardAttacks (queenAttacks allPieces)  (player&queens)+  .| kingAttacks                           (lsb (player&kings))+  where+    !allPieces = player .| (enemy .\ kings)+++pawnAttacks :: Color -> Board -> Board+pawnAttacks color board = case color of+  White -> (board .\ file_A) << 7 .| (board .\ file_H) << 9+  Black -> (board .\ file_A) >> 9 .| (board .\ file_H) >> 7+++pawnDiagAttacks :: Color -> Board -> Board+pawnDiagAttacks color board = case color of+  White -> (board .\ file_H) << 9+  Black -> (board .\ file_A) >> 9+++pawnAntiDiagAttacks :: Color -> Board -> Board+pawnAntiDiagAttacks color board = case color of+  White -> (board .\ file_A) << 7+  Black -> (board .\ file_H) >> 7+++knightAttacks :: Square -> Board+knightAttacks !n = knightMovesVec !! n+++kingAttacks :: Square -> Board+kingAttacks !n = kingMovesVec !! n+++bishopMoves :: Board -> Board -> Board -> Square -> Board+bishopMoves allPieces pinnedPieces king n+  | testSquare pinnedPieces n = attacks & getKingBishopRay king n+  | otherwise                 = attacks+  where+    !attacks = bishopAttacks allPieces n++rookMoves :: Board -> Board -> Board -> Square -> Board+rookMoves allPieces pinnedPieces king n+  | testSquare pinnedPieces n = attacks & getKingRookRay king n+  | otherwise                 = attacks+  where+    !attacks = rookAttacks allPieces n++queenMoves :: Board -> Board -> Board -> Square -> Board+queenMoves allPieces pinnedPieces king n+  | testSquare pinnedPieces n = attacks & getKingQueenRay king n+  | otherwise                 = attacks+  where+    !attacks = queenAttacks allPieces n++bishopAttacks :: Board -> Square -> Board+bishopAttacks !allPieces !n =+     sliding lsb northEastMovesVec allPieces n+  .| sliding lsb northWestMovesVec allPieces n+  .| sliding msb southWestMovesVec allPieces n+  .| sliding msb southEastMovesVec allPieces n+++rookAttacks :: Board -> Square -> Board+rookAttacks !allPieces !n =+     sliding lsb northMovesVec allPieces n+  .| sliding lsb eastMovesVec allPieces n+  .| sliding msb westMovesVec allPieces n+  .| sliding msb southMovesVec allPieces n+++queenAttacks :: Board -> Square -> Board+queenAttacks !allPieces !n =+     rookAttacks allPieces n+  .| bishopAttacks allPieces n+++sliding :: (Board -> Square) -> Vector Board -> Board -> Square -> Board+sliding !findBlocker !mask !allPieces !n =+   ray ^ blockerRay+  where+    !firstBlocker = findBlocker blockers+    !blockers     = ray & allPieces+    !blockerRay   = mask !! firstBlocker+    !ray          = mask !! n
+ src/MoveGen/PieceCaptures.hs view
@@ -0,0 +1,207 @@+module MoveGen.PieceCaptures (allCaptures, staticExchangeCaptures, knightCaptures, bishopCaptures, rookCaptures, queenCaptures) where++import           AppPrelude++import           Models.Move+import           Models.Piece+import           Models.Position+import           MoveGen.PieceAttacks+import           Utils.Board+++-- Captures legal move generator:+-- - Piece captures+-- - En passant captures+-- - Pawn promotions++allCaptures :: Position -> [Move]+allCaptures pos@Position {..}++  | allCheckers          == 0 = genCaptures id id+  | popCount allCheckers > 1 = allKingCaptures+  | sliderCheckers /= 0       = genCaptures captureChecker pawnCaptureChecker+  | otherwise                = genCaptures captureChecker pawnCaptureChecker++  where+    genCaptures =+      allCapturesHelper allPieces king allKingCaptures pos+    pawnCaptureChecker board =+      board & (allCheckers .| enPassantChecker)+    captureChecker board = board & allCheckers+    allKingCaptures =+      foldBoardSquares King (kingCaptures enemy attacked) [] kingSquare+    allCheckers = leapingCheckers .| sliderCheckers+    enPassantChecker =+      let checker = allCheckers & pawns+      in enPassant & (checker << 8 .| checker >> 8)+    allPieces  = player .| enemy+    kingSquare = lsb king+    king       = player&kings+++allCapturesHelper :: Board -> Board -> [Move] -> Position -> (Board -> Board) -> (Board -> Board) -> [Move]+allCapturesHelper allPieces king allKingCaptures Position {..} !f !g =++    foldBoardMoves     Pawn   (g . pawnCapturesAndPromotions+                                     enemy noPieces enPassant color)+                              (unpinned&pawns)++    $ foldBoardMoves   Pawn   (g . pawnPromotions noPieces color+                                 . toBoard)+                              filePinnedPawns++    $ foldBoardMoves   Pawn   (g . diagPawnCaptures enemy color)+                              diagPinnedPawns++    $ foldBoardMoves   Pawn   (g . antiDiagPawnCaptures enemy color)+                              antiDiagPinnedPawns++    $ foldBoardMoves   Knight (f . knightCaptures enemy)+                              (unpinned&knights)++    $ foldBoardMoves   Bishop (f . bishopCaptures+                                     enemy allPieces pinnedPieces king)+                              (player&bishops)++    $ foldBoardMoves   Rook   (f . rookCaptures+                                     enemy allPieces pinnedPieces king)+                              (player&rooks)++    $ foldBoardMoves   Queen  (f . queenCaptures+                                     enemy allPieces pinnedPieces king)+                              (player&queens)+    allKingCaptures++    where+    unpinned            = player .\ pinnedPieces+    pinnedPawns         = pinnedPieces & pawns+    filePinnedPawns     = pinnedPawns & kingFile+    diagPinnedPawns     = pinnedPawns & kingDiag+    antiDiagPinnedPawns = pinnedPawns & kingAntiDiag+    kingFile            = rankMovesVec !! kingSquare+    kingDiag            = antiDiagMovesVec !! kingSquare+    kingAntiDiag        = diagMovesVec !! kingSquare+    kingSquare          = lsb king+    noPieces            = (~) allPieces+++staticExchangeCaptures :: Square -> Position -> [Move]+staticExchangeCaptures target pos@Position {..}+  | allCheckers == 0               = genCaptures+  | popCount allCheckers > 1      = allKingCaptures+  | testSquare allCheckers target = genCaptures+  | otherwise                     = []++  where+    genCaptures =+      staticExchangeCapturesHelper target kingSquare allPieces+                                   allKingCaptures pos+    allKingCaptures =+      foldBoardSquares King (kingCaptures (toBoard target) attacked)+      [] kingSquare+    allCheckers     = leapingCheckers .| sliderCheckers+    allPieces       = player .| enemy+    kingSquare      = lsb king+    king            = player&kings+++staticExchangeCapturesHelper+  :: Square -> Square -> Board -> [Move] -> Position -> [Move]+staticExchangeCapturesHelper+  target king allPieces allKingCaptures Position {..} =+      foldBoardPawnMovesConst    target (validSliders&pawnAttackers)+    $ foldBoardMovesConst Knight target (unpinned&knightAttackers)+    $ foldBoardMovesConst Bishop target (validSliders&bishopAttackers)+    $ foldBoardMovesConst Rook   target (validSliders&rookAttackers)+    $ foldBoardMovesConst Queen  target (validSliders&queenAttackers)+      allKingCaptures++    where+    pawnAttackers   = pawns & pawnAttacks (reverseColor color) targetBoard+    knightAttackers = knights & knightAttacks target+    bishopAttackers = bishops & bishopRays+    rookAttackers   = rooks & rookRays+    queenAttackers  = queens & (bishopRays .| rookRays)+    bishopRays      = bishopAttacks allPieces target+    rookRays        = rookAttacks allPieces target+    targetBoard     = toBoard target+    unpinned        = player .\ pinnedPieces++    validSliders+      | pinnedPieces .\ knights == 0 = player+      | otherwise = unpinned .| pinnedPieces & getPinningRay target king+++getPinningRay :: Square -> Square -> Board+getPinningRay !target !king+    | testSquare kingDiag target     = kingDiag+    | testSquare kingAntiDiag target = kingAntiDiag+    | testSquare kingFile target     = kingFile+    | testSquare kingRank target     = kingRank+    | otherwise                      = 0+  where+  kingDiag        = antiDiagMovesVec !! king+  kingAntiDiag    = diagMovesVec     !! king+  kingFile        = rankMovesVec     !! king+  kingRank        = fileMovesVec     !! king+++pawnCapturesAndPromotions :: Board -> Board -> Board -> Color -> Square -> Board+pawnCapturesAndPromotions enemy noPieces enPassant color n =+  pawnPromotions noPieces color board+  .| pawnCaptures enemy enPassant color board+  where+    board = toBoard n+++pawnPromotions :: Board -> Color -> Board -> Board+pawnPromotions noPieces color board =+  promotions & noPieces+  where+    promotions = case color of+      White -> (board & rank_7) << 8+      Black -> (board & rank_2) >> 8+++pawnCaptures :: Board -> Board -> Color -> Board -> Board+pawnCaptures enemy enPassant color board =+  pawnAttacks color board & (enemy .| enPassant)+++diagPawnCaptures :: Board -> Color -> Square -> Board+diagPawnCaptures enemy color n =+  pawnDiagAttacks color board & enemy+  where+    board = toBoard n+++antiDiagPawnCaptures :: Board -> Color -> Square -> Board+antiDiagPawnCaptures enemy color n =+  pawnAntiDiagAttacks color board & enemy+  where+    board = toBoard n+++knightCaptures :: Board -> Square -> Board+knightCaptures enemy n =+  knightAttacks n & enemy+++kingCaptures :: Board -> Board -> Square -> Board+kingCaptures enemy attacked n =+  (kingAttacks n & enemy) .\ attacked+++bishopCaptures :: Board -> Board -> Board -> Board -> Square -> Board+bishopCaptures enemy allPieces pinnedPieces king n =+  bishopMoves allPieces pinnedPieces king n & enemy+++rookCaptures :: Board -> Board -> Board -> Board -> Square -> Board+rookCaptures enemy allPieces pinnedPieces king n =+  rookMoves allPieces pinnedPieces king n & enemy+++queenCaptures :: Board -> Board -> Board -> Board -> Square -> Board+queenCaptures enemy allPieces pinnedPieces king n =+  queenMoves allPieces pinnedPieces king n & enemy
+ src/MoveGen/PieceQuietMoves.hs view
@@ -0,0 +1,124 @@+module MoveGen.PieceQuietMoves (allQuietMoves) where+++import           AppPrelude++import           Models.Move+import           Models.Piece+import           Models.Position+import           MoveGen.PieceAttacks+import           MoveGen.PieceCaptures+import           Utils.Board+++-- Quiet moves legal move generator:+-- - Non capture moves except for pawn promotions++allQuietMoves :: Position -> [Move]+allQuietMoves pos@Position {..}++  | allCheckers == 0                                = genMoves id+  | leapingCheckers /= 0 || popCount allCheckers > 1 = allKingMoves+  | otherwise                                      = genMoves blockChecker++  where+    genMoves = quietMovesHelper allPieces king allKingMoves pos+    blockChecker board = board & checkerRay+    checkerRay = getKingQueenRay king checkerSquare+      & queenAttacks allPieces kingSquare+      & queenAttacks allPieces checkerSquare+    checkerSquare = lsb allCheckers+    allKingMoves =+      foldBoardSquares King+      (kingQuietMoves allPieces attacked castling (player&rooks) king) [] kingSquare+    allCheckers = leapingCheckers .| sliderCheckers+    allPieces = player .| enemy+    kingSquare = lsb king+    king = player&kings+++quietMovesHelper :: Board -> Board -> [Move] -> Position -> (Board -> Board)+                 -> [Move]+quietMovesHelper allPieces king allKingMoves Position {..} !f =++    foldBoardMoves     Pawn   (f . pawnAdvances noPieces color+                                 . toBoard)+                              (unpinned&pawns .| filePinnedPawns)++    $ foldBoardMoves   Knight (f . knightCaptures noPieces)+                              (unpinned&knights)++    $ foldBoardMoves   Bishop (f . bishopQuietMoves noPieces+                                     allPieces pinnedPieces king)+                              (player&bishops)++    $ foldBoardMoves   Rook   (f . rookQuietMoves noPieces+                                     allPieces pinnedPieces king)+                              (player&rooks)++    $ foldBoardMoves   Queen  (f . queenQuietMoves noPieces+                                     allPieces pinnedPieces king)+                              (player&queens)++      allKingMoves++    where+    unpinned = player .\ pinnedPieces+    pinnedPawns = pinnedPieces & pawns+    filePinnedPawns = pinnedPawns & kingFile+    kingFile = rankMovesVec !! kingSquare+    kingSquare = lsb king+    noPieces = (~) allPieces+++pawnAdvances :: Board -> Color -> Board -> Board+pawnAdvances noPieces color board = advances & noPieces+  where++    advances = case color of+      White -> (board .\ rank_7) << 8+           .| ((board & rank_2) << 8 & noPieces) << 8+      Black -> (board .\ rank_2) >> 8+           .| ((board & rank_7) >> 8 & noPieces) >> 8++bishopQuietMoves :: Board -> Board -> Board -> Board -> Square -> Board+bishopQuietMoves noPieces allPieces pinnedPieces king n =+  bishopMoves allPieces pinnedPieces king n & noPieces+++rookQuietMoves :: Board -> Board -> Board -> Board -> Square -> Board+rookQuietMoves noPieces allPieces pinnedPieces king n =+  rookMoves allPieces pinnedPieces king n & noPieces+++queenQuietMoves :: Board -> Board -> Board -> Board -> Square -> Board+queenQuietMoves noPieces allPieces pinnedPieces king n =+  queenMoves allPieces pinnedPieces king n & noPieces+++kingQuietMoves :: Board -> Board -> Board -> Board -> Board -> Square -> Board+kingQuietMoves allPieces attacked castling rooks king n =+  (kingAttacks n+  .| kingCastlingMoves allPieces attacked castling rooks king n)+  .\ (attacked .| allPieces)+++kingCastlingMoves :: Board -> Board -> Board -> Board -> Board -> Square -> Board+kingCastlingMoves allPieces attacked castling rooks king n =+  (shortCastlingCond+      * fromIntegral (popCount (castling & rooks & file_H))+      * ((castling & king) << 2))+  .|+  (longCastlingCond+      * fromIntegral (popCount (castling & rooks & file_A))+      * ((castling & king) >> 2))+  where+    shortCastlingCond =+     toReverseCondition (shortCastleSlidingFiles & collisions .| inCheck)+    longCastlingCond =+     toReverseCondition (longCastleSlidingFiles  & collisions+            .| inCheck+            .| allPieces & kingRank & file_B)+    collisions = kingRank & (attacked .| allPieces)+    kingRank = fileMovesVec !! n+    inCheck = king & attacked
+ src/MoveGen/PositionQueries.hs view
@@ -0,0 +1,196 @@+module MoveGen.PositionQueries (isDefeat, isNotWinnable, isDraw, isEndgame, isKingInCheck, hasSingleMove, isWonEndgame) where++import           AppPrelude++import           Models.Position+import           Search.Perft+import           Utils.Board+++isEndgame :: Position -> Bool+isEndgame Position {..} =+  popCount (player & majorAndMinorPieces) == 0+  where+    majorAndMinorPieces = queens .| rooks .| bishops .| knights+++isKingInCheck :: Position -> Bool+isKingInCheck Position {..} =+  sliderCheckers .| leapingCheckers /= 0+++hasSingleMove :: Position -> Bool+hasSingleMove = hasOne . allMoves+  where+  hasOne [_] = True+  hasOne _   = False+++isDefeat :: Position -> Bool+isDefeat = isCheckmate+++isNotWinnable :: Position -> Bool+isNotWinnable Position {..} =+  player & (pawns .| majorPieces) == 0+  && popCount (player & minorPieces) <= 1+  && enemy & pawns /= 0+  where+    minorPieces = bishops .| knights+    majorPieces = queens  .| rooks+++isDraw :: Position -> Bool+isDraw pos =+    isDrawByHalfMoves pos+  || isPawnlessEndgame pos && isDrawByMaterial pos+  || isStalemate pos+  || isDrawByRepetition pos+++isCheckmate :: Position -> Bool+isCheckmate pos = null (allMoves pos) && isKingInCheck pos+++isStalemate :: Position -> Bool+isStalemate pos = null (allMoves pos) && not (isKingInCheck pos)+++isDrawByHalfMoves :: Position -> Bool+isDrawByHalfMoves Position {halfMoveClock} =+  halfMoveClock >= 100+++isDrawByRepetition :: Position -> Bool+isDrawByRepetition pos =+  isRepeatedPosition (getZobristKey pos) pos+++isDrawByMaterial :: Position -> Bool+isDrawByMaterial Position {..} =++   allPieces == majorPieces .| minorPieces &&+     forBoth queenVsRookAndMinor++  || allPieces == majorPieces &&+    forBoth queenVsRooks++  || allPieces == queens &&+    (popCount (player & queens) == 1+    && popCount (enemy & queens) == 1)++  || allPieces == rooks &&+    (popCount (player & rooks) == 1+    && popCount (enemy & rooks) == 1)++  || allPieces == queens .| minorPieces &&+    (forBoth queenVsBishops+    || forBoth queenVsKnights)++  || allPieces == rooks .| minorPieces &&+    (forBoth rooksVsRookAndMinor+    || forBoth rooksVsRookBishopAndKnight+    || forBoth rookVsMinor+    || forBoth rookAndMinorVsRook+    || forBoth rookVsBishopAndKnight)++  || allPieces == minorPieces &&++    ((playerMinorPiecesCount <= 1+        && enemyMinorPiecesCount <= 1)++    || (popCount bishops == 3 && knights == 0)++    || forBoth knightsVsMinor++    || forBoth bishopAndKnightVsMinor)++  where+    knightsVsMinor !board !enemyBoard =+      popCount (board & knights)              <= 2+        && board & bishops                     == 0+        && popCount (enemyBoard & minorPieces) <= 1++    bishopAndKnightVsMinor !board !enemyBoard =+      popCount (board & bishops)              == 1+        && popCount (board & knights)          == 1+        && popCount (enemyBoard & minorPieces) == 1++    queenVsRooks !board !enemyBoard =+      board & rooks                     == 0+        && popCount (board & queens)     == 1+        && enemyBoard & queens           == 0+        && popCount (enemyBoard & rooks) == 2++    rookVsMinor !board !enemyBoard =+      board & minorPieces                    == 0+       && popCount (board & rooks)            == 1+       && enemyBoard & rooks                  == 0+       && popCount (enemyBoard & minorPieces) == 1++    rookAndMinorVsRook !board !enemyBoard =+      popCount (board & rooks)         == 1+      && popCount (board & minorPieces) == 1+      && popCount (enemyBoard & rooks)  == 1+      && enemyBoard & minorPieces       == 0++    rookVsBishopAndKnight !board !enemyBoard =+      board & rooks                == 0+      && popCount (board & bishops) == 1+      && popCount (board & knights) == 1+      && enemyBoard & minorPieces   == 0+      && popCount (board & rooks)   == 1++    queenVsRookAndMinor !board !enemyBoard =+      board & (rooks .| minorPieces)        == 0+      && popCount (board & queens)           == 1+      && enemyBoard & queens                 == 0+      && popCount (enemyBoard & rooks)       == 1+      && popCount (enemyBoard & minorPieces) == 1++    rooksVsRookAndMinor !board !enemyBoard =+      board & minorPieces        == 0+      && popCount (board & rooks)           == 2+      && popCount (enemyBoard & rooks)       == 1+      && popCount (enemyBoard & minorPieces) == 1++    rooksVsRookBishopAndKnight !board !enemyBoard =+      board & minorPieces               == 0+      && popCount (board & rooks)        == 2+      && popCount (enemyBoard & rooks)   == 1+      && popCount (enemyBoard & knights) == 1+      && popCount (enemyBoard & rooks)   == 1++    queenVsKnights !board !enemyBoard =+      board & minorPieces == 0+      && popCount (board & queens) == 1+      && enemyBoard & (queens .| bishops) == 0+      && popCount (enemyBoard & knights) == 2++    queenVsBishops !board !enemyBoard =+      board & minorPieces == 0+      && popCount (board & queens) == 1+      && enemyBoard & (queens .| knights) == 0+      && popCount (enemyBoard & bishops) == 2+++    !playerMinorPiecesCount = popCount (player & minorPieces)+    !enemyMinorPiecesCount  = popCount (enemy  & minorPieces)+    !allPieces              = (player .| enemy) .\ kings+    !minorPieces            = knights .| bishops+    !majorPieces            = rooks   .| queens+    forBoth fn = fn player enemy || fn enemy player+++isWonEndgame :: Position -> Bool+isWonEndgame Position {..} = enemy == enemy & kings+  && (player & majorPieces /= 0+     || popCount (player & minorPieces) >= 2 && bishops /= 0)+  where+  !minorPieces      = knights .| bishops+  !majorPieces      = rooks   .| queens+++isPawnlessEndgame :: Position -> Bool+isPawnlessEndgame Position {..} =+  pawns == 0
+ src/Parsers/Command.hs view
@@ -0,0 +1,105 @@+module Parsers.Command (parseCommand) where++import           AppPrelude++import           Models.Command+import           Models.Position+import           Parsers.Position++import           Bookhound.Parser+import           Bookhound.ParserCombinators+import           Bookhound.Parsers.Number+import           Bookhound.Parsers.Text+import           Control.Newtype+import           Data.Monoid+import           Models.Piece+++parseCommand :: Text -> Either [ParseError] Command+parseCommand = runParser command+  where++  command =+        stringToken "ucinewgame" $> UciNewGame+    <|> stringToken "uci"        $> Uci+    <|> stringToken "isready"    $> IsReady+    <|> stringToken "position"   *> (SetPosition <$> positionSpec)+    <|> stringToken "setoption"  *> (SetOption   <$> optionSpec)+    <|> stringToken "move"       *> (MakeMoves   <$> unknownMoves)+    <|> stringToken "ponderhit"  $> Ponderhit+    <|> stringToken "stop"       $> Stop+    <|> stringToken "quit"       $> Quit+    <|> stringToken "eval"       $> Evaluate+    <|> stringToken "display"    $> Display+    <|> stringToken "flip"       $> Flip+    <|> stringToken "go" *>+         (stringToken "perft"    *> (Perft  <$> depth)+      <|> stringToken "divide"   *> (Divide <$> depth)+      <|>                           (Search <$> searchOptions))++  searchOption =+        setInfinite       <$  token (oneOf @Text ["infinite", "ponder"])+    <|> setSearchMoves    <$> (stringToken "searchmoves" *> unknownMoves)+    <|> setTargetDepth    <$> (stringToken "depth"       *> depth)+    <|> setWhiteTime      <$> (stringToken "wtime"       *> unsignedInt)+    <|> setBlackTime      <$> (stringToken "btime"       *> unsignedInt)+    <|> setWhiteIncrement <$> (stringToken "winc"        *> unsignedInt)+    <|> setBlackIncrement <$> (stringToken "binc"        *> unsignedInt)+    <|> setMovesUntil     <$> (stringToken "movestogo"   *> unsignedInt)+    <|> setFindMate       <$> (stringToken "mate"        *> unsignedInt)+    <|> setMoveTime       <$> (stringToken "movetime"    *> unsignedInt)+    <|> setMaxNodes       <$> (stringToken "nodes"       *> unsignedBigInt)++  positionSpec = PositionSpec+    <$> initialPositionSpec+    <*> (stringToken "moves" *> unknownMoves <|> pure [])++  optionSpec = stringToken "name" *>+    (    (stringToken "Hash"      $> HashSize)+     <*> (stringToken "value"     *> unsignedInt)++     <|> (stringToken "Ponder"    $> Ponder)+     <*> (stringToken "value"     *> boolean)++     <|> stringToken "Clear Hash" $> ClearHash)++  searchOptions =+    ($ defaultSearchOptions) . ala Endo foldMap <$> (searchOption |*)++  initialPositionSpec =+        stringToken "startpos" $> startPosition+    <|> stringToken "fen"      *> positionFenParser++  unknownMoves = (token unknownMove |+)+  unknownMove  = UnknownMove+    <$> squareParser+    <*> squareParser+    <*> (fromMaybe NoProm <$> (promotionParser |?))++  promotionParser =+        string "k" $> KnightProm+    <|> string "b" $> BishopProm+    <|> string "r" $> RookProm+    <|> string "q" $> QueenProm++  boolean      =+        stringToken "true"  $> True+    <|> stringToken "false" $> False++  token          = withTransform maybeBetweenSpacing+  stringToken    = token . string+  depth          = fromIntegral <$> satisfy (inRange 1 255) unsignedInt+  unsignedBigInt = fromIntegral <$> unsignedInt+++  setTargetDepth x opts    = opts { targetDepth        = x }+  setSearchMoves x opts    = opts { searchMoves        = x }+  setInfinite opts         = opts { infinite           = True }+  setMoveTime x opts       = opts { moveTime           = Just x }+  setWhiteTime x opts      = opts { whiteTime          = Just x }+  setWhiteIncrement x opts = opts { whiteIncrement     = Just x }+  setBlackTime x opts      = opts { blackTime          = Just x }+  setBlackIncrement x opts = opts { blackIncrement     = Just x }+  setMovesUntil x opts     = opts { movesUntilNextTime = Just x }+  setFindMate x opts       = opts { findMate           = Just x }+  setMaxNodes x opts       = opts { maxNodes           = Just x }
+ src/Parsers/Position.hs view
@@ -0,0 +1,111 @@+module Parsers.Position (positionFenParser, squareParser) where++import           AppPrelude++import           Bookhound.Parser+import           Bookhound.ParserCombinators+import           Bookhound.Parsers.Char      (space)+import           Bookhound.Parsers.Number    (unsignedInt)+import           Data.Char                   (digitToInt)++import           Models.Piece+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove+import           Utils.Board+++positionFenParser :: Parser Position+positionFenParser = do+  (pieces, color, castling, enPassant, halfMoveClock, _) <- position+  pure+    $ newPosition+    $ foldrFlipped includePiece pieces+    $ foldrFlipped includeCastling castling+    $ foldrFlipped includeEnPassant enPassant+    $ includeHalfMoveClock halfMoveClock+    $ includeColor color+    emptyPosition+  where+  position = (,,,,,)+    <$> (piecesP    <* space)+    <*> (colorP     <* space)+    <*> (castlingP  <* space)+    <*> (enPassantP <* space)+    <*> (ply        <* space)+    <*> unsignedInt+  piecesP =+    map (mapMaybe (\(x, y) -> (x,) <$> y) . zip [0 ..] . fold . reverse)+    $ satisfy lengthCheck+    $ satisfy (all lengthCheck)+    $ manySepBy (is '/') (fold <$> ((emptySquaresN <|> piece) |+))+  colorP = mandatory (map charToColor anyChar)+  castlingP = (mandatory (map charToCastlingRights anyChar) |+)+           <|> [] <$ is '-'+  enPassantP = Just <$> squareParser+           <|> Nothing <$ is '-'+  emptySquaresN = (`replicate` Nothing) . digitToInt <$> oneOf ['1' .. '8']+  piece = pure . pure <$> mandatory (map charToPiece anyChar)+  lengthCheck xs = length xs == 8+  ply = fromIntegral <$> unsignedInt+  mandatory = (=<<) (fromMaybe empty . map pure)+  foldrFlipped f = flip $ foldr f+++squareParser :: Parser Square+squareParser = (+) <$> column <*> map (* 8) row+  where+    column = (\x -> x - fromEnum 'a') . fromEnum <$> oneOf ['a' .. 'h']+    row = (\x -> x - 1) . digitToInt <$> oneOf ['1' .. '8']+++newPosition :: Position -> Position+newPosition = setInitialValues . makeNullMove . makeNullMove+  where+  setInitialValues pos = pos {+    phase = getPhase pos+  }+++includePiece :: (Square, (Piece, Color)) -> Position -> Position+includePiece (square, (piece, pieceColor)) pos@Position {..} =+  if pieceColor == color then+    pos' { player = player .| board }+  else+    pos' { enemy  = enemy  .| board }+  where+  pos' = case piece of+    Pawn   -> pos { pawns   = pawns   .| board }+    Knight -> pos { knights = knights .| board }+    Bishop -> pos { bishops = bishops .| board }+    Rook   -> pos { rooks   = rooks   .| board }+    Queen  -> pos { queens  = queens  .| board }+    King   -> pos { kings   = kings   .| board }+  board = toBoard square+++includeHalfMoveClock :: Ply -> Position -> Position+includeHalfMoveClock halfMoveClock pos =+  pos { halfMoveClock = halfMoveClock }+++includeColor :: Color -> Position -> Position+includeColor color pos =+  pos { color = color }+++includeCastling :: (CastlingRights, Color) -> Position -> Position+includeCastling (castlingRights, castlingColor) pos@Position {..} =+  pos { castling = castling .| row & (column .| file_E) }+  where+  row = case castlingColor of+    White -> rank_1+    Black -> rank_8+  column = case castlingRights of+    QueenSide -> file_A+    KingSide  -> file_H+++includeEnPassant :: Square -> Position -> Position+includeEnPassant square pos =+  pos { enPassant = toBoard square }
+ src/Search/MoveOrdering.hs view
@@ -0,0 +1,81 @@+module Search.MoveOrdering (getSortedMoves) where++import           AppPrelude++import           Evaluation.Evaluation+import           Models.Command           (EngineOptions)+import           Models.Move+import           Models.Piece+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove         (makeMove)+import           MoveGen.MoveQueries+import           MoveGen.PieceCaptures    (allCaptures)+import           MoveGen.PieceQuietMoves  (allQuietMoves)+import           MoveGen.PositionQueries+import qualified Utils.KillersTable       as KillersTable+import           Utils.KillersTable       (KillersTable)+import qualified Utils.TranspositionTable as TTable+import           Utils.TranspositionTable (TTable)++++-- Move Ordering:+-- - Transposition table (PV / Refutation) move+-- - Winning captures (SEE >= 0) (Ordered by SEE)+-- - 2 Killer moves+-- - Quiet moves (Ordered by Static Eval)+-- - Losing captures (SEE < 0) (Ordered by SEE)++-- Reduced moves:+-- Late killers / quiet moves++getSortedMoves :: (?killersTable :: KillersTable, ?tTable :: TTable,+                  ?opts :: EngineOptions)+  => Depth -> Ply -> Position -> IO ([Move], [Move])+getSortedMoves !depth !ply pos = do+  ttMove      <- toList <$> TTable.lookupBestMove (getZobristKey pos)+  killerMoves <- getKillers ply pos+  let+    bestMoves =+         ttMove+      <> filter (`notElem` ttMove) winningCaptures+      <> filter (`notElem` ttMove) killerMoves++    worstMoves =+         filter (`notElem` (ttMove <> killerMoves)) quietMoves+      <> filter (`notElem` ttMove)                  losingCaptures++  pure if depth >= 3 && not (isKingInCheck pos)+    then (bestMoves, worstMoves)+    else (bestMoves <> worstMoves, [])+  where+    quietMoves                        = getSortedQuietMoves depth pos+    (winningCaptures, losingCaptures) = getSortedCaptures pos+++getKillers+  :: (?killersTable :: KillersTable) => Ply -> Position -> IO [Move]+getKillers !ply pos =+   filter (`isLegalQuietMove` pos) <$> KillersTable.lookupMoves ply+++getSortedCaptures :: Position -> ([Move], [Move])+getSortedCaptures pos =+  bimap mapFn mapFn+    $ partition ((>= 0) . snd)+    $ map attachEval+    $ filter ((`member` bestPromotions) . (.promotion))+    $ allCaptures pos+  where+    mapFn         = map fst . sortOn (Down . snd)+    attachEval mv = (mv, evaluateExchange mv pos)+++getSortedQuietMoves :: Depth -> Position -> [Move]+getSortedQuietMoves !depth pos+  | depth <= 2 = quietMoves+  | otherwise = sortOn (Down . eval) quietMoves+   where+    eval mv         = - evaluatePosition (makeMove mv pos)+    quietMoves      = allQuietMoves pos
+ src/Search/Parameters.hs view
@@ -0,0 +1,30 @@+module Search.Parameters where++import           AppPrelude           hiding ((/))+import           ClassyPrelude        ((/))++import           Models.Score++import qualified Data.Vector.Storable as Vector+++futilityMargins :: Vector Score+futilityMargins = Vector.fromList+  [300, 600, 1200]+++getLmrDepth :: Int -> Depth -> Depth+getLmrDepth mvIdx depth =+  min (depth - 1) lmrDepth+  where+    lmrDepth = ceiling (lmrFactor * (fromIntegral depth / 2)+                + (1 - lmrFactor) * (fromIntegral depth - 1))+    lmrFactor = min @Double 1 (fromIntegral mvIdx / 80)+++initialAlpha :: Score+initialAlpha = minScore+++initialBeta :: Score+initialBeta = maxScore
+ src/Search/Perft.hs view
@@ -0,0 +1,37 @@+module Search.Perft (perft, divide, allMoves) where++import           AppPrelude++import           Models.Move+import           Models.Position+import           MoveGen.MakeMove+import           MoveGen.PieceCaptures+import           MoveGen.PieceQuietMoves++import qualified Data.Map                as Map+import           Models.Score+++perft :: Depth -> Position -> Int+perft = go 0+  where+    go !nodes !depth !pos+      | depth == 1 = nodes + length moves+      | otherwise = foldl' f nodes moves+      where+        f !acc mv  = go acc (depth - 1) (makeMove mv pos)+        moves = allMoves pos+++divide :: Depth -> Position -> Map Move Int+divide !depth !pos+  | depth == 1 = Map.fromList $ toList ((,1) <$> moves)+  | otherwise = Map.fromList+  (second (perft (depth - 1)) . getResults <$> toList moves)+  where+    getResults !mv = (mv, makeMove mv pos)+    moves = allMoves pos+++allMoves :: Position -> [Move]+allMoves = allCaptures <> allQuietMoves
+ src/Search/Quiescence.hs view
@@ -0,0 +1,71 @@+module Search.Quiescence (quiesceSearch) where++import           AppPrelude++import           Evaluation.Evaluation+import           Models.Move+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove+import           MoveGen.MoveQueries+import           MoveGen.PieceCaptures+import           MoveGen.PositionQueries+import           MoveGen.PieceQuietMoves+import           Search.Perft++import           Control.Monad.State+++quiesceSearch :: (?nodes :: IORef Word64)+  => Score -> Score -> Ply -> Position -> IO Score+quiesceSearch !alpha !beta !ply !pos++  | standPat >= beta = pure beta++  | otherwise       = do+      modifyIORef' ?nodes (+ 1)+      (score, finalAlpha) <- runStateT scoreState newAlpha+      pure $! fromMaybe finalAlpha score+  where+    scoreState = findTraverseIndex (getMoveScore beta ply pos) moves+    moves+      | isKingInCheck pos = allMoves pos+      | ply <= 1           = getWinningCapturesAndChecks pos+      | otherwise         = getWinningCaptures pos+    !newAlpha  = max alpha standPat+    !standPat  = evaluatePosition pos+++getMoveScore :: (?nodes :: IORef Word64)+  => Score -> Ply -> Position -> Int -> Move -> QuiesceM (Maybe Score)+getMoveScore !beta !ply !pos _ mv =+  do !alpha <- get+     !score <- liftIO (negate <$> quiesceSearch (-beta) (-alpha)+                                               (ply + 1)+                                               (makeMove mv pos))+     let !nodeType = getNodeType alpha beta score+     advanceState beta score nodeType+++advanceState :: Score -> Score -> NodeType -> QuiesceM (Maybe Score)+advanceState !beta !score !nodeType =+  case nodeType of+    PV  -> Nothing <$ put score+    Cut -> pure $ Just beta+    All -> pure Nothing++++getWinningCapturesAndChecks :: Position -> [Move]+getWinningCapturesAndChecks pos =+  getWinningCaptures pos+    <> filter (`isCheckMove` pos) (allQuietMoves pos)+++getWinningCaptures :: Position -> [Move]+getWinningCaptures pos =+  filter (`isWinningCapture` pos) (allCaptures pos)++++type QuiesceM = StateT Score IO
+ src/Search/Search.hs view
@@ -0,0 +1,299 @@+module Search.Search (search, emptySearchResult, SearchResult(..)) where++import           AppPrelude++import           Evaluation.Evaluation+import           Models.Command+import           Models.Move+import           Models.Position+import           Models.Score+import           MoveGen.MakeMove+import           MoveGen.MoveQueries+import           MoveGen.PositionQueries+import           Search.MoveOrdering+import           Search.Parameters+import           Search.Perft+import           Search.Quiescence+import           Search.TimeManagement+import qualified Utils.KillersTable       as KillersTable+import           Utils.KillersTable       (KillersTable)+import qualified Utils.TranspositionTable as TEntry (TEntry (..))+import qualified Utils.TranspositionTable as TTable+import           Utils.TranspositionTable (TEntry (TEntry), TTable)++import           Control.Concurrent+import           Control.Monad.State+import           Data.Time.Clock.System+++-- Features:+-- - Iterative deepening++search+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?age :: Age)+  => SearchOptions -> IORef SearchResult -> Position -> IO ()+search searchOpts@SearchOptions{..} resultRef pos = do+  startTime <- getSystemTime+  nodesRef <- newIORef 0+  let ?nodes = nodesRef+  maybeTimeout timeToMove $ untilM (go startTime nodesRef) [1 .. targetDepth]+  when infinite $ forever $ threadDelay maxBound+  where+    timeToMove =+      maybeFilter (const $ not infinite) $ getMoveTime searchOpts pos++    go startTime nodesRef depth = do+      result  <- getNodeResult initialAlpha initialBeta depth 0 pos+      endTime <- getSystemTime+      nodes   <- readIORef nodesRef+      let bestMove = result.bestMove <|> headMay (allMoves pos)+          result'  = result {bestMove = bestMove}+      printSearchInfo depth nodes (endTime |-| startTime) result'+      unless (null bestMove) $ writeIORef resultRef result'+      pure (isTimeOver endTime startTime timeToMove+            || not infinite && hasSingleMove pos+            || any (nodes >=) maxNodes+            || isDraw pos+            || getGameResult result.score `elem` [Victory, Defeat])+++-- Features:+-- - Transposition table score caching+-- - Search extensions (Check, Single move)++negamax+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Score -> Depth -> Ply -> Position -> IO SearchResult+negamax !alpha !beta !depth !ply pos++  | isDefeat pos =+    pure $! emptySearchResult minScore++  | ply > 0 && isDraw pos =+    pure $! emptySearchResult 0++  | ply > 0 && isWonEndgame pos =+    pure $! emptySearchResult (maxScore - 1000)++  | otherwise = do+  ttResult <- liftIO $ TTable.lookupScore alpha beta extendedDepth zKey+  case ttResult of+    Just (!score, !bestMove) -> pure $! SearchResult score bestMove Nothing+    Nothing -> cacheNodeResult alpha beta extendedDepth ply zKey pos+  where+    zKey = getZobristKey pos+    extendedDepth =+      if isKingInCheck pos || (hasSingleMove pos && ply < 30)+      then depth + 1+      else depth+++cacheNodeResult+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Score -> Depth -> Ply -> ZKey -> Position -> IO SearchResult+cacheNodeResult !alpha !beta !depth !ply !zKey pos = do+  modifyIORef' ?nodes (+ 1)+  searchResult@SearchResult {..} <- getNodeResult alpha beta depth ply pos+  let+    !nodeType = getNodeType alpha beta score+    !ttScore = case nodeType of+      PV  -> score+      Cut -> beta+      All -> alpha+    !newTEntry = TEntry {+        TEntry.depth      = depth+      , TEntry.bestMove   = bestMove+      , TEntry.score      = ttScore+      , TEntry.nodeType   = nodeType+      , TEntry.zobristKey = zKey+      , TEntry.age        = ?age+    }+  TTable.insert zKey newTEntry+  pure searchResult+++-- Features:+-- - Quiescence search+-- - Null move prunning+-- - Futility prunning++getNodeResult+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Score -> Depth -> Ply -> Position -> IO SearchResult+getNodeResult !alpha !beta !depth !ply pos++  | depth == 0+  || depth <= 3+    && not (isKingInCheck pos)+    && inRange (-1000) 1000 (fromIntegral staticEval)+    && staticEval + futilityMargin <= alpha =+    emptySearchResult <$> quiesceSearch alpha beta 0 pos++  | otherwise = do+    nullMoveScore <- getNullMoveScore beta depth ply pos+    if any (>= beta) nullMoveScore+      then pure $! emptySearchResult beta+      else traverseMoves =<< getSortedMoves depth ply pos++  where+    staticEval          = evaluatePosition pos+    !futilityMargin     = futilityMargins !! (fromIntegral depth - 1)+    traverseMoves moves = do+      let movesSearch   = getMovesScore beta depth ply moves pos+      (!score, !searchResult) <-+        runStateT movesSearch (emptySearchResult alpha)+      let+        !newAlpha = searchResult.score+        !newScore = fromMaybe newAlpha score+      pure $! searchResult {score = newScore}+++getMovesScore+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+    ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Depth -> Ply -> ([Move], [Move]) -> Position+  -> SearchM (Maybe Score)+getMovesScore !beta !depth !ply (mainMoves, reducedMoves) pos = do+  mainSearchScore <- mainMovesSearch+  maybe reducedMovesSearch (pure . Just) mainSearchScore++  where+    mainMovesSearch       = movesSearch False mainMoves+    reducedMovesSearch    = movesSearch True  reducedMoves+    movesSearch isReduced =+      findTraverseIndex (getMoveScore beta depth ply isReduced pos)+++-- Features:+-- - Principal Variation Search+-- - Late Move Reductions++getMoveScore+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Depth -> Ply -> Bool -> Position -> Int -> Move -> SearchM (Maybe Score)+getMoveScore !beta !depth !ply !isReduced pos !mvIdx !mv = do+  SearchResult {score = alpha} <- get+  if | alpha > 0 && isNotWinnable pos -> pure Nothing+     | isReduced || mvIdx > 0         -> nullWindowSearch+     | otherwise                      -> fullSearch+  where+    !lmrDepth+      | isReduced && quietMove = getLmrDepth mvIdx depth+      | otherwise             = depth++    quietMove = isQuietMove mv pos++    nullWindowSearch = do+     st@SearchResult {score = alpha} <- get+     SearchResult {score} <- getScore alpha (alpha + 1)+     put st+     if score > alpha+       then fullSearch+       else pure Nothing++    fullSearch = do+      SearchResult {score = alpha} <- get+      SearchResult{..} <- getScore alpha beta+      let nodeType    = getNodeType alpha beta score+      !newScore <- advanceState beta score ply nodeType mv bestMove pos+      pure newScore++    getScore !alpha' !beta' = liftIO+      $ getNegamaxScore alpha' beta' lmrDepth ply (makeMove mv pos)+++getNullMoveScore+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Depth -> Ply -> Position -> IO (Maybe Score)+getNullMoveScore !beta !depth !ply pos++  | depth > r && not (isKingInCheck pos)+              && not (isEndgame pos) = do+    SearchResult {..} <- getNegamaxScore alpha beta reducedDepth ply+                                       (makeNullMove pos)+    pure $ Just score++  | otherwise = pure Nothing++  where+    reducedDepth = depth - r+    alpha        = beta - 1+    r            = 2+++getNegamaxScore+  :: (?killersTable :: KillersTable, ?tTable :: TTable,+     ?opts :: EngineOptions, ?nodes :: IORef Word64, ?age :: Age)+  => Score -> Score -> Depth -> Ply -> Position -> IO SearchResult+getNegamaxScore !alpha !beta !depth !ply !pos = do+  result <- negamax (-beta) (-alpha) (depth - 1) (ply + 1) pos+  pure $ result {score = - result.score}+++advanceState :: (?killersTable :: KillersTable)+  => Score -> Score -> Ply -> NodeType -> Move -> Maybe Move -> Position+  -> SearchM (Maybe Score)+advanceState !beta !score !ply !nodeType !mv !enemyMv pos =+  case nodeType of+    PV  -> put searchResult+            $> Nothing+    Cut -> put searchResult+            *> liftIO (KillersTable.insert ply pos mv)+            $> Just beta+    All -> pure Nothing+    where+      !searchResult = SearchResult score (Just mv) enemyMv+++getGameResult :: Score -> GameResult+getGameResult score+  | score == maxScore = Victory+  | score == minScore = Defeat+  | otherwise        = InProgress+++printSearchInfo :: Depth -> Word64 -> MicroSeconds -> SearchResult -> IO ()+printSearchInfo depth nodes elapsedTime SearchResult{..} = do+  putStrLn ("info"+    <> " depth " <> tshow depth+    <> " score " <> showScore+    <> " nodes " <> tshow nodes+    <> " nps "   <> tshow nps+    <> " time "  <> tshow timeMillis+    <> " pv "    <> unwords (tshow <$> pv))+  hFlush stdout+  where+    nps        = nodes * 1_000_000 `div` elapsedTime+    timeMillis = elapsedTime `div` 1_000+    pv         = catMaybes [bestMove, ponderMove]+    showScore = case getGameResult score of+      InProgress -> "cp "   <> tshow score+      Victory    -> "mate " <> tshow @Int 1+      Defeat     -> "mate " <> tshow @Int (-1)+++emptySearchResult :: Score -> SearchResult+emptySearchResult score = SearchResult score Nothing Nothing+++data SearchResult = SearchResult {+    score      :: Score+  , bestMove   :: Maybe Move+  , ponderMove :: Maybe Move+}+++data GameResult+  = InProgress+  | Victory+  | Defeat+  deriving (Eq)+++type SearchM = StateT SearchResult IO
+ src/Search/TimeManagement.hs view
@@ -0,0 +1,65 @@+module Search.TimeManagement (MicroSeconds, getMoveTime, maybeTimeout, isTimeOver, (|-|))  where++import           AppPrelude                 hiding (timeout)+import           Evaluation.Parameters+import           Evaluation.ScoreBreakdown+import           Models.Command+import           Models.Piece+import           Models.Position++import           Control.Concurrent.Timeout (timeout)+import           Data.Time.Clock.System+++getMoveTime :: SearchOptions -> Position -> Maybe MicroSeconds+getMoveTime SearchOptions {..} Position {phase, color} =+  fromIntegral . (* 1000) <$> (moveTime <|> timeToMove)+  where+    timeToMove+      | Just t <- time+      , Just i <- inc+        = Just (min (t / 2) (3 * t / (2 * movesUntil) + i))+      | Just t <- time+        = Just (t / movesUntil)+      | Just i <- inc+        = Just i+      | otherwise+        = Nothing+    (time, inc) = case color of+      White -> (whiteTime, whiteIncrement)+      Black -> (blackTime, blackIncrement)+    movesUntil = fromMaybe movesUntilDefault movesUntilNextTime+    movesUntilDefault =+      let ?phase = phase in fromIntegral $ taperScore (ScorePair 40 10)+++maybeTimeout :: Maybe MicroSeconds -> IO () -> IO ()+maybeTimeout (Just duration) action =+  timeout (fromIntegral duration) action $> ()+maybeTimeout Nothing action         =+  action+++isTimeOver :: SystemTime -> SystemTime -> Maybe MicroSeconds -> Bool+isTimeOver endTime startTime (Just moveTime) =+  endTime |-| startTime > getTimeOver moveTime+isTimeOver _ _ Nothing =+  False+++getTimeOver :: MicroSeconds -> MicroSeconds+getTimeOver moveTime =+  moveTime * 30 / 100+++infixl 9 |-|+(|-|) :: SystemTime -> SystemTime -> MicroSeconds+(|-|) endTime startTime =+  systemTimeToMicros endTime - systemTimeToMicros startTime+  where+  systemTimeToMicros MkSystemTime {..} =+    fromIntegral systemSeconds * 1_000_000+    + fromIntegral systemNanoseconds / 1000+++type MicroSeconds = Word64
+ src/Utils/Board.hs view
@@ -0,0 +1,440 @@+{- HLINT ignore "Use camelCase" -}++module Utils.Board (Board, Square, (>>), (<<), (&), (.\), (.|), (^), (~),  popCount, popCountToBoard, lsb, msb, toBoard, toCondition, getSquareDistance, toReverseCondition, testSquare, toFile, toRank, knightMovesVec, kingMovesVec, fileMovesVec, rankMovesVec, diagMovesVec, antiDiagMovesVec, northEastMovesVec, northWestMovesVec, southEastMovesVec, southWestMovesVec, northMovesVec, westMovesVec, southMovesVec, eastMovesVec, shortCastleSlidingFiles, longCastleSlidingFiles, shortCastleFiles, longCastleFiles, whiteKnightOutpostRanks, blackKnightOutpostRanks, knightOupostFiles, castlingRngVec, enPassantRngVec, sideToMoveRng, pieceRngVec, whiteKnightOutpostAttackersVec, blackKnightOutpostAttackersVec, whitePassedPawnBlockersVec, blackPassedPawnBlockersVec, squares, rank_1, rank_2, rank_3, rank_4, rank_5, rank_6, rank_7, rank_8, file_A, file_B, file_C, file_D, file_E, file_F, file_G, file_H)  where++import           AppPrelude           hiding (foldl', map)++import qualified Data.Bits            as Bits+import           Data.Vector.Storable (foldl', foldl1, foldl1', map, slice)+import           System.IO.Unsafe     (unsafePerformIO)+import           System.Random++type Board = Word64++type Square = Int+type SideSquare = Int+type Diagonal = Int+type Rank = Int+type File = Int+type Diag = Int+++{-# SPECIALIZE (<<) :: Board -> Square -> Board #-}+infixl 9 <<+(<<) :: Bits.Bits a => a -> Square -> a+(<<) !x !y = Bits.unsafeShiftL x y++{-# SPECIALIZE (>>) :: Board -> Square -> Board #-}+infixl 9 >>+(>>) :: Bits.Bits a => a -> Square -> a+(>>) !x !y = Bits.unsafeShiftR x y++infixl 8 &+(&) :: Board -> Board -> Board+(&) !x !y = (Bits..&.) x y++infixl 7 .\+(.\) :: Board -> Board -> Board+(.\) !x !y = x & (~) y++infixl 7 .|+(.|) :: Board -> Board -> Board+(.|) !x !y = (Bits..|.) x y++infixl 7 ^+(^) :: Board -> Board -> Board+(^) !x !y = Bits.xor x y++infixl 9 ~+(~) :: Board -> Board+(~) !x = Bits.complement x++popCount :: Board -> Int+popCount !x = Bits.popCount x++popCountToBoard :: Board -> Board+popCountToBoard !x = fromIntegral $! popCount x++lsb :: Board -> Square+lsb !x = Bits.countTrailingZeros x++msb :: Board -> Square+msb !x = 65 * (zeros / 64) + 63 - zeros+  where+    !zeros = Bits.countLeadingZeros x++{-# SPECIALIZE toReverseCondition :: Board -> Board #-}+{-# SPECIALIZE toReverseCondition :: Square -> Square #-}+toReverseCondition :: (Num a, Ord a) => a -> a+toReverseCondition !x = 1 - toCondition x++{-# SPECIALIZE toCondition :: Board -> Board #-}+{-# SPECIALIZE toCondition :: Square -> Square #-}+toCondition :: (Ord a, Num a) => a -> a+toCondition !x = min 1 x++toBoard :: Square -> Board+toBoard !n = fromIntegral (1 - n / 64) * (1 << n)++testSquare :: Board -> Square -> Bool+testSquare !x !n = x & toBoard n /= 0++toFile :: Square -> File+toFile !n = n % 8++toRank :: Square -> Rank+toRank !n = n / 8++knightMove :: Square -> Board+knightMove n =+    move1 .| move2 .| move3 .| move4 .| move5+          .| move6 .| move7 .| move8+  where+    move1 = (board .\ (file_H .| file_G .| rank_8)) << 10+    move3 = (board .\ (file_H .| rank_7 .| rank_8)) << 17+    move4 = (board .\ (file_A .| rank_7 .| rank_8)) << 15+    move5 = (board .\ (file_A .| file_B .| rank_8)) << 6+    move6 = (board .\ (file_A .| file_B .| rank_1)) >> 10+    move7 = (board .\ (file_A .| rank_2 .| rank_1)) >> 17+    move8 = (board .\ (file_H .| rank_2 .| rank_1)) >> 15+    move2 = (board .\ (file_H .| file_G .| rank_1)) >> 6+    board = toBoard n++kingMove :: Square -> Board+kingMove n =+    move1 .| move2 .| move3 .| move4 .| move5+          .| move6 .| move7 .| move8+  where+    move1 = (board .\ file_H) << 1+    move2 = (board .\ (file_H .| rank_8)) << 9+    move3 = (board .\ file_A) >> 1+    move4 = (board .\ (file_A .| rank_1)) >> 9+    move5 = (board .\ rank_8) << 8+    move6 = (board .\ (file_A .| rank_8)) << 7+    move7 = (board .\ rank_1) >> 8+    move8 = (board .\ (file_H .| rank_1)) >> 7+    board = toBoard n+++knightOutpostAttackers :: Bool -> Int -> Board+knightOutpostAttackers above n = filesBoard & ranksBoard+  where+    filesBoard = getPreviousFile file .| getNextFile file+    ranksBoard = foldl' (.|) 0+      $ map getRank+      $ filter (compareFn rank) sideSquares+    rank = toRank n+    file = toFile n+    compareFn | above     = (<)+              | otherwise = (>)++passedPawnBlockers :: Bool -> Int -> Board+passedPawnBlockers above n = filesBoard & ranksBoard+  where+    filesBoard = getPreviousFile file .| getFile file .| getNextFile file+    ranksBoard = foldl' (.|) 0+      $ map getRank+      $ filter (compareFn rank) sideSquares+    rank = toRank n+    file = toFile n+    compareFn | above     = (<)+              | otherwise = (>)+++squareDistance :: Square -> Square -> Int+squareDistance n1 n2 = max fileDistance rankDistance+  where+    fileDistance = abs (file1 - file2)+    rankDistance = abs (rank1 - rank2)+    file1        = toFile n1+    file2        = toFile n2+    rank1        = toRank n1+    rank2        = toRank n2+++fileMove :: Square -> Board+fileMove n = ranks !! toRank n++rankMove :: Square -> Board+rankMove n = files !! toFile n++diagMove :: Square -> Board+diagMove n = antiDiags !! (toFile n + toRank n)++antiDiagMove :: Square -> Board+antiDiagMove n = diags !! (7 - toFile n + toRank n)++getRank :: Rank -> Board+getRank n = foldl1' (.|) (map f sideSquares)+  where+    f = (1 << (8 * n) <<)++getFile :: File -> Board+getFile n = foldl1' (.|) (map f sideSquares)+  where+    f = (1 << n <<) . (* 8)++getPreviousFile :: File -> Board+getPreviousFile n+  | n == 0 = 0+  | otherwise = getFile (n - 1)++getNextFile :: File -> Board+getNextFile n+  | n == 7 = 0+  | otherwise = getFile (n + 1)++getSquareDistance :: Square -> Square -> Int+getSquareDistance n1 n2 =+  squareDistanceVec !! (n1 * 64 + n2)+++getDiag :: Diag -> Board+getDiag = diagHelper (7 -)++getAntiDiag :: Int -> Board+getAntiDiag = diagHelper id++diagHelper :: (Int -> Int) -> Int -> Board+diagHelper f n = foldl1 (.|) xs+  where+  xs = fromList do+    x <- toList sideSquares+    let y = f (n - x) `rem` 8+    guard $ inRange 0 7 (n - x)+    pure $ toBoard (y + 8 * x)+++-- Move Functions+northMove :: Square -> Board+northMove n = aboveMask n & rankMovesVec !! n++eastMove :: Square -> Board+eastMove n = aboveMask n & fileMovesVec !! n++westMove :: Square -> Board+westMove n = belowMask n & fileMovesVec !! n++southMove :: Square -> Board+southMove n = belowMask n & rankMovesVec !! n++northWestMove :: Square -> Board+northWestMove n = aboveMask n & diagMovesVec !! n++northEastMove :: Square -> Board+northEastMove n = aboveMask n & antiDiagMovesVec !! n++southEastMove :: Square -> Board+southEastMove n = belowMask n & diagMovesVec !! n++southWestMove :: Square -> Board+southWestMove n = belowMask n & antiDiagMovesVec !! n+++-- Masks+aboveMask :: Square -> Board+aboveMask n = (toBoard 63 - toBoard n) << 1++belowMask :: Square -> Board+belowMask n = toBoard n - 1+++-- Directions+ranks :: Vector Board+ranks = map getRank sideSquares++files :: Vector Board+files = map getFile sideSquares++diags :: Vector Board+diags = map getDiag diagonals++antiDiags :: Vector Board+antiDiags = map getAntiDiag diagonals+++-- Cached Piece moves+knightMovesVec :: Vector Board+knightMovesVec = map knightMove squares++kingMovesVec :: Vector Board+kingMovesVec = map kingMove squares+++-- Sliding moves+fileMovesVec :: Vector Board+fileMovesVec = snoc (map fileMove squares) 0++rankMovesVec :: Vector Board+rankMovesVec = snoc (map rankMove squares) 0++diagMovesVec :: Vector Board+diagMovesVec = snoc (map diagMove squares) 0++antiDiagMovesVec :: Vector Board+antiDiagMovesVec = snoc (map antiDiagMove squares) 0++westMovesVec :: Vector Board+westMovesVec = snoc (map westMove squares) 0++northMovesVec :: Vector Board+northMovesVec = snoc (map northMove squares) 0++eastMovesVec :: Vector Board+eastMovesVec = snoc (map eastMove squares) 0++southMovesVec :: Vector Board+southMovesVec = snoc (map southMove squares) 0++northWestMovesVec :: Vector Board+northWestMovesVec = snoc (map northWestMove squares) 0++northEastMovesVec :: Vector Board+northEastMovesVec = snoc (map northEastMove squares) 0++southEastMovesVec :: Vector Board+southEastMovesVec = snoc (map southEastMove squares) 0++southWestMovesVec :: Vector Board+southWestMovesVec = snoc (map southWestMove squares) 0+++-- Evaluation+whiteKnightOutpostAttackersVec :: Vector Board+whiteKnightOutpostAttackersVec =+  map (knightOutpostAttackers True) squares++blackKnightOutpostAttackersVec :: Vector Board+blackKnightOutpostAttackersVec =+  map (knightOutpostAttackers False) squares++whitePassedPawnBlockersVec :: Vector Board+whitePassedPawnBlockersVec =+  map (passedPawnBlockers True) squares++blackPassedPawnBlockersVec :: Vector Board+blackPassedPawnBlockersVec =+  map (passedPawnBlockers False) squares++squareDistanceVec :: Vector Int+squareDistanceVec = fromList do+  n1 <- toList squares+  n2 <- toList squares+  pure $ squareDistance n1 n2+++{-# NOINLINE pieceRngVec #-}+pieceRngVec :: Vector Board+pieceRngVec = unsafePerformIO+  (slice 0 768 <$> genRandoms)+++{-# NOINLINE castlingRngVec #-}+castlingRngVec :: Vector Board+castlingRngVec = unsafePerformIO+  (slice 768 16 <$> genRandoms)+++{-# NOINLINE enPassantRngVec #-}+enPassantRngVec :: Vector Board+enPassantRngVec = unsafePerformIO+  (slice 784 8 <$> genRandoms)+++{-# NOINLINE sideToMoveRng #-}+sideToMoveRng :: Board+sideToMoveRng = unsafePerformIO+  ((!! 792) <$> genRandoms)+++genRandoms :: IO (Vector Board)+genRandoms = fromList+  . take 1000 . randoms+  <$> getStdGen+++-- Ranges+squares :: Vector Square+squares = fromList [0 .. 63]++sideSquares :: Vector SideSquare+sideSquares = fromList [0 .. 7]++diagonals :: Vector Diagonal+diagonals = fromList [0 .. 14]+++-- Useful boards+shortCastleSlidingFiles :: Board+shortCastleSlidingFiles = file_F .| file_G++longCastleSlidingFiles :: Board+longCastleSlidingFiles = file_C .| file_D+++shortCastleFiles :: Board+shortCastleFiles = file_F .| file_G .| file_H++longCastleFiles :: Board+longCastleFiles = file_A .| file_B .| file_C++whiteKnightOutpostRanks :: Board+whiteKnightOutpostRanks = rank_5 .| rank_6 .| rank_7++blackKnightOutpostRanks :: Board+blackKnightOutpostRanks = rank_4 .| rank_3 .| rank_2++knightOupostFiles :: Board+knightOupostFiles = file_C .| file_D .| file_E .| file_F+++-- Ranks+rank_1 :: Board+rank_1 = getRank 0++rank_2 :: Board+rank_2 = getRank 1++rank_3 :: Board+rank_3 = getRank 2++rank_4 :: Board+rank_4 = getRank 3++rank_5 :: Board+rank_5 = getRank 4++rank_6 :: Board+rank_6 = getRank 5++rank_7 :: Board+rank_7 = getRank 6++rank_8 :: Board+rank_8 = getRank 7+++-- Files+file_A :: Board+file_A = getFile 0++file_B :: Board+file_B = getFile 1++file_C :: Board+file_C = getFile 2++file_D :: Board+file_D = getFile 3++file_E :: Board+file_E = getFile 4++file_F :: Board+file_F = getFile 5++file_G :: Board+file_G = getFile 6++file_H :: Board+file_H = getFile 7
+ src/Utils/KillersTable.hs view
@@ -0,0 +1,49 @@+module Utils.KillersTable where++import           AppPrelude++import           Models.Move+import           Models.Position+import           Models.Score+import           MoveGen.MoveQueries++import           Data.Vector.Storable.Mutable (IOVector)+import qualified Data.Vector.Storable.Mutable as Vector+++type KillersTable = IOVector StorableMove+++lookupMoves :: (?killersTable :: KillersTable) => Ply -> IO [Move]+lookupMoves !ply = do+  firstMove  <- Vector.unsafeRead ?killersTable idx+  secondMove <- Vector.unsafeRead ?killersTable (idx + 1)+  pure $ mapMaybe decodeMove [firstMove, secondMove]+  where+    !idx = killerSlots * fromIntegral ply+++insert :: (?killersTable :: KillersTable) => Ply -> Position -> Move -> IO ()+insert !ply pos mv =+  when (isQuietMove mv pos) do+  firstMove  <- Vector.unsafeRead ?killersTable idx+  unless (mv `elem` decodeMove firstMove) do+    Vector.unsafeWrite ?killersTable idx+                                    (encodeMove $ Just mv)+    Vector.unsafeWrite ?killersTable (idx + 1)+                                     firstMove+  where+    !idx = killerSlots * fromIntegral ply+++create :: IO KillersTable+create = Vector.replicate (killerSlots * (fromIntegral (maxBound @Ply) + 1))+                          (encodeMove Nothing)+++clear ::  KillersTable -> IO ()+clear = Vector.clear+++killerSlots :: Int+killerSlots = 2
+ src/Utils/TranspositionTable.hs view
@@ -0,0 +1,154 @@+module Utils.TranspositionTable where++import           AppPrelude++import           Models.Command+import           Models.Move+import           Models.Position              (ZKey (..))+import           Models.Score+import           Utils.Board++import           Data.Vector.Storable.Mutable (IOVector)+import qualified Data.Vector.Storable.Mutable as Vector+import           Data.Word+import           Foreign.Storable.Generic+import           Test.QuickCheck+++type TTable = IOVector StorableTEntry+++data TEntry = TEntry {+  zobristKey :: ZKey,+  bestMove   :: Maybe Move,+  score      :: Score,+  depth      :: Depth,+  nodeType   :: NodeType,+  age        :: Age+} deriving (Eq, Show, Generic)++instance Arbitrary TEntry where+  arbitrary = TEntry <$> arbitrary <*> arbitrary+                     <*> arbitrary <*> arbitrary+                     <*> arbitrary <*> choose (0, 31)++data StorableTEntry = StorableTEntry {+  zobristKey :: ZKey,+  info       :: Word64+} deriving Generic++instance GStorable StorableTEntry+++tTableSize :: (?opts :: EngineOptions) => Word64+tTableSize | ?opts.hashSize == 0 = 0+           | otherwise          = toBoard bits+  where+    bits = msb (fromIntegral ?opts.hashSize) + 16+++hashZKey :: (?opts :: EngineOptions) => ZKey -> Int+hashZKey (ZKey zKey) =+  fromIntegral (zKey % tTableSize)+++encodeTEntry :: TEntry -> StorableTEntry+encodeTEntry TEntry {..} = StorableTEntry {+  zobristKey = zobristKey,+  info = fromIntegral bestMoveN+    .| fromIntegral (fromIntegral score :: Word16) << 32+    .| fromIntegral depth << 48+    .| fromIntegral nodeTypeN << 56+    .| fromIntegral age << 58+  }+  where+    StorableMove bestMoveN = encodeMove bestMove+    NodeType nodeTypeN     = nodeType+++decodeTEntry :: StorableTEntry -> Maybe TEntry+decodeTEntry StorableTEntry {..}+  | testSquare info 63 = Nothing+  | otherwise          = Just TEntry {+      zobristKey = zobristKey+      , bestMove   = decodeMove $ fromIntegral info+      , score      = fromIntegral (info >> 32)+      , depth      = fromIntegral (info >> 48)+      , nodeType   = fromIntegral ((info >> 56) & 3)+      , age        = fromIntegral ((info >> 58) & 31)+  }+++lookupEntry+  :: (?tTable :: TTable, ?opts :: EngineOptions) => ZKey -> IO (Maybe TEntry)+lookupEntry !zKey+  | tTableSize == 0 = pure Nothing+  | otherwise      = do+  entry <- decodeTEntry <$> Vector.unsafeRead ?tTable (hashZKey zKey)+  pure (maybeFilter ((== zKey) . (.zobristKey)) entry)+++lookupScore+  :: (?tTable :: TTable, ?opts :: EngineOptions)+  => Score -> Score -> Depth -> ZKey -> IO (Maybe (Score, Maybe Move))+lookupScore !alpha !beta !depth !zKey = do+  entry <- maybeFilter ((>= depth) . (.depth)) <$> lookupEntry zKey+  let !score = getScore =<< entry+      !bestMove = (.bestMove) =<< entry+  pure ((, bestMove) <$> score)+  where+    getScore TEntry {score, nodeType} =+      case nodeType of+        PV                   -> Just score+        Cut | score >= beta  -> Just beta+        All | score <= alpha -> Just alpha+        _                    -> Nothing+++lookupBestMove+  :: (?tTable :: TTable, ?opts :: EngineOptions) => ZKey -> IO (Maybe Move)+lookupBestMove !zKey = do+  entry <- lookupEntry zKey+  pure ((.bestMove) =<< entry)+++insert+  :: (?tTable :: TTable, ?opts :: EngineOptions) => ZKey -> TEntry -> IO ()+insert !zKey !newEntry+ | tTableSize == 0 = pure ()+ | otherwise       = do+  entry <- decodeTEntry <$> Vector.unsafeRead ?tTable hashKey+  when (isStaleEntry entry newEntry)+    $ Vector.unsafeWrite ?tTable hashKey (encodeTEntry newEntry)+  where+    hashKey = hashZKey zKey+++isStaleEntry :: Maybe TEntry -> TEntry -> Bool+isStaleEntry (Just entry) newEntry =+  newEntry.age - entry.age > 1+  || newEntry.depth >= entry.depth+  && (newEntry.nodeType == PV || entry.nodeType /= PV)+isStaleEntry Nothing _ =+  True+++emptyTEntry :: StorableTEntry+emptyTEntry = StorableTEntry {+  zobristKey = 0,+  info       = toBoard 63+}+++create ::  EngineOptions -> IO TTable+create opts = Vector.replicate (fromIntegral tTableSize) emptyTEntry+  where+    ?opts = opts+++reset :: TTable -> IO ()+reset = flip Vector.set emptyTEntry+++clear :: TTable -> IO ()+clear = Vector.clear
+ test/Search/PerftSpec.hs view
@@ -0,0 +1,68 @@+module Search.PerftSpec where++import           AppPrelude++import           Control.Error.Util (hush)+import           Data.Maybe         (fromJust)+import           Test.Hspec++import           Bookhound.Parser+import           Models.Position+import           Parsers.Position+import           Search.Perft++spec :: Spec+spec = do++  describe "Perft tests" do++    it "Initial Position" do+      perft 6 startPosition `shouldBe` 119_060_324++    it "Kiwipete" do+      perft 5 kiwipete `shouldBe` 193_690_690++    it "Extra Position 1" do+      perft 7 extraPos1 `shouldBe` 178_633_661++    it "Extra Position 2" do+      perft 6 extraPos2 `shouldBe` 706_045_033++    it "Extra Position 3" do+      perft 5 extraPos3 `shouldBe` 89_941_194++    it "Extra Position 4" do+      perft 5 extraPos4 `shouldBe` 164_075_551++    it "Extra Position 5" do+      perft 5 extraPos5 `shouldBe` 73_007_159++++kiwipete :: Position+kiwipete = fenPosition+  "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq - 0 1"++extraPos1 :: Position+extraPos1 = fenPosition+  "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - - 0 1"++extraPos2 :: Position+extraPos2 = fenPosition+  "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq - 0 1"++extraPos3 :: Position+extraPos3 = fenPosition+  "rnbq1k1r/pp1Pbppp/2p5/8/2B5/8/PPP1NnPP/RNBQK2R w KQ - 0 1"++extraPos4 :: Position+extraPos4 = fenPosition+  "r4rk1/1pp1qppp/p1np1n2/2b1p1B1/2B1P1b1/P1NP1N2/1PP1QPPP/R4RK1 w - - 0 1"++extraPos5 :: Position+extraPos5 = fenPosition+  "1k1r2r1/1pp2p1p/np1p1pb1/3P2q1/1PPN4/P6Q/4BPPP/3RR1K1 b - - 0 1"+++fenPosition :: Text -> Position+fenPosition = fromJust . hush . runParser positionFenParser
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Utils/TranspositionTableSpec.hs view
@@ -0,0 +1,21 @@+module Utils.TranspositionTableSpec where++import           AppPrelude++import           Test.QuickCheck.Property++import           Test.Hspec               (Spec, it, shouldBe)+import           Test.QuickCheck          (Args (maxSuccess), quickCheckWith,+                                           stdArgs)+import           Utils.TranspositionTable+++spec :: Spec+spec = do++  it "Encode then decode Table entries" $+    quickCheckWith stdArgs {maxSuccess = 1_000 }+    \tEntry -> (decodeTEntry . encodeTEntry) tEntry === Just tEntry++  it "Decode empty Table entry" $+     decodeTEntry emptyTEntry `shouldBe` Nothing
+ turncoat.cabal view
@@ -0,0 +1,187 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name:           turncoat+version:        1.0+synopsis:       Elegant UCI chess engine+description:    Please see the README on GitHub at <https://github.com/albertprz/turncoat#readme>+category:       Chess Engine+homepage:       https://github.com/albertprz/turncoat#readme+bug-reports:    https://github.com/albertprz/turncoat/issues+author:         Alberto Perez+maintainer:     albertoperez1994@gmail.com+copyright:      2023 Alberto Perez+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/albertprz/turncoat++library+  exposed-modules:+      AppPrelude+      Evaluation.Evaluation+      Evaluation.Material+      Evaluation.Parameters+      Evaluation.ScoreBreakdown+      Models.Command+      Models.Move+      Models.Piece+      Models.Position+      Models.Score+      MoveGen.MakeMove+      MoveGen.MoveQueries+      MoveGen.PieceAttacks+      MoveGen.PieceCaptures+      MoveGen.PieceQuietMoves+      MoveGen.PositionQueries+      Parsers.Command+      Parsers.Position+      Search.MoveOrdering+      Search.Parameters+      Search.Perft+      Search.Quiescence+      Search.Search+      Search.TimeManagement+      Utils.Board+      Utils.KillersTable+      Utils.TranspositionTable+  other-modules:+      Paths_turncoat+  hs-source-dirs:+      src+  default-extensions:+      NoImplicitPrelude+      StrictData+      LambdaCase+      MultiWayIf+      BlockArguments+      PostfixOperators+      DuplicateRecordFields+      NoFieldSelectors+      RecordWildCards+      OverloadedRecordDot+      OverloadedStrings+      ViewPatterns+      PatternSynonyms+      ImplicitParams+  ghc-options: -O2 -funbox-strict-fields -fspecialize-aggressively -fexpose-all-unfoldings -funfolding-use-threshold=200 -fspec-constr-count=20 -flate-dmd-anal -flate-specialise -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      QuickCheck+    , async+    , base ==4.*+    , bookhound+    , classy-prelude+    , composition+    , containers+    , derive-storable+    , errors+    , mtl+    , newtype+    , random+    , split+    , text+    , time+    , unbounded-delays+    , vector+  default-language: GHC2021++executable turncoat+  main-is: Main.hs+  other-modules:+      Uci+      Paths_turncoat+  hs-source-dirs:+      app+  default-extensions:+      NoImplicitPrelude+      StrictData+      LambdaCase+      MultiWayIf+      BlockArguments+      PostfixOperators+      DuplicateRecordFields+      NoFieldSelectors+      RecordWildCards+      OverloadedRecordDot+      OverloadedStrings+      ViewPatterns+      PatternSynonyms+      ImplicitParams+  ghc-options: -O2 -funbox-strict-fields -fspecialize-aggressively -fexpose-all-unfoldings -funfolding-use-threshold=200 -fspec-constr-count=20 -flate-dmd-anal -flate-specialise -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , async+    , base ==4.*+    , bookhound+    , classy-prelude+    , composition+    , containers+    , derive-storable+    , errors+    , mtl+    , newtype+    , random+    , split+    , text+    , time+    , turncoat+    , unbounded-delays+    , vector+  default-language: GHC2021++test-suite test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Search.PerftSpec+      Utils.TranspositionTableSpec+      Paths_turncoat+  hs-source-dirs:+      test+  default-extensions:+      NoImplicitPrelude+      StrictData+      LambdaCase+      MultiWayIf+      BlockArguments+      PostfixOperators+      DuplicateRecordFields+      NoFieldSelectors+      RecordWildCards+      OverloadedRecordDot+      OverloadedStrings+      ViewPatterns+      PatternSynonyms+      ImplicitParams+  ghc-options: -O2 -funbox-strict-fields -fspecialize-aggressively -fexpose-all-unfoldings -funfolding-use-threshold=200 -fspec-constr-count=20 -flate-dmd-anal -flate-specialise -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-type-defaults+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      QuickCheck+    , async+    , base ==4.*+    , bookhound+    , classy-prelude+    , composition+    , containers+    , derive-storable+    , errors+    , hspec+    , mtl+    , newtype+    , random+    , split+    , text+    , time+    , turncoat+    , unbounded-delays+    , vector+  default-language: GHC2021