packages feed

ymonad (empty) → 0.1.0.0

raw patch · 32 files changed

+5984/−0 lines, 32 filesdep +basedep +binarydep +bytestring

Dependencies added: base, binary, bytestring, containers, directory, effectful, filepath, hxt, network, process, relude, stm, text, time, ymonad

Files

+ LICENSE view
@@ -0,0 +1,660 @@+# GNU AFFERO GENERAL PUBLIC LICENSE++Version 3, 19 November 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 Affero General Public License is a free, copyleft license for+software and other kinds of works, specifically designed to ensure+cooperation with the community in the case of network server software.++The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+our General Public Licenses are 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.++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.++Developers that use our General Public Licenses protect your rights+with two steps: (1) assert copyright on the software, and (2) offer+you this License which gives you legal permission to copy, distribute+and/or modify the software.++A secondary benefit of defending all users' freedom is that+improvements made in alternate versions of the program, if they+receive widespread use, become available for other developers to+incorporate. Many developers of free software are heartened and+encouraged by the resulting cooperation. However, in the case of+software used on network servers, this result may fail to come about.+The GNU General Public License permits making a modified version and+letting the public access it on a server without ever releasing its+source code to the public.++The GNU Affero General Public License is designed specifically to+ensure that, in such cases, the modified source code becomes available+to the community. It requires the operator of a network server to+provide the source code of the modified version running there to the+users of that server. Therefore, public use of a modified version, on+a publicly accessible server, gives the public access to the source+code of the modified version.++An older license, called the Affero General Public License and+published by Affero, was designed to accomplish similar goals. This is+a different license, not a version of the Affero GPL, but Affero has+released a new version of the Affero GPL which permits relicensing+under this license.++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 Affero 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. Remote Network Interaction; Use with the GNU General Public License.++Notwithstanding any other provision of this License, if you modify the+Program, your modified version must prominently offer all users+interacting with it remotely through a computer network (if your+version supports such interaction) an opportunity to receive the+Corresponding Source of your version by providing access to the+Corresponding Source from a network server at no charge, through some+standard or customary means of facilitating copying of software. This+Corresponding Source shall include the Corresponding Source for any+work covered by version 3 of the GNU General Public License that is+incorporated pursuant to the following paragraph.++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 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 work with which it is combined will remain governed by version+3 of the GNU General Public License.++### 14. Revised Versions of this License.++The Free Software Foundation may publish revised and/or new versions+of the GNU Affero 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 Affero 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 Affero 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 Affero 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 Affero 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 Affero General Public License for more details.++        You should have received a copy of the GNU Affero 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 your software can interact with users remotely through a computer+network, you should also make sure that it provides a way for users to+get its source. For example, if your program is a web application, its+interface could display a "Source" link that leads users to an archive+of the code. There are many ways you could offer source, and different+solutions will be better for different programs; see section 13 for+the specific requirements.++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 AGPL, see <https://www.gnu.org/licenses/>.
+ protocol/river/river-window-management-v1.xml view
@@ -0,0 +1,1854 @@+<?xml version="1.0" encoding="UTF-8"?>+<protocol name="river_window_management_v1">+  <copyright>+    SPDX-FileCopyrightText: © 2024 Isaac Freund+    SPDX-License-Identifier: MIT++    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to+    deal in the Software without restriction, including without limitation the+    rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+    sell copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:++    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.++    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+    FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+    IN THE SOFTWARE.+  </copyright>++  <description summary="frame-perfect window management">+    This protocol allows a single "window manager" client to determine the+    window management policy of the compositor. State is globally+    double-buffered allowing for frame perfect state changes involving multiple+    windows.++    The key words "must", "must not", "required", "shall", "shall not",+    "should", "should not", "recommended", "may", and "optional" in this+    document are to be interpreted as described in IETF RFC 2119.+  </description>++  <interface name="river_window_manager_v1" version="4">+    <description summary="window manager global interface">+      This global interface should only be advertised to the window manager+      process. Only one window management client may be active at a time. The+      compositor should use the unavailable event if necessary to enforce this.++      There are two disjoint categories of state managed by this protocol:++      Window management state influences the communication between the+      compositor and individual windows (e.g. xdg_toplevels). Window management+      state includes window dimensions, fullscreen state, keyboard focus,+      keyboard bindings, and more.++      Rendering state only affects the rendered output of the compositor and+      does not influence communication between the compositor and individual+      windows. Rendering state includes the position and rendering order of+      windows, shell surfaces, decoration surfaces, borders, and more.++      Window management state may only be modified by the window manager as part+      of a manage sequence. A manage sequence is started with the manage_start+      event and ended with the manage_finish request. It is a protocol error to+      modify window management state outside of a manage sequence.++      A manage sequence is always followed by at least one render sequence. A+      render sequence is started with the render_start event and ended with the+      render_finish request.++      Rendering state may be modified by the window manager during a manage+      sequence or a render sequence. Regardless of when the rendering state is+      modified, it is applied with the next render_finish request. It is a+      protocol error to modify rendering state outside of a manage or render+      sequence.++      The server will start a manage sequence by sending new state and the+      manage_start event as soon as possible whenever there is a change in state+      that must be communicated with the window manager.++      If the window manager client needs to ensure a manage sequence is started+      due to a state change the compositor is not aware of, it may send the+      manage_dirty request.++      The server will start a render sequence by sending new state and the+      render_start event as soon as possible whenever there is a change in+      window dimensions that must be communicated with the window manager.+      Multiple render sequences may be made consecutively without a manage+      sequence in between, for example if a window independently changes its own+      dimensions.++      To summarize, the main loop of this protocol is as follows:++      1. The server sends events indicating all changes since the last+         manage sequence followed by the manage_start event.++      2. The client sends requests modifying window management state or+         rendering state (as defined above) followed by the manage_finish+         request.++      3. The server sends new state to windows and waits for responses.++      4. The server sends new window dimensions to the client followed by the+         render_start event.++      5. The client sends requests modifying rendering state (as defined above)+         followed by the render_finish request.++      6. If window dimensions change, loop back to step 4.+         If state that requires a manage sequence changes or if the client makes+         a manage_dirty request, loop back to step 1.++      For the purposes of frame perfection, the server may delay rendering new+      state committed by the windows in step 3 until after step 5 is finished.++      It is a protocol error for the client to make a manage_finish or+      render_finish request that violates this ordering.+    </description>++    <enum name="error">+      <entry name="sequence_order" value="0"+        summary="request violates manage/render sequence ordering"/>+      <entry name="role" value="1"+        summary="given wl_surface already has a role"/>+      <entry name="unresponsive" value="2"+        summary="window manager unresponsive"/>+    </enum>++    <event name="unavailable">+      <description summary="window management unavailable">+        This event indicates that window management is not available to the+        client, perhaps due to another window management client already running.+        The circumstances causing this event to be sent are compositor policy.++        If sent, this event is guaranteed to be the first and only event sent by+        the server.++        The server will send no further events on this object. The client should+        destroy this object and all objects created through this interface.+      </description>+    </event>++    <request name="stop">+      <description summary="stop sending events">+        This request indicates that the client no longer wishes to receive+        events on this object.++        The Wayland protocol is asynchronous, which means the server may send+        further events until the stop request is processed. The client must wait+        for a river_window_manager_v1.finished event before destroying this+        object.+      </description>+    </request>++    <event name="finished">+      <description summary="the server has finished with the window manager">+        This event indicates that the server will send no further events on this+        object. The client should destroy the object. See+        river_window_manager_v1.destroy for more information.+      </description>+    </event>++    <request name="destroy" type="destructor">+      <description summary="destroy the river_window_manager_v1 object">+        This request should be called after the finished event has been received+        to complete destruction of the object.++        If a client wishes to destroy this object it should send a+        river_window_manager_v1.stop request and wait for a+        river_window_manager_v1.finished event. Once the finished event is+        received it is safe to destroy this object and any other objects created+        through this interface.+      </description>+    </request>++    <event name="manage_start">+      <description summary="start a manage sequence">+        This event indicates that the server has sent events indicating all+        state changes since the last manage sequence.++        In response to this event, the client should make requests modifying+        window management state as it chooses. Then, the client must make the+        manage_finish request.++        See the description of the river_window_manager_v1 interface for a+        complete overview of the manage/render sequence loop.+      </description>+    </event>++    <request name="manage_finish">+      <description summary="finish a manage sequence">+        This request indicates that the client has made all changes to window+        management state it wishes to include in the current manage sequence and+        that the server should atomically send these state changes to the+        windows and continue with the manage sequence.++        After sending this request, it is a protocol error for the client to+        make further changes to window management state until the next+        manage_start event is received.++        See the description of the river_window_manager_v1 interface for a+        complete overview of the manage/render sequence loop.+      </description>+    </request>++    <request name="manage_dirty">+      <description summary="ensure a manage sequence is started">+        This request ensures a manage sequence is started and that a+        manage_start event is sent by the server. If this request is made during+        an ongoing manage sequence, a new manage sequence will be started as+        soon as the current one is completed.++        The client may want to use this request due to an internal state change+        that the compositor is not aware of (e.g. a dbus event) which should+        affect window management or rendering state.+      </description>+    </request>++    <event name="render_start">+      <description summary="start a render sequence">+        This event indicates that the server has sent all river_node_v1.position+        and river_window_v1.dimensions events necessary.++        In response to this event, the client should make requests modifying+        rendering state as it chooses. Then, the client must make the+        render_finish request.++        See the description of the river_window_manager_v1 interface for a+        complete overview of the manage/render sequence loop.+      </description>+    </event>++    <request name="render_finish">+      <description summary="finish a render sequence">+        This request indicates that the client has made all changes to rendering+        state it wishes to include in the current manage sequence and that the+        server should atomically apply and display these state changes to the+        user.++        After sending this request, it is a protocol error for the client to+        make further changes to rendering state until the next manage_start or+        render_start event is received, whichever comes first.++        See the description of the river_window_manager_v1 interface for a+        complete overview of the manage/render sequence loop.+      </description>+    </request>++    <event name="session_locked">+      <description summary="the session has been locked">+        This event indicates that the session has been locked.++        The window manager may wish to restrict which key bindings are available+        while locked or otherwise use this information.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="session_unlocked">+      <description summary="the session has been unlocked">+        This event indicates that the session has been unlocked.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="window">+      <description summary="new window">+        A new window has been created.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="id" type="new_id" interface="river_window_v1" summary="new window"/>+    </event>++    <event name="output">+      <description summary="new output">+        A new logical output has been created, perhaps due to a new physical+        monitor being plugged in or perhaps due to a change in configuration.++        This event will be followed by river_output_v1.position and dimensions+        events as well as a manage_start event after all other new state has+        been sent by the server.+      </description>+      <arg name="id" type="new_id" interface="river_output_v1" summary="new output"/>+    </event>++    <event name="seat">+      <description summary="new seat">+        A new seat has been created.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="id" type="new_id" interface="river_seat_v1" summary="new seat"/>+    </event>++    <request name="get_shell_surface">+      <description summary="assign the river_shell_surface_v1 surface role">+        Create a new shell surface for window manager UI and assign the+        river_shell_surface_v1 role to the surface.++        Providing a wl_surface which already has a role or already has a buffer+        attached or committed is a protocol error.+      </description>+      <arg name="id" type="new_id" interface="river_shell_surface_v1"+        summary="new river shell surface"/>+      <arg name="surface" type="object" interface="wl_surface"+        summary="base surface"/>+    </request>++    <request name="exit_session" since="4">+      <description summary="exit the Wayland session">+        End the current Wayland session and exit the compositor.+        All Wayland clients running in the current session, including+        the window manager, will be disconnected.++        Window managers should only make this request if the user explicitly+        asks to exit the Wayland session, not for example on normal window+        manager termination.+      </description>+    </request>+  </interface>++  <interface name="river_window_v1" version="4">+    <description summary="a logical window">+      This represents a logical window. For example, a window may correspond to+      an xdg_toplevel or Xwayland window.++      A newly created window will not be displayed until the window manager+      makes a propose_dimensions or fullscreen request as part of a manage+      sequence, the server replies with a dimensions event as part of a render+      sequence, and that render sequence is finished.+    </description>++    <enum name="error">+      <entry name="node_exists" value="0"+        summary="window already has a node object"/>+      <entry name="invalid_dimensions" value="1"+        summary="proposed dimensions out of bounds"/>+      <entry name="invalid_border" value="2"+        summary="invalid arg to set_borders"/>+      <entry name="invalid_clip_box" value="3"+        summary="invalid arg to set_clip_box"/>+    </enum>++    <request name="destroy" type="destructor">+      <description summary="destroy the window object">+        This request indicates that the client will no longer use the window+        object and that it may be safely destroyed.++        This request should be made after the river_window_v1.closed event or+        river_window_manager_v1.finished is received to complete destruction of+        the window.+      </description>+    </request>++    <event name="closed">+      <description summary="the window has been closed">+        The window has been closed by the server, perhaps due to an+        xdg_toplevel.close request or similar.++        The server will send no further events on this object and ignore any+        request other than river_window_v1.destroy made after this event is+        sent. The client should destroy this object with the+        river_window_v1.destroy request to free up resources.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <request name="close">+      <description summary="request that the window be closed">+        Request that the window be closed. The window may ignore this request or+        only close after some delay, perhaps opening a dialog asking the user to+        save their work or similar.++        The server will send a river_window_v1.closed event if/when the window+        has been closed.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="get_node">+      <description summary="get the window's render list node">+        Get the node in the render list corresponding to the window.++        It is a protocol error to make this request more than once for a single+        window.+      </description>+      <arg name="id" type="new_id" interface="river_node_v1" summary="new node"/>+    </request>++    <event name="dimensions_hint">+      <description summary="the window's preferred min/max dimensions">+        This event informs the window manager of the window's preferred min/max+        dimensions. These preferences are a hint, and the window manager is free+        to propose dimensions outside of these bounds.++        All min/max width/height values must be strictly greater than or equal+        to 0. A value of 0 indicates that the window has no preference for that+        value.++        The min_width/min_height must be strictly less than or equal to the+        max_width/max_height.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="min_width" type="int" summary="minimum width"/>+      <arg name="min_height" type="int" summary="minimum height"/>+      <arg name="max_width" type="int" summary="maximum width"/>+      <arg name="max_height" type="int" summary="maximum height"/>+    </event>++    <event name="dimensions">+      <description summary="window dimensions">+        This event indicates the dimensions of the window in the compositor's+        logical coordinate space. The width and height must be strictly greater+        than zero.++        Note that the dimensions of a river_window_v1 refer to the dimensions of+        the window content and are unaffected by the presence of borders or+        decoration surfaces.++        This event is sent as part of a render sequence before the render_start+        event.++        It may be sent due to a propose_dimensions or fullscreen request in a+        previous manage sequence or because a window independently decides to+        change its dimensions.++        The window will not be displayed until the first dimensions event is+        received and the render sequence is finished.+      </description>+      <arg name="width" type="int" summary="window content width"/>+      <arg name="height" type="int" summary="window content height"/>+    </event>++    <request name="propose_dimensions">+      <description summary="propose window dimensions">+        This request proposes dimensions for the window in the compositor's+        logical coordinate space.++        The width and height must be greater than or equal to zero. If the width+        or height is zero the window will be allowed to decide its own+        dimensions.++        The window may not take the exact dimensions proposed. The actual+        dimensions taken by the window will be sent in a subsequent+        river_window_v1.dimensions event. For example, a terminal emulator may+        only allow dimensions that are multiple of the cell size.++        When a propose_dimensions request is made, the server must send a+        dimensions event in response as soon as possible. It may not be possible+        to send a dimensions event in the very next render sequence if, for+        example, the window takes too long to respond to the proposed+        dimensions. In this case, the server will send the dimensions event in a+        future render sequence.++        Note that the dimensions of a river_window_v1 refer to the dimensions of+        the window content and are unaffected by the presence of borders or+        decoration surfaces.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="width" type="int" summary="proposed content width"/>+      <arg name="height" type="int" summary="proposed content height"/>+    </request>++    <request name="hide">+      <description summary="request that the window be hidden">+        Request that the window be hidden. Has no effect if the window is+        already hidden. Hides any window borders and decorations as well.++        Newly created windows are considered shown unless explicitly hidden with+        the hide request.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="show">+      <description summary="request that the window be shown">+        Request that the window be shown. Has no effect if the window is not+        hidden. Does not guarantee that the window is visible as it may be+        completely obscured by other windows placed above it for example.++        Newly created windows are considered shown unless explicitly hidden with+        the hide request.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="app_id">+      <description summary="the window set an application ID">+        The window set an application ID.++        The app_id argument will be null if the window has never set an+        application ID or if the window cleared its application ID. (Xwayland+        windows may do this for example, though xdg-toplevels may not.)++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="app_id" type="string" allow-null="true"+        summary="window application ID"/>+    </event>++    <event name="title">+      <description summary="the window set a title">+        The window set a title.++        The title argument will be null if the window has never set a title or+        if the window cleared its title. (Xwayland windows may do this for+        example, though xdg-toplevels may not.)++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="title" type="string" allow-null="true" summary="window title"/>+    </event>++    <event name="parent">+      <description summary="the window set a parent">+        The window set a parent window. If this event is never received or if+        the parent argument is null then the window has no parent.++        A surface with a parent set might be a dialog, file picker, or similar+        for the parent window.++        Child windows should generally be rendered directly above their parent.++        The compositor must guarantee that there are no loops in the window+        tree: a parent must not be the descendant of one of its children.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="parent" type="object" allow-null="true"+        interface="river_window_v1" summary="parent window, if any"/>+    </event>++    <enum name="decoration_hint">+      <entry name="only_supports_csd" value="0"+        summary="only supports client side decoration"/>+      <entry name="prefers_csd" value="1"+        summary="client side decoration preferred, both CSD and SSD supported"/>+      <entry name="prefers_ssd" value="2"+        summary="server side decoration preferred, both CSD and SSD supported"/>+      <entry name="no_preference" value="3"+        summary="no preference, both CSD and SSD supported"/>+    </enum>++    <event name="decoration_hint">+      <description summary="supported/preferred decoration style">+        Information from the window about the supported and preferred client+        side/server side decoration options.++        This event may be sent multiple times over the lifetime of the window if+        the window changes its preferences.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="hint" type="uint" enum="decoration_hint" summary="decoration hint"/>+    </event>++    <request name="use_csd">+      <description summary="tell the client to use CSD">+        Tell the client to use client side decoration and draw its own title+        bar, borders, etc.++        This is the default if neither this request nor the use_ssd request is+        ever made.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="use_ssd">+      <description summary="tell the client to use SSD">+        Tell the client to use server side decoration and not draw any client+        side decorations.++        This request will have no effect if the client only supports client side+        decoration, see the decoration_hint event.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <enum name="edges" bitfield="true">+      <entry name="none" value="0"/>+      <entry name="top" value="1"/>+      <entry name="bottom" value="2"/>+      <entry name="left" value="4"/>+      <entry name="right" value="8"/>+    </enum>++    <request name="set_borders">+      <description summary="set window borders">+        This request decorates the window with borders drawn by the compositor+        on the specified edges of the window. Borders are drawn above the window+        content.++        Corners are drawn only between borders on adjacent edges. If e.g. the+        left edge has a border and the top edge does not, the border drawn on+        the left edge will not extend vertically beyond the top edge of the+        window.++        Borders are not drawn while the window is fullscreen.++        The color is defined by four 32-bit RGBA values. Unless specified in+        another protocol extension, the RGBA values use pre-multiplied alpha.++        Setting the edges to none or the width to 0 disables the borders.+        Setting a negative width is a protocol error.++        This request completely overrides all previous set_borders requests.+        Only the most recent set_borders request has an effect.++        Note that the position/dimensions of a river_window_v1 refer to the+        position/dimensions of the window content and are unaffected by the+        presence of borders or decoration surfaces.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="edges" type="uint" enum="edges" summary="border edges"/>+      <arg name="width" type="int" summary="border width"/>+      <arg name="r" type="uint" summary="32-bit red value"/>+      <arg name="g" type="uint" summary="32-bit green value"/>+      <arg name="b" type="uint" summary="32-bit blue value"/>+      <arg name="a" type="uint" summary="32-bit alpha value"/>+    </request>++    <request name="set_tiled">+      <description summary="set window tiled state">+        Inform the window that it is part of a tiled layout and adjacent to+        other elements in the tiled layout on the given edges.++        The window should use this information to change the style of its client+        side decorations and avoid drawing e.g. drop shadows outside of the+        window dimensions on the tiled edges.++        Setting the edges argument to none informs the window that it is not+        part of a tiled layout. If this request is never made, the window is+        informed that it is not part of a tiled layout.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="edges" type="uint" enum="edges" summary="tiled edges"/>+    </request>++    <request name="get_decoration_above">+      <description summary="create a decoration above the window in z-order">+        Create a decoration surface and assign the river_decoration_v1 role to+        the surface. The created decoration is placed above the window in+        rendering order, see the description of river_decoration_v1.++        Providing a wl_surface which already has a role or already has a buffer+        attached or committed is a protocol error.+      </description>+      <arg name="id" type="new_id" interface="river_decoration_v1"+        summary="new decoration surface"/>+      <arg name="surface" type="object" interface="wl_surface"+        summary="base surface"/>+    </request>++    <request name="get_decoration_below">+      <description summary="create a decoration below the window in z-order">+        Create a decoration surface and assign the river_decoration_v1 role to+        the surface. The created decoration is placed below the window in+        rendering order, see the description of river_decoration_v1.++        Providing a wl_surface which already has a role or already has a buffer+        attached or committed is a protocol error.+      </description>+      <arg name="id" type="new_id" interface="river_decoration_v1"+        summary="new decoration surface"/>+      <arg name="surface" type="object" interface="wl_surface"+        summary="base surface"/>+    </request>++    <event name="pointer_move_requested">+      <description summary="window requested interactive pointer move">+        This event informs the window manager that the window has requested to+        be interactively moved using the pointer. The seat argument indicates the+        seat for the move.++        The xdg-shell protocol for example allows windows to request that an+        interactive move be started, perhaps when a client-side rendered+        titlebar is dragged.++        The window manager may use the river_seat_v1.op_start_pointer request to+        interactively move the window or ignore this event entirely.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="seat" type="object" interface="river_seat_v1"+        summary="requested seat"/>+    </event>++    <event name="pointer_resize_requested">+      <description summary="window requested interactive pointer resize">+        This event informs the window manager that the window has requested to+        be interactively resized using the pointer. The seat argument indicates+        the seat for the resize.++        The edges argument indicates which edges the window has requested to be+        resized from. The edges argument will never be none and will never have+        both top and bottom or both left and right edges set.++        The xdg-shell protocol for example allows windows to request that an+        interactive resize be started, perhaps when the corner of client-side+        rendered decorations is dragged.++        The window manager may use the river_seat_v1.op_start_pointer request to+        interactively resize the window or ignore this event entirely.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="seat" type="object" interface="river_seat_v1"+        summary="requested seat"/>+      <arg name="edges" type="uint" enum="edges"+        summary="requested edges"/>+    </event>++    <request name="inform_resize_start">+      <description summary="inform the window it is being resized">+        Inform the window that it is being resized. The window manager should+        use this request to inform windows that are the target of an interactive+        resize for example.++        The window manager remains responsible for handling the position and+        dimensions of the window while it is resizing.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="inform_resize_end">+      <description summary="inform the window it no longer being resized">+        Inform the window that it is no longer being resized. The window manager+        should use this request to inform windows that are the target of an+        interactive resize that the interactive resize has ended for example.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <enum name="capabilities" bitfield="true">+      <entry name="window_menu" value="1"/>+      <entry name="maximize" value="2"/>+      <entry name="fullscreen" value="4"/>+      <entry name="minimize" value="8"/>+    </enum>++    <request name="set_capabilities">+      <description summary="inform window of supported capabilities">+        This request informs the window of the capabilities supported by the+        window manager. If the window manager, for example, ignores requests to+        be maximized from the window it should not tell the window that it+        supports the maximize capability.++        The window might use this information to, for example, only show a+        maximize button if the window manager supports the maximize capability.++        The window manager client should use this request to set capabilities+        for all new windows. If this request is never made, the compositor will+        inform windows that all capabilities are supported.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="caps" type="uint" enum="capabilities"+        summary="supported capabilities"/>+    </request>++    <event name="show_window_menu_requested">+      <description summary="window requested that the window menu be shown">+        The xdg-shell protocol for example allows windows to request that a+        window menu be shown, for example when the user right clicks on client+        side window decorations.++        A window menu might include options to maximize or minimize the window.++        The window manager is free to ignore this request and decide what the+        window menu contains if it does choose to show one.++        The x and y arguments indicate where the window requested that the+        window menu be shown.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="x" type="int" summary="x offset from top left corner"/>+      <arg name="y" type="int" summary="y offset from top left corner"/>+    </event>++    <event name="maximize_requested">+      <description summary="the window requested to be maximized">+        The xdg-shell protocol for example allows windows to request to be+        maximized.++        The window manager is free to honor this request using+        river_window_v1.inform_maximize or ignore it.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="unmaximize_requested">+      <description summary="the window requested to be unmaximized">+        The xdg-shell protocol for example allows windows to request to be+        unmaximized.++        The window manager is free to honor this request using+        river_window_v1.inform_unmaximized or ignore it.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <request name="inform_maximized">+      <description summary="inform the window that it is maximized">+        Inform the window that it is maximized. The window might use this+        information to adapt the style of its client-side window decorations for+        example.++        The window manager remains responsible for handling the position and+        dimensions of the window while it is maximized.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="inform_unmaximized">+      <description summary="inform the window that it is unmaximized">+        Inform the window that it is unmaximized. The window might use this+        information to adapt the style of its client-side window decorations for+        example.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="fullscreen_requested">+      <description summary="the window requested to be fullscreen">+        The xdg-shell protocol for example allows windows to request that they+        be made fullscreen and allows them to provide an optional output hint.++        If the output argument is null, the window has no preference and the+        window manager should choose an output.++        The window manager is free to honor this request using+        river_window_v1.fullscreen or ignore it.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="output" type="object" allow-null="true"+        interface="river_output_v1" summary="fullscreen output requested"/>+    </event>++    <event name="exit_fullscreen_requested">+      <description summary="the window requested to exit fullscreen">+        The xdg-shell protocol for example allows windows to request to exit+        fullscreen.++        The window manager is free to honor this request using+        river_window_v1.exit_fullscreen or ignore it.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <request name="inform_fullscreen">+      <description summary="inform the window that it is fullscreen">+        Inform the window that it is fullscreen. The window might use this+        information to adapt the style of its client-side window decorations for+        example.++        This request does not affect the size/position of the window or cause it+        to become the only window rendered, see the river_window_v1.fullscreen+        and exit_fullscreen requests for that.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="inform_not_fullscreen">+      <description summary="inform the window that it is not fullscreen">+        Inform the window that it is not fullscreen. The window might use this+        information to adapt the style of its client-side window decorations for+        example.++        This request does not affect the size/position of the window or cause it+        to become the only window rendered, see the river_window_v1.fullscreen+        and exit_fullscreen requests for that.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="fullscreen">+      <description summary="make the window fullscreen">+        Make the window fullscreen on the given output. If multiple windows are+        fullscreen on the same output at the same time only the "top" window in+        rendering order shall be displayed.++        All river_shell_surface_v1 objects above the top fullscreen window in+        the rendering order will continue to be rendered.++        The compositor will handle the position and dimensions of the window+        while it is fullscreen. The set_position and propose_dimensions requests+        shall not affect the current position and dimensions of a fullscreen+        window.++        When a fullscreen request is made, the server must send a dimensions+        event in response as soon as possible. It may not be possible to send a+        dimensions event in the very next render sequence if, for example, the+        window takes too long to respond. In this case, the server will send the+        dimensions event in a future render sequence.++        The compositor will clip window content, decoration surfaces, and+        borders to the given output's dimensions while the window is fullscreen.+        The effects of set_clip_box and set_content_clip_box are ignored while+        the window is fullscreen.++        If the output on which a window is currently fullscreen is removed, the+        windowing state is modified as if there were an exit_fullscreen request+        made in the same manage sequence as the river_output_v1.removed event.++        This request does not inform the window that it is fullscreen, see the+        river_window_v1.inform_fullscreen and inform_not_fullscreen requests.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="output" type="object" interface="river_output_v1"+        summary="fullscreen output"/>+    </request>++    <request name="exit_fullscreen">+      <description summary="make the window not fullscreen">+        Make the window not fullscreen.++        The position and dimensions are undefined after this request is made+        until a manage sequence in which the window manager makes the+        propose_dimensions and set_position requests is completed.++        The window manager should make propose_dimensions and set_position+        requests in the same manage sequence as the exit_fullscreen request for+        frame perfection.++        This request does not inform the window that it is fullscreen, see the+        river_window_v1.inform_fullscreen and inform_not_fullscreen requests.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="minimize_requested">+      <description summary="the window requested to be minimized">+        The xdg-shell protocol for example allows windows to request to be+        minimized.++        The window manager is free to ignore this request, hide the window, or+        do whatever else it chooses.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <request name="set_clip_box" since="2">+      <description summary="clip the window to a given box">+        Clip the window, including borders and decoration surfaces, to the box+        specified by the x, y, width, and height arguments. The x/y position of+        the box is relative to the top left corner of the window.++        The width and height arguments must be greater than or equal to 0.++        Setting a clip box with 0 width or height disables clipping.++        The clip box is ignored while the window is fullscreen.++        Both set_clip_box and set_content_clip_box may be enabled simultaneously.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="x" type="int" summary="x relative to top left window corner"/>+      <arg name="y" type="int" summary="y relative to top left window corner"/>+      <arg name="width" type="int" summary="clip box width"/>+      <arg name="height" type="int" summary="clip box height"/>+    </request>++    <event name="unreliable_pid" since="2">+      <description summary="unreliable PID of the window's creator">+        This event gives an unreliable PID of the process that created the+        window. Obtaining this information is inherently racy due to PID reuse.+        Therefore, this PID must not be used for anything security sensitive.++        Note also that a single process may create multiple windows, so there is+        not necessarily a 1-to-1 mapping from PID to window. Multiple windows+        may have the same PID.++        This event is sent once when the river_window_v1 is created and never+        sent again.+      </description>+      <arg name="unreliable_pid" type="int" summary="unreliable PID"/>+    </event>++    <request name="set_content_clip_box" since="3">+      <description summary="clip the window content to a given box">+        Clip the content of the window, excluding borders and decoration+        surfaces, to the box specified by the x, y, width, and height arguments.+        The x/y position of the box is relative to the top left corner of the+        window.++        Borders drawn by the compositor (see set_borders) are placed around the+        intersection of the window content (as defined by the dimensions event)+        and the content clip box when content clipping is enabled.++        The width and height arguments must be greater than or equal to 0.++        Setting a box with 0 width or height disables content clipping.++        The content clip box is ignored while the window is fullscreen.++        Both set_clip_box and set_content_clip_box may be enabled simultaneously.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="x" type="int" summary="x relative to top left window corner"/>+      <arg name="y" type="int" summary="y relative to top left window corner"/>+      <arg name="width" type="int" summary="clip box width"/>+      <arg name="height" type="int" summary="clip box height"/>+    </request>++    <event name="presentation_hint" since="4">+      <description summary="presentation hint set by the window">+        This event communicates the window's preferred presentation mode.++        This event will be followed by a render_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="hint" type="uint" enum="river_output_v1.presentation_mode"+        summary="presentation hint"/>+    </event>++    <event name="identifier" since="4">+      <description summary="unique window identifier">+        The identifier is a string that contains up to 32 printable ASCII bytes.+        The identifier must not be an empty string.++        It is compositor policy how the identifier is generated, but the following+        properties must be upheld:++        1. The identifier must uniquely identify the window. Two windows must not+           share the same identifier.++        2. The identifier must not be reused. This avoids races around window+           creation/destruction when identifiers are used in out-of-band IPC.++        If the compositor implements the ext-foreign-toplevel-list-v1 protocol,+        the river_window_v1.identifier event must match the corresponding+        ext_foreign_toplevel_handle_v1.identifier event.++        This event is sent once when the river_window_v1 is created and never+        sent again.+      </description>+      <arg name="identifier" type="string" summary="unique identifier"/>+    </event>++    <request name="set_dimension_bounds" since="4">+      <description summary="recommend maximum dimensions to the window">+        Recommend that the window keep its dimensions within a given+        maximum width/height. This recommendation is only a hint and the window+        may ignore it.++        Setting the width and height to 0 indicates that there are no bounds+        and is equivalent to having never made this request.++        Setting width or height to a negative value is a protocol error.++        The server should communicate this hint to an xdg_toplevel window with+        the xdg_toplevel.configure_bounds event for example.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="max_width" type="int" summary="maximum width"/>+      <arg name="max_height" type="int" summary="maximum height"/>+    </request>+  </interface>++  <interface name="river_decoration_v1" version="4">+    <description summary="a window decoration">+      The rendering order of windows with decorations is follows:++      1. Decorations created with get_decoration_below at the bottom+      2. Window content+      3. Borders configured with river_window_v1.set_borders+      4. Decorations created with get_decoration_above at the top++      The relative ordering of decoration surfaces above/below a window is+      undefined by this protocol and left up to the compositor.+    </description>++    <enum name="error">+      <entry name="no_commit" value="0"+        summary="failed to commit the surface before the window manager commit"/>+    </enum>++    <request name="destroy" type="destructor">+      <description summary="destroy the decoration object">+        This request indicates that the client will no longer use the decoration+        object and that it may be safely destroyed.+      </description>+    </request>++    <request name="set_offset">+      <description summary="set offset from the window's top left corner">+        This request sets the offset of the decoration surface from the top left+        corner of the window.++        If this request is never sent, the x and y offsets are undefined by this+        protocol and left up to the compositor.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="x" type="int" summary="x relative to top left window corner"/>+      <arg name="y" type="int" summary="y relative to top left window corner"/>+    </request>++    <request name="sync_next_commit">+      <description summary="sync next commit with other rendering state">+        Synchronize application of the next wl_surface.commit request on the+        decoration surface with rest of the state atomically applied with the+        next river_window_manager_v1.render_finish request.++        The client must make a wl_surface.commit request on the decoration+        surface after this request and before the render_finish request, failure+        to do so is a protocol error.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>+  </interface>++  <interface name="river_shell_surface_v1" version="4">+    <description summary="a surface for window manager UI">+      The window manager might use a shell surface to display a status bar,+      background image, desktop notifications, launcher, desktop menu, or+      whatever else it wants.+    </description>++    <enum name="error">+      <entry name="node_exists" value="0"+        summary="shell surface already has a node object"/>+      <entry name="no_commit" value="1"+        summary="failed to commit the surface before the window manager commit"/>+    </enum>++    <request name="destroy" type="destructor">+      <description summary="destroy the shell surface object">+        This request indicates that the client will no longer use the shell+        surface object and that it may be safely destroyed.+      </description>+    </request>++    <request name="get_node">+      <description summary="get the shell surface's render list node">+        Get the node in the render list corresponding to the shell surface.++        It is a protocol error to make this request more than once for a single+        shell surface.+      </description>+      <arg name="id" type="new_id" interface="river_node_v1" summary="new node"/>+    </request>++    <request name="sync_next_commit">+      <description summary="sync next surface commit to window manager commit">+        Synchronize application of the next wl_surface.commit request on the+        shell surface with rest of the rendering state atomically applied with+        the next river_window_manager_v1.render_finish request.++        The client must make a wl_surface.commit request on the shell surface+        after this request and before the render_finish request, failure to do+        so is a protocol error.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>+  </interface>++  <interface name="river_node_v1" version="4">+    <description summary="a node in the render list">+      The render list is a list of nodes that determines the rendering order of+      the compositor. Nodes may correspond to windows or shell surfaces. The+      relative ordering of nodes may be changed with the place_above and+      place_below requests, changing the rendering order.++      The initial position of a node in the render list is undefined, the window+      manager client must use the place_above or place_below request to+      guarantee a specific rendering order.+    </description>++    <request name="destroy" type="destructor">+      <description summary="destroy the decoration object">+        This request indicates that the client will no longer use the node+        object and that it may be safely destroyed.+      </description>+    </request>++    <request name="set_position">+      <description summary="set absolute position of the node">+        Set the absolute position of the node in the compositor's logical+        coordinate space. The x and y coordinates may be positive or negative.++        Note that the position of a river_window_v1 refers to the position of+        the window content and is unaffected by the presence of borders or+        decoration surfaces.++        If this request is never sent, the position of the node is undefined by+        this protocol and left up to the compositor.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="x" type="int" summary="global x coordinate"/>+      <arg name="y" type="int" summary="global y coordinate"/>+    </request>++    <request name="place_top">+      <description summary="place node above all other nodes">+        This request places the node above all other nodes in the compositor's+        render list.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="place_bottom">+      <description summary="place node below all other nodes">+        This request places the node below all other nodes in the compositor's+        render list.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="place_above">+      <description summary="place node above another node">+        This request places the node directly above another node in the+        compositor's render list.++        Attempting to place a node above itself has no effect.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="other" type="object" interface="river_node_v1"+        summary="other node"/>+    </request>++    <request name="place_below">+      <description summary="place node below another node">+        This request places the node directly below another node in the+        compositor's render list.++        Attempting to place a node below itself has no effect.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="other" type="object" interface="river_node_v1"+        summary="other node"/>+    </request>+  </interface>++  <interface name="river_output_v1" version="4">+    <description summary="a logical output">+      An area in the compositor's logical coordinate space that should be+      treated as a single output for window management purposes. This area may+      correspond to a single physical output or multiple physical outputs in the+      case of mirroring or tiled monitors depending on the hardware and+      compositor configuration.+    </description>++    <request name="destroy" type="destructor">+      <description summary="destroy the output object">+        This request indicates that the client will no longer use the output+        object and that it may be safely destroyed.++        This request should be made after the river_output_v1.removed event is+        received to complete destruction of the output.+      </description>+    </request>++    <event name="removed">+      <description summary="the output is removed">+        This event indicates that the logical output is no longer conceptually+        part of window management space.++        The server will send no further events on this object and ignore any+        request (other than river_output_v1.destroy) made after this event is+        sent. The client should destroy this object with the+        river_output_v1.destroy request to free up resources.++        This event may be sent because a corresponding physical output has been+        physically unplugged or because some output configuration has changed.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="wl_output">+      <description summary="corresponding wl_output">+        The wl_output object corresponding to the river_output_v1. The argument+        is the global name of the wl_output advertised with wl_registry.global.++        It is guaranteed that the corresponding wl_output is advertised before+        this event is sent.++        This event is sent exactly once. The wl_output associated with a+        river_output_v1 cannot change. It is guaranteed that there is a 1-to-1+        mapping between wl_output and river_output_v1 objects.++        The global_remove event for the corresponding wl_output may be sent+        before the river_output_v1.remove event. This is due to the fact that+        river_output_v1 state changes are synced to the river window management+        manage sequence while changes to globals are not.++        Rationale: The window manager may need information provided by the+        wl_output interface such as the name/description. It also may need the+        wl_output object to start screencopy for example.+      </description>+      <arg name="name" type="uint" summary="name of the wl_output global"/>+    </event>++    <event name="position">+      <description summary="output position">+        This event indicates the position of the output in the compositor's+        logical coordinate space. The x and y coordinates may be positive or+        negative.++        This event is sent once when the river_output_v1 is created and again+        whenever the position changes.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.++        The server must guarantee that the position and dimensions events do not+        cause the areas of multiple logical outputs to overlap when the+        corresponding manage_start event is received.+      </description>+      <arg name="x" type="int" summary="global x coordinate"/>+      <arg name="y" type="int" summary="global y coordinate"/>+    </event>++    <event name="dimensions">+      <description summary="output dimensions">+        This event indicates the dimensions of the output in the compositor's+        logical coordinate space. The width and height will always be strictly+        greater than zero.++        This event is sent once when the river_output_v1 is created and again+        whenever the dimensions change.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.++        The server must guarantee that the position and dimensions events do not+        cause the areas of multiple logical outputs to overlap when the+        corresponding manage_start event is received.+      </description>+      <arg name="width" type="int" summary="output width"/>+      <arg name="height" type="int" summary="output height"/>+    </event>++    <enum name="error" since="4">+      <entry name="invalid_presentation_mode" value="0" since="4"+        summary="invalid presentation mode enum value"/>+    </enum>++    <enum name="presentation_mode" since="4">+      <entry name="vsync" value="0">+        <description summary="tearing-free presentation">+          Output page-flips should be synchronized to the vertical blanking+          period, eliminating tearing. This is the default presentation mode.+        </description>+      </entry>+      <entry name="async" value="1">+        <description summary="asynchronous presentation">+          Output page-flips should not be synchronized to the vertical blanking+          period, visual screen tearing may occur.+        </description>+      </entry>+    </enum>++    <request name="set_presentation_mode" since="4">+      <description summary="set the preferred presentation mode">+        Set the preferred presentation mode of the output. The compositor should+        always respect the preference of the window manager if possible. If this+        request is never made, the preferred presentation mode is vsync.++        This request modifies rendering state and may only be made as part of a+        render sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="mode" type="uint" enum="presentation_mode"+        summary="preferred presentation mode"/>+    </request>+  </interface>++  <interface name="river_seat_v1" version="4">+    <description summary="a window management seat">+      This object represents a single user's collection of input devices. It+      allows the window manager to route keyboard input to windows, get+      high-level information about pointer input, define pointer bindings, etc.++      For keyboard bindings, see the river-xkb-bindings-v1 protocol.++      Since version 4: The cursor surface/shape set by the window manager on the+      wl_pointer of this seat is used when no client has pointer focus, for+      example during a pointer operation. Since the window manager is allowed to+      set cursor surface/shape even when it does not have pointer focus, the+      compositor must ignore the serial argument of wl_pointer.set_cursor and+      wp_cursor_shape_device_v1.set_shape requests made by the window manager.++      The most recent cursor surface/shape set by the window manager is+      remembered by the compositor and restored whenever no client has pointer+      focus. If the window manager never sets a cursor surface/shape, the+      "default" shape is used.+    </description>++    <request name="destroy" type="destructor">+      <description summary="destroy the seat object">+        This request indicates that the client will no longer use the seat+        object and that it may be safely destroyed.++        This request should be made after the river_seat_v1.removed event is+        received to complete destruction of the seat.+      </description>+    </request>++    <event name="removed">+      <description summary="the seat is removed">+        This event indicates that seat is no longer in use and should be+        destroyed.++        The server will send no further events on this object and ignore any+        request (other than river_seat_v1.destroy) made after this event is+        sent.  The client should destroy this object with the+        river_seat_v1.destroy request to free up resources.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="wl_seat">+      <description summary="corresponding wl_seat">+        The wl_seat object corresponding to the river_seat_v1. The argument is+        the global name of the wl_seat advertised with wl_registry.global.++        It is guaranteed that the corresponding wl_seat is advertised before+        this event is sent.++        This event is sent exactly once. The wl_seat associated with a+        river_seat_v1 cannot change. It is guaranteed that there is a 1-to-1+        mapping between wl_seat and river_seat_v1 objects.++        The global_remove event for the corresponding wl_seat may be sent before+        the river_seat_v1.remove event. This is due to the fact that+        river_seat_v1 state changes are synced to the river window management+        manage sequence while changes to globals are not.++        Rationale: The window manager may want to trigger window management+        state changes based on normal input events received by its shell+        surfaces for example.+      </description>+      <arg name="name" type="uint" summary="name of the wl_seat global"/>+    </event>++    <request name="focus_window">+      <description summary="give keyboard focus to a window">+        Request that the compositor send keyboard input to the given window.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="window" type="object" interface="river_window_v1"+        summary="window to focus"/>+    </request>++    <request name="focus_shell_surface">+      <description summary="give keyboard focus to a shell_surface">+        Request that the compositor send keyboard input to the given shell+        surface.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="shell_surface" type="object" interface="river_shell_surface_v1"+        summary="shell surface to focus"/>+    </request>++    <request name="clear_focus">+      <description summary="clear keyboard focus">+        Request that the compositor not send keyboard input to any client.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="pointer_enter">+      <description summary="pointer entered a window">+        The seat's pointer entered the given window's area.++        The area of a window is defined to include the area defined by the+        window dimensions, borders configured using river_window_v1.set_borders,+        and the input regions of decoration surfaces. In particular, it does not+        include input regions of surfaces belonging to the window that extend+        outside the window dimensions.++        The pointer of a seat may only enter a single window at a time. When the+        pointer moves between windows, the pointer_leave event for the old+        window must be sent before the pointer_enter event for the new window.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="window" type="object" interface="river_window_v1"+        summary="window entered"/>+    </event>++    <event name="pointer_leave">+      <description summary="pointer left the entered window">+        The seat's pointer left the window for which pointer_enter was most+        recently sent. See pointer_enter for details.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <event name="window_interaction">+      <description summary="a window has been interacted with">+        A window has been interacted with beyond the pointer merely passing over+        it. This event might be sent due to a pointer button press or due to a+        touch/tablet tool interaction with the window.++        There are no guarantees regarding how this event is sent in relation to+        the pointer_enter and pointer_leave events as the interaction may use+        touch or tablet tool input.++        Rationale: this event gives window managers necessary information to+        determine when to send keyboard focus, raise a window that already has+        keyboard focus, etc. Rather than expose all pointer, touch, and tablet+        events to window managers, a policy over mechanism approach is taken.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="window" type="object" interface="river_window_v1"+        summary="window interacted with"/>+    </event>++    <event name="shell_surface_interaction">+      <description summary="a shell surface has been interacted with">+        A shell surface has been interacted with beyond the pointer merely+        passing over it. This event might be sent due to a pointer button press+        or due to a touch/tablet tool interaction with the shell_surface.++        There are no guarantees regarding how this event is sent in relation to+        the pointer_enter and pointer_leave events as the interaction may use+        touch or tablet tool input.++        Rationale: While the shell surface does receive all wl_pointer,+        wl_touch, etc. input events for the surface directly, these events do+        not necessarily trigger a manage sequence and therefore do not allow the+        window manager to update focus or perform other actions in response to+        the input in a race-free way.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="shell_surface" type="object" interface="river_shell_surface_v1"+        summary="shell surface interacted with"/>+    </event>++    <request name="op_start_pointer">+      <description summary="start an interactive pointer operation">+        Start an interactive pointer operation. During the operation, op_delta+        events will be sent based on pointer input.++        When all pointer buttons are released, the op_release event is sent.++        The pointer operation continues until the op_end request is made during+        a manage sequence and that manage sequence is finished.++        The window manager may use this operation to implement interactive+        move/resize of windows by setting the position of windows and proposing+        dimensions based off of the op_delta events.++        This request is ignored if an operation is already in progress.++        The compositor must ensure that no client has pointer focus from this+        seat during the pointer operation. This means that the window manager+        has control over the pointer's cursor surface/shape during the pointer+        operation. See the river_seat_v1 description.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="op_delta">+      <description summary="total cumulative motion since op start">+        This event indicates the total change in position since the start of the+        operation of the pointer/touch point/etc.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+      <arg name="dx" type="int" summary="total change in x"/>+      <arg name="dy" type="int" summary="total change in y"/>+    </event>++    <event name="op_release">+      <description summary="operation input has been released">+        The input driving the current interactive operation has been released.+        For a pointer op for example, all pointer buttons have been released.++        Depending on the op type, op_delta events may continue to be sent until+        the op is ended with the op_end request.++        This event is sent at most once during an interactive operation.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.+      </description>+    </event>++    <request name="op_end">+      <description summary="end an interactive operation">+        End an interactive operation.++        This request is ignored if there is no operation in progress.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <enum name="modifiers" bitfield="true">+      <description summary="a set of keyboard modifiers">+        This enum is used to describe the keyboard modifiers that must be held+        down to trigger a key binding or pointer binding.++        Note that river and wlroots use the values 2 and 16 for capslock and+        numlock internally. It doesn't make sense to use locked modifiers for+        bindings however so these values are not included in this enum.+      </description>+      <entry name="none" value="0"/>+      <entry name="shift" value="1"/>+      <entry name="ctrl" value="4"/>+      <entry name="mod1" value="8" summary="commonly called alt"/>+      <entry name="mod3" value="32"/>+      <entry name="mod4" value="64" summary="commonly called super or logo"/>+      <entry name="mod5" value="128"/>+    </enum>++    <request name="get_pointer_binding">+      <description summary="define a new pointer binding">+        Define a pointer binding in terms of a pointer button, keyboard+        modifiers, and other configurable properties.++        The button argument is a Linux input event code defined in the+        linux/input-event-codes.h header file (e.g. BTN_RIGHT).++        The new pointer binding is not enabled until initial configuration is+        completed and the enable request is made during a manage sequence.+      </description>+      <arg name="id" type="new_id" interface="river_pointer_binding_v1"+        summary="new pointer binding"/>+      <arg name="button" type="uint" summary="a Linux input event code"/>+      <arg name="modifiers" type="uint" enum="modifiers"+        summary="keyboard modifiers"/>+    </request>++    <request name="set_xcursor_theme" since="2">+      <description summary="set the xcursor theme for the seat">+        Set the XCursor theme for the seat. This theme is used for cursors+        rendered by the compositor, but not necessarily for cursors rendered by+        clients.++        Note: The window manager may also wish to set the XCURSOR_THEME and+        XCURSOR_SIZE environment variable for programs it starts.+      </description>+      <arg name="name" type="string" summary="xcursor theme name"/>+      <arg name="size" type="uint" summary="cursor size"/>+    </request>++    <event name="pointer_position" since="2">+      <description summary="The current position of the pointer">+        The current position of the pointer in the compositor's logical+        coordinate space.++        This state is special in that a change in pointer position alone must+        not cause the compositor to start a manage sequence.++        Assuming the seat has a pointer, this event must be sent in every manage+        sequence unless there is no change in x/y position since the last time this+        event was sent.+      </description>+      <arg name="x" type="int" summary="global x coordinate"/>+      <arg name="y" type="int" summary="global y coordinate"/>+    </event>++    <request name="pointer_warp" since="3">+      <description summary="warp the pointer to a given position">+        Warp the pointer to the given position in the compositor's logical+        coordinate space.++        If the given position is outside the bounds of all outputs, the pointer+        will be warped to the closest point inside an output instead.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+      <arg name="x" type="int" summary="global x coordinate"/>+      <arg name="y" type="int" summary="global y coordinate"/>+    </request>+  </interface>++  <interface name="river_pointer_binding_v1" version="4">+    <description summary="configure a pointer binding, receive trigger events">+      This object allows the window manager to configure a pointer binding and+      receive events when the binding is triggered.++      The new pointer binding is not enabled until the enable request is made+      during a manage sequence.++      Normally, all pointer button events are sent to the surface with pointer+      focus by the compositor. Pointer button events that trigger a pointer+      binding are not sent to the surface with pointer focus.++      If multiple pointer bindings would be triggered by a single physical+      pointer event on the compositor side, it is compositor policy which+      pointer binding(s) will receive press/release events or if all of the+      matched pointer bindings receive press/release events.+    </description>++    <request name="destroy" type="destructor">+      <description summary="destroy the pointer binding object">+        This request indicates that the client will no longer use the pointer+        binding object and that it may be safely destroyed.+      </description>+    </request>++    <request name="enable">+      <description summary="enable the pointer binding">+        This request should be made after all initial configuration has been+        completed and the window manager wishes the pointer binding to be able+        to be triggered.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <request name="disable">+      <description summary="disable the pointer binding">+        This request may be used to temporarily disable the pointer binding. It+        may be later re-enabled with the enable request.++        This request modifies window management state and may only be made as+        part of a manage sequence, see the river_window_manager_v1 description.+      </description>+    </request>++    <event name="pressed">+      <description summary="the bound pointer button has been pressed">+        This event indicates that the pointer button triggering the binding has+        been pressed.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.++        The compositor should wait for the manage sequence to complete before+        processing further input events. This allows the window manager client+        to, for example, modify key bindings and keyboard focus without racing+        against future input events. The window manager should of course respond+        as soon as possible as the capacity of the compositor to buffer incoming+        input events is finite.+      </description>+    </event>++    <event name="released">+      <description summary="the bound pointer button has been released">+        This event indicates that the pointer button triggering the binding has+        been released.++        Releasing the modifiers for the binding without releasing the pointer+        button does not trigger the release event. This event is sent when the+        pointer button is released, even if the modifiers have changed since the+        pressed event.++        This event will be followed by a manage_start event after all other new+        state has been sent by the server.++        The compositor should wait for the manage sequence to complete before+        processing further input events. This allows the window manager client+        to, for example, modify key bindings and keyboard focus without racing+        against future input events. The window manager should of course respond+        as soon as possible as the capacity of the compositor to buffer incoming+        input events is finite.+      </description>+    </event>+  </interface>+</protocol>
+ protocol/river/river-xkb-bindings-v1.xml view
@@ -0,0 +1,37 @@+<?xml version="1.0" encoding="UTF-8"?>+<protocol name="river-xkb-bindings-v1">+  <interface name="river_xkb_bindings_v1" version="2">+    <request name="destroy" type="destructor"/>+    <request name="get_xkb_binding">+      <arg name="seat" type="object" interface="river_seat_v1"/>+      <arg name="id" type="new_id" interface="river_xkb_binding_v1"/>+      <arg name="keysym" type="uint"/>+      <arg name="modifiers" type="uint"/>+    </request>+    <request name="get_seat">+      <arg name="id" type="new_id" interface="river_xkb_bindings_seat_v1"/>+      <arg name="seat" type="object" interface="river_seat_v1"/>+    </request>+  </interface>++  <interface name="river_xkb_binding_v1" version="2">+    <request name="destroy" type="destructor"/>+    <request name="set_layout_override">+      <arg name="layout" type="uint"/>+    </request>+    <request name="enable"/>+    <request name="disable"/>++    <event name="pressed"/>+    <event name="released"/>+    <event name="stop_repeat"/>+  </interface>++  <interface name="river_xkb_bindings_seat_v1" version="2">+    <request name="destroy" type="destructor"/>+    <request name="ensure_next_key_eaten"/>+    <request name="cancel_ensure_next_key_eaten"/>++    <event name="ate_unbound_key"/>+  </interface>+</protocol>
+ src/ControlMain.hs view
@@ -0,0 +1,37 @@+module Main where++import Control.Exception (bracketOnError, try)+import Network.Socket+import Network.Socket.ByteString qualified as NSB++main :: IO ()+main = do+  args <- getArgs+  case args of+    ["--socket", socketPath, "send", encoded] -> sendCommand socketPath encoded+    otherArgs -> die ("usage: ymonadctl --socket /path/to/ymonad.sock send '<command>'; got: " <> show otherArgs)++sendCommand :: FilePath -> String -> IO ()+sendCommand socketPath encoded = do+  result <-+    ( try+        ( bracketOnError+            (socket AF_UNIX Stream defaultProtocol)+            close+            ( \sock -> do+                connect sock (SockAddrUnix socketPath)+                NSB.sendAll sock (encodeUtf8 (toText encoded))+                close sock+            )+        ) ::+        IO (Either SomeException ())+    )+  case result of+    Left ex ->+      die+        ( "Failed to send command to YMonad control socket at "+            <> socketPath+            <> ": "+            <> displayException ex+        )+    Right () -> pass
+ src/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import YMonad.Launcher++main :: IO ()+main = launcherMain
+ src/YMonad.hs view
@@ -0,0 +1,35 @@+module YMonad (+  ymonad,+  def,+  defaultKeys,+  YAction (..),+  YConfig (..),+  Layout (..),+  Border (..),+  Resize (..),+  IncMasterN (..),+  ChangeLayout (..),+  CLR (..),+  TitleBarMode (..),+  Dimension (..),+  tall,+  full,+  mirror,+  spacingRaw,+  spacing,+  spacingWithEdge,+  smartSpacing,+  smartSpacingWithEdge,+  description,+  (|||),+  YPConfig (..),+  defaultYPConfig,+  module YMonad.Keys,+) where++import YMonad.Config+import YMonad.Core.Common (Dimension (..), TitleBarMode (..))+import YMonad.Core.Layout+import YMonad.Keys+import YMonad.Prompt (YPConfig (..), defaultYPConfig)+import YMonad.Run
+ src/YMonad/Backend/River.hs view
@@ -0,0 +1,15 @@+module YMonad.Backend.River+  ( module YMonad.Backend.River.Decode+  , module YMonad.Backend.River.Encode+  , module YMonad.Backend.River.Interpreter+  , module YMonad.Backend.River.Protocol+  , module YMonad.Backend.River.Translate+  , module YMonad.Backend.River.Types+  ) where++import YMonad.Backend.River.Decode+import YMonad.Backend.River.Encode+import YMonad.Backend.River.Interpreter+import YMonad.Backend.River.Protocol+import YMonad.Backend.River.Translate+import YMonad.Backend.River.Types
+ src/YMonad/Backend/River/Decode.hs view
@@ -0,0 +1,301 @@+{-# LANGUAGE OverloadedStrings #-}++module YMonad.Backend.River.Decode (+  decodeCallback,+  ingestBytes,+) where++import Data.ByteString qualified as BS+import Data.Map.Strict qualified as M+import Data.Text qualified as T++import YMonad.Backend.River.Types+import YMonad.Core+import YMonad.Protocol.Wayland.Types+import YMonad.Protocol.Wayland.Wire++decodeCallback :: RiverCallback -> Either BackendFault [YEvent]+decodeCallback cb = Right $ case cb of+  RiverViewCreated vid meta -> [EvViewMapped vid meta]+  RiverViewDestroyed vid -> [EvViewUnmapped vid]+  RiverOutputDiscovered oid info -> [EvOutputAdded oid info]+  RiverOutputLost oid -> [EvOutputRemoved oid]+  RiverSeatFocus mvid -> [EvFocusChanged mvid]+  RiverManageStart -> []+  RiverRenderStart -> []+  RiverUserCommand cmd -> [EvUserCommand cmd]+  RiverActionTriggered _ -> []+  RiverProtocolFault msg -> [EvBackendFault (BackendFault msg)]+  RiverTrace _msg -> []++ingestBytes :: RiverRuntime -> BS.ByteString -> Either BackendFault (RiverRuntime, [RiverCallback])+ingestBytes rt chunk = do+  let buffered = rrInboundBuffer rt <> chunk+  (frames, leftover) <- firstFault (decodeRawFrames buffered)+  processFrames (rt {rrInboundBuffer = leftover}) id frames+  where+    processFrames runtime callbacks [] = Right (runtime, callbacks [])+    processFrames runtime callbacks (frame : rest) = do+      (runtime', produced) <- processFrame runtime frame+      processFrames runtime' (callbacks . (produced ++)) rest++processFrame :: RiverRuntime -> RawFrame -> Either BackendFault (RiverRuntime, [RiverCallback])+processFrame rt frame = do+  ifaceName <- case M.lookup (rawObjectId frame) (rrObjectInterfaces rt) of+    Nothing -> Left (BackendFault ("Unknown Wayland object id: " <> tshow (rawObjectId frame)))+    Just name -> Right name+  spec <- case lookupEventByOpcode (rrProtocol rt) ifaceName (rawOpcode frame) of+    Nothing -> Left (BackendFault ("Unknown event opcode " <> tshow (rawOpcode frame) <> " for interface " <> ifaceName))+    Just found -> Right found+  args <- firstFault (decodeMessageArgs spec (rawPayload frame))+  interpretEvent rt frame ifaceName spec args++interpretEvent :: RiverRuntime -> RawFrame -> Text -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+interpretEvent rt frame ifaceName spec args+  | ifaceName == "wl_registry" && messageSpecName spec == "global" = handleRegistryGlobal rt args+  | ifaceName == "wl_display" && messageSpecName spec == "error" =+      Right (rt, [RiverProtocolFault ("wl_display.error: " <> T.intercalate ", " (map renderArg args))])+  | ifaceName == "wl_callback" = handleCallbackEvent rt (rawObjectId frame) spec args+  | ifaceName == "river_window_manager_v1" = handleManagerEvent rt spec args+  | ifaceName == "river_xkb_binding_v1" = handleXkbBindingEvent rt (rawObjectId frame) spec args+  | ifaceName == "river_window_v1" = handleWindowEvent rt (rawObjectId frame) spec args+  | ifaceName == "river_output_v1" = handleOutputEvent rt (rawObjectId frame) spec args+  | ifaceName == "river_seat_v1" = handleSeatEvent rt spec args+  | otherwise = Right (rt, [])++handleRegistryGlobal :: RiverRuntime -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleRegistryGlobal rt [ArgUintValue globalName, ArgStringValue (Just ifaceName), ArgUintValue version]+  | ifaceName == "river_window_manager_v1" =+      case rrManagerObject rt of+        Just _ -> Right (rt, [])+        Nothing ->+          let (managerId, rt1) = allocateObjectId rt+              bindMessage =+                WireMessage+                  { wireObjectId = rrRegistryObject rt1+                  , wireInterface = "wl_registry"+                  , wireMessageName = "bind"+                  , wireOpcode = 0+                  , wireArgs =+                      [ ArgUintValue globalName+                      , ArgStringValue (Just ifaceName)+                      , ArgUintValue version+                      , ArgNewIdValue managerId+                      ]+                  }+              rt2 =+                rt1+                  { rrManagerObject = Just managerId+                  , rrObjectInterfaces = M.insert managerId ifaceName (rrObjectInterfaces rt1)+                  , rrOutgoing = rrOutgoing rt1 ++ [bindMessage]+                  }+           in Right (rt2, [RiverTrace ("bound river_window_manager_v1 object " <> tshow managerId)])+  | ifaceName == "river_xkb_bindings_v1" =+      case rrXkbBindingsObject rt of+        Just _ -> Right (rt, [])+        Nothing ->+          let (bindingsId, rt1) = allocateObjectId rt+              bindMessage =+                WireMessage+                  { wireObjectId = rrRegistryObject rt1+                  , wireInterface = "wl_registry"+                  , wireMessageName = "bind"+                  , wireOpcode = 0+                  , wireArgs =+                      [ ArgUintValue globalName+                      , ArgStringValue (Just ifaceName)+                      , ArgUintValue version+                      , ArgNewIdValue bindingsId+                      ]+                  }+              rt2 =+                rt1+                  { rrXkbBindingsObject = Just bindingsId+                  , rrObjectInterfaces = M.insert bindingsId ifaceName (rrObjectInterfaces rt1)+                  , rrOutgoing = rrOutgoing rt1 ++ [bindMessage]+                  }+           in Right (rt2, [RiverTrace ("bound river_xkb_bindings_v1 object " <> tshow bindingsId)])+  | otherwise = Right (rt, [])+handleRegistryGlobal _ _ = Left (BackendFault "Malformed wl_registry.global payload")++handleCallbackEvent :: RiverRuntime -> Word32 -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleCallbackEvent rt objectId spec args = case messageSpecName spec of+  "done" -> case args of+    [ArgUintValue _callbackData]+      | Just objectId == rrStartupSyncObject rt ->+          let rt' =+                rt+                  { rrStartupSyncObject = Nothing+                  , rrRegistryReady = True+                  , rrObjectInterfaces = M.delete objectId (rrObjectInterfaces rt)+                  }+           in Right (rt', [RiverTrace "registry roundtrip complete"])+    [ArgUintValue _callbackData] -> Right (rt, [])+    unexpectedDoneArgs -> Left (BackendFault ("Malformed wl_callback.done payload: " <> tshow unexpectedDoneArgs))+  _otherCallbackEvent -> Right (rt, [])++handleManagerEvent :: RiverRuntime -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleManagerEvent rt spec args = case messageSpecName spec of+  "manage_start" -> Right (rt {rrPhase = RiverPhaseManage, rrManageDirtySent = False}, [RiverTrace "manage_start", RiverManageStart])+  "render_start" -> Right (rt {rrPhase = RiverPhaseRender}, [RiverTrace "render_start", RiverRenderStart])+  "window" -> case args of+    [ArgNewIdValue windowId] ->+      let vid = ViewId (fromIntegral windowId)+          (nodeId, rt1) = allocateObjectId rt+          getNode =+            WireMessage+              { wireObjectId = windowId+              , wireInterface = "river_window_v1"+              , wireMessageName = "get_node"+              , wireOpcode = opcodeOf rt1 "river_window_v1" "get_node"+              , wireArgs = [ArgNewIdValue nodeId]+              }+          handle = RiverViewHandle windowId (Just nodeId) "" "" Nothing+          rt2 =+            rt1+              { rrViews = M.insert vid handle (rrViews rt1)+              , rrViewsByObjectId = M.insert windowId vid (rrViewsByObjectId rt1)+              , rrObjectInterfaces = M.insert nodeId "river_node_v1" (M.insert windowId "river_window_v1" (rrObjectInterfaces rt1))+              , rrOutgoing = rrOutgoing rt1 ++ [getNode]+              }+          meta = ViewMeta "" "" False+       in Right (rt2, [RiverTrace ("manager announced window " <> tshow (unViewId vid) <> " (object " <> tshow windowId <> ")"), RiverViewCreated vid meta])+    unexpectedWindowArgs -> Left (BackendFault ("Malformed river_window_manager_v1.window payload: " <> tshow unexpectedWindowArgs))+  "output" -> case args of+    [ArgNewIdValue outputObj] ->+      let oid = OutputId (fromIntegral outputObj)+          handle = RiverOutputHandle outputObj Nothing Nothing+          rt' =+            rt+              { rrOutputs = M.insert oid handle (rrOutputs rt)+              , rrOutputsByObjectId = M.insert outputObj oid (rrOutputsByObjectId rt)+              , rrObjectInterfaces = M.insert outputObj "river_output_v1" (rrObjectInterfaces rt)+              }+       in Right (rt', [])+    unexpectedOutputArgs -> Left (BackendFault ("Malformed river_window_manager_v1.output payload: " <> tshow unexpectedOutputArgs))+  "seat" -> case args of+    [ArgNewIdValue seatObj] ->+      let seat = RiverSeatHandle seatObj+          rt' =+            rt+              { rrSeat = Just seat+              , rrObjectInterfaces = M.insert seatObj "river_seat_v1" (rrObjectInterfaces rt)+              }+       in Right (rt', [RiverTrace ("seat discovered: object " <> tshow seatObj)])+    unexpectedSeatArgs -> Left (BackendFault ("Malformed river_window_manager_v1.seat payload: " <> tshow unexpectedSeatArgs))+  "unavailable" -> Right (rt, [RiverProtocolFault "river window management unavailable"])+  _otherManagerEvent -> Right (rt, [])++handleXkbBindingEvent :: RiverRuntime -> Word32 -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleXkbBindingEvent rt objectId spec _args =+  case bindingActionForObject rt objectId of+    Nothing -> Right (rt, [])+    Just action -> case messageSpecName spec of+      "pressed" -> Right (rt, [RiverActionTriggered action])+      "released" -> Right (rt, [])+      "stop_repeat" -> Right (rt, [])+      _otherBindingEvent -> Right (rt, [])++handleWindowEvent :: RiverRuntime -> Word32 -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleWindowEvent rt objectId spec args = case M.lookup objectId (rrViewsByObjectId rt) of+  Nothing -> Right (rt, [])+  Just vid -> case messageSpecName spec of+    "closed" ->+      let rt' =+            rt+              { rrViews = M.delete vid (rrViews rt)+              , rrViewsByObjectId = M.delete objectId (rrViewsByObjectId rt)+              }+       in Right (rt', [RiverViewDestroyed vid])+    "title" -> case args of+      [ArgStringValue maybeTitle] ->+        let title = fromMaybe "" maybeTitle+         in Right (updateViewMeta rt vid (\h -> h {riverViewTitle = title}), [])+      unexpectedTitleArgs -> Left (BackendFault ("Malformed river_window_v1.title payload: " <> tshow unexpectedTitleArgs))+    "app_id" -> case args of+      [ArgStringValue maybeAppId] ->+        let appId = fromMaybe "" maybeAppId+         in Right (updateViewMeta rt vid (\h -> h {riverViewAppId = appId}), [])+      unexpectedAppIdArgs -> Left (BackendFault ("Malformed river_window_v1.app_id payload: " <> tshow unexpectedAppIdArgs))+    "dimensions" -> case args of+      [ArgIntValue w, ArgIntValue h] ->+        let size = Size (fromIntegral w) (fromIntegral h)+            rt' = updateViewMeta rt vid (\hnd -> hnd {riverViewDimensions = Just size})+         in Right (rt', [RiverTrace ("window " <> tshow (unViewId vid) <> " dimensions " <> tshow w <> "x" <> tshow h)])+      unexpectedDimensionsArgs -> Left (BackendFault ("Malformed river_window_v1.dimensions payload: " <> tshow unexpectedDimensionsArgs))+    _otherWindowEvent -> Right (rt, [])++handleOutputEvent :: RiverRuntime -> Word32 -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleOutputEvent rt objectId spec args = case M.lookup objectId (rrOutputsByObjectId rt) of+  Nothing -> Right (rt, [])+  Just oid -> case messageSpecName spec of+    "removed" ->+      let rt' =+            rt+              { rrOutputs = M.delete oid (rrOutputs rt)+              , rrOutputsByObjectId = M.delete objectId (rrOutputsByObjectId rt)+              }+       in Right (rt', [RiverOutputLost oid])+    "position" -> case args of+      [ArgIntValue x, ArgIntValue y] ->+        emitOutput rt oid (\h -> h {riverOutputPosition = Just (Point (fromIntegral x) (fromIntegral y))})+      unexpectedPositionArgs -> Left (BackendFault ("Malformed river_output_v1.position payload: " <> tshow unexpectedPositionArgs))+    "dimensions" -> case args of+      [ArgIntValue w, ArgIntValue h] ->+        emitOutput rt oid (\handle -> handle {riverOutputSize = Just (Size (fromIntegral w) (fromIntegral h))})+      unexpectedDimensionsArgs -> Left (BackendFault ("Malformed river_output_v1.dimensions payload: " <> tshow unexpectedDimensionsArgs))+    _otherOutputEvent -> Right (rt, [])++handleSeatEvent :: RiverRuntime -> MessageSpec -> [ArgValue] -> Either BackendFault (RiverRuntime, [RiverCallback])+handleSeatEvent rt spec args = case messageSpecName spec of+  "pointer_enter" -> Right (rt, [])+  "window_interaction" -> case args of+    [ArgObjectValue (Just windowObj)] ->+      let mVid = M.lookup windowObj (rrViewsByObjectId rt)+       in Right (rt, [RiverSeatFocus mVid])+    _unexpectedWindowInteractionArgs -> Right (rt, [])+  _otherSeatEvent -> Right (rt, [])++emitOutput :: RiverRuntime -> OutputId -> (RiverOutputHandle -> RiverOutputHandle) -> Either BackendFault (RiverRuntime, [RiverCallback])+emitOutput rt oid f = case M.lookup oid (rrOutputs rt) of+  Nothing -> Right (rt, [])+  Just handle ->+    let updated = f handle+        rt' = rt {rrOutputs = M.insert oid updated (rrOutputs rt)}+     in case (riverOutputPosition updated, riverOutputSize updated) of+          (Just point, Just size) ->+            let info =+                  OutputInfo+                    { outputName = "river-output-" <> tshow (unOutputId oid)+                    , outputRect = Rect (pointX point) (pointY point) (sizeWidth size) (sizeHeight size)+                    }+             in Right (rt', [RiverOutputDiscovered oid info])+          _incompleteOutputInfo -> Right (rt', [])++updateViewMeta :: RiverRuntime -> ViewId -> (RiverViewHandle -> RiverViewHandle) -> RiverRuntime+updateViewMeta rt vid f = case M.lookup vid (rrViews rt) of+  Nothing -> rt+  Just handle -> rt {rrViews = M.insert vid (f handle) (rrViews rt)}++opcodeOf :: RiverRuntime -> Text -> Text -> Word16+opcodeOf rt ifaceName msgName =+  maybe+    0+    messageSpecOpcode+    (lookupRequest (rrProtocol rt) ifaceName msgName)++firstFault :: Either String a -> Either BackendFault a+firstFault = either (Left . BackendFault . T.pack) Right++renderArg :: ArgValue -> Text+renderArg arg = case arg of+  ArgIntValue n -> tshow n+  ArgUintValue n -> tshow n+  ArgStringValue Nothing -> "<null>"+  ArgStringValue (Just txt) -> txt+  ArgObjectValue Nothing -> "object:null"+  ArgObjectValue (Just oid) -> "object:" <> tshow oid+  ArgNewIdValue oid -> "new_id:" <> tshow oid++tshow :: (Show a) => a -> Text+tshow = T.pack . show
+ src/YMonad/Backend/River/Encode.hs view
@@ -0,0 +1,13 @@+module YMonad.Backend.River.Encode+  ( flushOutgoingBytes+  ) where++import qualified Data.ByteString as BS++import YMonad.Backend.River.Types+import YMonad.Protocol.Wayland.Wire++flushOutgoingBytes :: RiverRuntime -> (RiverRuntime, BS.ByteString)+flushOutgoingBytes rt =+  let bytes = encodeWireBatch (rrOutgoing rt)+  in (rt { rrOutgoing = [] }, bytes)
+ src/YMonad/Backend/River/Interpreter.hs view
@@ -0,0 +1,64 @@+module YMonad.Backend.River.Interpreter (+  connectRiver,+  recvEventsIO,+  flushTransportIO,+) where++import Control.Exception (bracketOnError, try)+import Data.ByteString qualified as BS+import Network.Socket+import Network.Socket.ByteString qualified as NSB+import System.FilePath ((</>))++import YMonad.Backend.River.Decode+import YMonad.Backend.River.Encode+import YMonad.Backend.River.Translate+import YMonad.Backend.River.Types+import YMonad.Core++connectRiver :: Maybe FilePath -> IO (Either BackendFault Socket)+connectRiver explicitPath = do+  resolved <- resolveSocketPath explicitPath+  case resolved of+    Left err -> pure (Left err)+    Right path -> do+      result <- (try (bracketOnError (socket AF_UNIX Stream defaultProtocol) close (\sock -> connect sock (SockAddrUnix path) >> pure sock)) :: IO (Either SomeException Socket))+      pure $ case result of+        Left ex -> Left (BackendFault ("Failed to connect to Wayland socket " <> toText path <> ": " <> toText (displayException ex)))+        Right sock -> Right sock++recvEventsIO :: Socket -> RiverRuntime -> IO (Either BackendFault (RiverRuntime, [YEvent]))+recvEventsIO sock rt = do+  recvResult <- (try (NSB.recv sock 65535) :: IO (Either SomeException BS.ByteString))+  case recvResult of+    Left ex -> pure (Left (BackendFault ("Wayland recv failed: " <> toText (displayException ex))))+    Right chunk ->+      if BS.null chunk+        then pure (Left (BackendFault "Wayland socket closed by compositor"))+        else do+          pure $ do+            (rt', callbacks) <- ingestBytes rt chunk+            events <- fmap concat (mapM decodeCallback callbacks)+            pure (rt', events)++flushTransportIO :: Socket -> RiverRuntime -> IO (Either BackendFault RiverRuntime)+flushTransportIO sock rt0 = do+  let rt1 = pumpPending rt0+      (rt2, bytes) = flushOutgoingBytes rt1+  if BS.null bytes+    then pure (Right rt2)+    else do+      sendResult <- (try (NSB.sendAll sock bytes) :: IO (Either SomeException ()))+      pure $ case sendResult of+        Left ex -> Left (BackendFault ("Wayland send failed: " <> toText (displayException ex)))+        Right () -> Right rt2++resolveSocketPath :: Maybe FilePath -> IO (Either BackendFault FilePath)+resolveSocketPath (Just path) = pure (Right path)+resolveSocketPath Nothing = do+  display <- lookupEnv "WAYLAND_DISPLAY"+  runtimeDir <- lookupEnv "XDG_RUNTIME_DIR"+  pure $ case (display, runtimeDir) of+    (Just disp, Just dir) -> Right (dir </> disp)+    (Nothing, _) -> Left (BackendFault "WAYLAND_DISPLAY is not set")+    (_, Nothing) -> Left (BackendFault "XDG_RUNTIME_DIR is not set")
+ src/YMonad/Backend/River/Protocol.hs view
@@ -0,0 +1,17 @@+module YMonad.Backend.River.Protocol+  ( module YMonad.Backend.River.Decode+  , module YMonad.Backend.River.Encode+  , module YMonad.Backend.River.Translate+  , module YMonad.Backend.River.Types+  , module YMonad.Protocol.Wayland.Types+  , module YMonad.Protocol.Wayland.Wire+  , module YMonad.Protocol.Wayland.Xml+  ) where++import YMonad.Backend.River.Decode+import YMonad.Backend.River.Encode+import YMonad.Backend.River.Translate+import YMonad.Backend.River.Types+import YMonad.Protocol.Wayland.Types+import YMonad.Protocol.Wayland.Wire+import YMonad.Protocol.Wayland.Xml
+ src/YMonad/Backend/River/Translate.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}++module YMonad.Backend.River.Translate (+  stageRequests,+  pumpPending,+) where++import Data.Map.Strict qualified as M++import YMonad.Backend.River.Types+import YMonad.Core+import YMonad.Protocol.Wayland.Types++stageRequests :: RiverRuntime -> [BackendReq] -> RiverRuntime+stageRequests = foldl' stageRequest++stageRequest :: RiverRuntime -> BackendReq -> RiverRuntime+stageRequest rt req = case req of+  ReqShowView vid -> enqueueRender rt vid (\handle -> [mkWindowRequest rt handle "show" []])+  ReqHideView vid -> enqueueRender rt vid (\handle -> [mkWindowRequest rt handle "hide" []])+  ReqSetViewRect vid rect -> enqueueRender (enqueueManage rt vid manageMessages) vid renderMessages+    where+      manageMessages handle = [mkWindowRequest rt handle "propose_dimensions" [ArgIntValue (fromIntegral (rectWidth rect)), ArgIntValue (fromIntegral (rectHeight rect))]]+      renderMessages handle =+        [ mkNodeRequest rt handle "set_position" [ArgIntValue (fromIntegral (rectX rect)), ArgIntValue (fromIntegral (rectY rect))]+        , mkWindowRequest rt handle "show" []+        ]+  ReqSetViewStyle vid style -> enqueueRender (enqueueManage rt vid manageMessages) vid renderMessages+    where+      manageMessages handle =+        [ mkWindowRequest rt handle (case viewStyleTitleBarMode style of NoTitleBar -> "use_ssd"; ServerSideTitleBar -> "use_ssd") []+        ]+      renderMessages handle = [mkSetBordersRequest rt handle style]+  ReqFocusView Nothing -> case rrSeat rt of+    Nothing -> rt+    Just seat -> rt {rrPendingManage = rrPendingManage rt ++ [mkSeatRequest rt seat "clear_focus" []]}+  ReqFocusView (Just vid) ->+    enqueueManage+      rt+      vid+      ( \handle -> case rrSeat rt of+          Nothing -> []+          Just seat -> [mkSeatFocusWindow rt seat handle]+      )+  ReqCloseView vid -> enqueueManage rt vid (\handle -> [mkWindowRequest rt handle "close" []])+  ReqExitSession -> case rrManagerObject rt of+    Nothing -> rt+    Just managerId -> rt {rrOutgoing = rrOutgoing rt ++ [managerRequest rt managerId "exit_session" []]}+  ReqCommit -> rt++enqueueManage :: RiverRuntime -> ViewId -> (RiverViewHandle -> [WireMessage]) -> RiverRuntime+enqueueManage rt vid f = case M.lookup vid (rrViews rt) of+  Nothing -> rt+  Just handle -> rt {rrPendingManage = rrPendingManage rt ++ f handle}++enqueueRender :: RiverRuntime -> ViewId -> (RiverViewHandle -> [WireMessage]) -> RiverRuntime+enqueueRender rt vid f = case M.lookup vid (rrViews rt) of+  Nothing -> rt+  Just handle -> rt {rrPendingRender = rrPendingRender rt ++ f handle}++pumpPending :: RiverRuntime -> RiverRuntime+pumpPending rt = pumpRender (pumpManage rt)++pumpManage :: RiverRuntime -> RiverRuntime+pumpManage rt = case rrPhase rt of+  RiverPhaseManage ->+    let finish = maybe [] (\managerId -> [managerRequest rt managerId "manage_finish" []]) (rrManagerObject rt)+     in rt+          { rrOutgoing = rrOutgoing rt ++ rrPendingManage rt ++ finish+          , rrPendingManage = []+          , rrManageDirtySent = False+          , rrPhase = RiverPhaseIdle+          }+  _otherPhase+    | null (rrPendingManage rt) -> requestManageIfNeeded rt+    | otherwise -> requestManageIfNeeded rt++pumpRender :: RiverRuntime -> RiverRuntime+pumpRender rt = case rrPhase rt of+  RiverPhaseRender ->+    let finish = maybe [] (\managerId -> [managerRequest rt managerId "render_finish" []]) (rrManagerObject rt)+     in rt+          { rrOutgoing = rrOutgoing rt ++ rrPendingRender rt ++ finish+          , rrPendingRender = []+          , rrPhase = RiverPhaseIdle+          }+  _otherPhase -> rt++requestManageIfNeeded :: RiverRuntime -> RiverRuntime+requestManageIfNeeded rt+  | null (rrPendingManage rt) = rt+  | rrManageDirtySent rt = rt+  | otherwise = case rrManagerObject rt of+      Nothing -> rt+      Just managerId ->+        rt+          { rrOutgoing = rrOutgoing rt ++ [managerRequest rt managerId "manage_dirty" []]+          , rrManageDirtySent = True+          }++managerRequest :: RiverRuntime -> Word32 -> Text -> [ArgValue] -> WireMessage+managerRequest rt managerId name args =+  WireMessage+    { wireObjectId = managerId+    , wireInterface = "river_window_manager_v1"+    , wireMessageName = name+    , wireOpcode = requestOpcode rt "river_window_manager_v1" name+    , wireArgs = args+    }++mkWindowRequest :: RiverRuntime -> RiverViewHandle -> Text -> [ArgValue] -> WireMessage+mkWindowRequest rt handle name args =+  WireMessage+    { wireObjectId = riverWindowObjectId handle+    , wireInterface = "river_window_v1"+    , wireMessageName = name+    , wireOpcode = requestOpcode rt "river_window_v1" name+    , wireArgs = args+    }++mkNodeRequest :: RiverRuntime -> RiverViewHandle -> Text -> [ArgValue] -> WireMessage+mkNodeRequest rt handle name args =+  WireMessage+    { wireObjectId = fromMaybe 0 (riverNodeObjectId handle)+    , wireInterface = "river_node_v1"+    , wireMessageName = name+    , wireOpcode = requestOpcode rt "river_node_v1" name+    , wireArgs = args+    }++mkSeatRequest :: RiverRuntime -> RiverSeatHandle -> Text -> [ArgValue] -> WireMessage+mkSeatRequest rt seat name args =+  WireMessage+    { wireObjectId = riverSeatObjectId seat+    , wireInterface = "river_seat_v1"+    , wireMessageName = name+    , wireOpcode = requestOpcode rt "river_seat_v1" name+    , wireArgs = args+    }++mkSeatFocusWindow :: RiverRuntime -> RiverSeatHandle -> RiverViewHandle -> WireMessage+mkSeatFocusWindow rt seat handle = mkSeatRequest rt seat "focus_window" [ArgObjectValue (Just (riverWindowObjectId handle))]++mkSetBordersRequest :: RiverRuntime -> RiverViewHandle -> ViewStyle -> WireMessage+mkSetBordersRequest rt handle style =+  mkWindowRequest+    rt+    handle+    "set_borders"+    [ ArgUintValue edges+    , ArgIntValue (fromIntegral width)+    , ArgUintValue (rgbaRed color)+    , ArgUintValue (rgbaGreen color)+    , ArgUintValue (rgbaBlue color)+    , ArgUintValue (rgbaAlpha color)+    ]+  where+    width = max 0 (unDimension (viewStyleBorderWidth style))+    edges = if width > 0 then allEdges else 0+    color = viewStyleBorderColor style++allEdges :: Word32+allEdges = 1 + 2 + 4 + 8++requestOpcode :: RiverRuntime -> Text -> Text -> Word16+requestOpcode rt ifaceName name = maybe 0 messageSpecOpcode (lookupRequest (rrProtocol rt) ifaceName name)
+ src/YMonad/Backend/River/Types.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE OverloadedStrings #-}++module YMonad.Backend.River.Types (+  RiverViewHandle (..),+  RiverOutputHandle (..),+  RiverSeatHandle (..),+  RiverPhase (..),+  RiverCallback (..),+  RiverConnection (..),+  RiverRuntime (..),+  bindingActionForObject,+  loadRiverRuntime,+  emptyRiverRuntime,+  allocateObjectId,+) where++import Data.ByteString qualified as BS+import Data.Map.Strict qualified as M+import Paths_ymonad (getDataFileName)++import YMonad.Config (YAction)+import YMonad.Core+import YMonad.Protocol.Wayland.Types+import YMonad.Protocol.Wayland.Xml++data RiverViewHandle = RiverViewHandle+  { riverWindowObjectId :: Word32+  , riverNodeObjectId :: Maybe Word32+  , riverViewTitle :: Text+  , riverViewAppId :: Text+  , riverViewDimensions :: Maybe Size+  }+  deriving stock (Eq, Ord, Show)++data RiverOutputHandle = RiverOutputHandle+  { riverOutputObjectId :: Word32+  , riverOutputPosition :: Maybe Point+  , riverOutputSize :: Maybe Size+  }+  deriving stock (Eq, Ord, Show)++newtype RiverSeatHandle = RiverSeatHandle+  { riverSeatObjectId :: Word32+  }+  deriving stock (Eq, Ord, Show)++data RiverPhase+  = RiverPhaseIdle+  | RiverPhaseManage+  | RiverPhaseRender+  deriving stock (Eq, Ord, Show)++data RiverCallback+  = RiverViewCreated ViewId ViewMeta+  | RiverViewDestroyed ViewId+  | RiverOutputDiscovered OutputId OutputInfo+  | RiverOutputLost OutputId+  | RiverSeatFocus (Maybe ViewId)+  | RiverManageStart+  | RiverRenderStart+  | RiverUserCommand UserCommand+  | RiverActionTriggered YAction+  | RiverProtocolFault Text+  | RiverTrace Text+  deriving stock (Eq, Ord, Show)++newtype RiverConnection = RiverConnection+  { riverSocketPath :: FilePath+  }+  deriving stock (Eq, Ord, Show)++data RiverRuntime = RiverRuntime+  { rrProtocol :: ProtocolSpec+  , rrDisplayObject :: Word32+  , rrRegistryObject :: Word32+  , rrManagerObject :: Maybe Word32+  , rrXkbBindingsObject :: Maybe Word32+  , rrStartupSyncObject :: Maybe Word32+  , rrRegistryReady :: Bool+  , rrSeat :: Maybe RiverSeatHandle+  , rrBindingActions :: Map Word32 YAction+  , rrBindingsInstalled :: Bool+  , rrViews :: Map ViewId RiverViewHandle+  , rrViewsByObjectId :: Map Word32 ViewId+  , rrOutputs :: Map OutputId RiverOutputHandle+  , rrOutputsByObjectId :: Map Word32 OutputId+  , rrObjectInterfaces :: Map Word32 Text+  , rrPendingManage :: [WireMessage]+  , rrPendingRender :: [WireMessage]+  , rrOutgoing :: [WireMessage]+  , rrInboundBuffer :: BS.ByteString+  , rrNextObjectId :: Word32+  , rrPhase :: RiverPhase+  , rrManageDirtySent :: Bool+  }+  deriving stock (Eq, Show)++loadRiverRuntime :: IO (Either String RiverRuntime)+loadRiverRuntime = do+  windowPath <- getDataFileName "protocol/river/river-window-management-v1.xml"+  xkbPath <- getDataFileName "protocol/river/river-xkb-bindings-v1.xml"+  windowSpecResult <- loadProtocolSpec windowPath+  xkbSpecResult <- loadProtocolSpec xkbPath+  pure $ do+    windowSpec <- windowSpecResult+    emptyRiverRuntime . mergeProtocolSpecs windowSpec <$> xkbSpecResult++emptyRiverRuntime :: ProtocolSpec -> RiverRuntime+emptyRiverRuntime riverSpec =+  let base = baseProtocolSpec+      merged = mergeProtocolSpecs base riverSpec+      registryMessage = bootstrapGetRegistry+   in RiverRuntime+        { rrProtocol = merged+        , rrDisplayObject = 1+        , rrRegistryObject = 2+        , rrManagerObject = Nothing+        , rrXkbBindingsObject = Nothing+        , rrStartupSyncObject = Just 3+        , rrRegistryReady = False+        , rrSeat = Nothing+        , rrBindingActions = M.empty+        , rrBindingsInstalled = False+        , rrViews = M.empty+        , rrViewsByObjectId = M.empty+        , rrOutputs = M.empty+        , rrOutputsByObjectId = M.empty+        , rrObjectInterfaces = M.fromList [(1, "wl_display"), (2, "wl_registry"), (3, "wl_callback")]+        , rrPendingManage = []+        , rrPendingRender = []+        , rrOutgoing = [registryMessage, bootstrapSync 3]+        , rrInboundBuffer = BS.empty+        , rrNextObjectId = 4+        , rrPhase = RiverPhaseIdle+        , rrManageDirtySent = False+        }++allocateObjectId :: RiverRuntime -> (Word32, RiverRuntime)+allocateObjectId rt = (rrNextObjectId rt, rt {rrNextObjectId = rrNextObjectId rt + 1})++baseProtocolSpec :: ProtocolSpec+baseProtocolSpec =+  ProtocolSpec+    { protocolName = "wayland-core"+    , protocolInterfaces =+        M.fromList+          [ (interfaceName wlDisplay, wlDisplay)+          , (interfaceName wlRegistry, wlRegistry)+          , (interfaceName wlCallback, wlCallback)+          ]+    }+  where+    wlDisplay =+      mkInterfaceSpec+        "wl_display"+        1+        [ MessageSpec "sync" 0 MessageRequest [ArgSpec "callback" (ArgNewId (Just "wl_callback")) False]+        , MessageSpec "get_registry" 1 MessageRequest [ArgSpec "registry" (ArgNewId (Just "wl_registry")) False]+        ]+        [ MessageSpec+            "error"+            0+            MessageEvent+            [ ArgSpec "object_id" (ArgObject Nothing) False+            , ArgSpec "code" ArgUint False+            , ArgSpec "message" ArgString False+            ]+        , MessageSpec "delete_id" 1 MessageEvent [ArgSpec "id" ArgUint False]+        ]+    wlRegistry =+      mkInterfaceSpec+        "wl_registry"+        1+        [ MessageSpec+            "bind"+            0+            MessageRequest+            [ ArgSpec "name" ArgUint False+            , ArgSpec "interface" ArgString False+            , ArgSpec "version" ArgUint False+            , ArgSpec "id" (ArgNewId Nothing) False+            ]+        ]+        [ MessageSpec+            "global"+            0+            MessageEvent+            [ ArgSpec "name" ArgUint False+            , ArgSpec "interface" ArgString False+            , ArgSpec "version" ArgUint False+            ]+        , MessageSpec "global_remove" 1 MessageEvent [ArgSpec "name" ArgUint False]+        ]+    wlCallback =+      mkInterfaceSpec+        "wl_callback"+        1+        []+        [ MessageSpec "done" 0 MessageEvent [ArgSpec "callback_data" ArgUint False]+        ]++bootstrapGetRegistry :: WireMessage+bootstrapGetRegistry =+  WireMessage+    { wireObjectId = 1+    , wireInterface = "wl_display"+    , wireMessageName = "get_registry"+    , wireOpcode = 1+    , wireArgs = [ArgNewIdValue 2]+    }++bootstrapSync :: Word32 -> WireMessage+bootstrapSync callbackId =+  WireMessage+    { wireObjectId = 1+    , wireInterface = "wl_display"+    , wireMessageName = "sync"+    , wireOpcode = 0+    , wireArgs = [ArgNewIdValue callbackId]+    }++bindingActionForObject :: RiverRuntime -> Word32 -> Maybe YAction+bindingActionForObject rt objectId = M.lookup objectId (rrBindingActions rt)
+ src/YMonad/Config.hs view
@@ -0,0 +1,95 @@+module YMonad.Config (+  YAction (..),+  YConfig (..),+  def,+  defaultKeys,+) where++import Data.Bits ((.|.))+import Data.Map.Strict qualified as M++import YMonad.Core.Common (Dimension (..), TitleBarMode (..))+import YMonad.Core.Layout (Layout, full, mirror, tall, (|||))+import YMonad.Keys+import YMonad.Prompt (YPConfig)++data YAction+  = Spawn String+  | ToggleFullscreen+  | ViewWorkspace String+  | MoveFocusedTo String+  | FocusNext+  | FocusPrev+  | SwapNext+  | SwapPrev+  | KillFocused+  | CycleLayout+  | ShrinkMaster+  | ExpandMaster+  | IncMasterNBy Int+  | ExitSession+  | RecompileRestart+  | ShellPrompt YPConfig+  | SafePrompt FilePath YPConfig+  | UnsafePrompt FilePath YPConfig+  | SshPrompt YPConfig+  | ManPrompt YPConfig+  deriving stock (Eq, Ord, Show)++data YConfig = YConfig+  { terminal :: String+  , modMask :: KeyMask+  , workspaces :: [String]+  , layoutHook :: Layout+  , borderWidth :: Dimension+  , normalBorderColor :: String+  , focusedBorderColor :: String+  , titleBarMode :: TitleBarMode+  , keys :: YConfig -> Map (KeyMask, KeySym) YAction+  }++def :: YConfig+def =+  YConfig+    { terminal = "foot"+    , modMask = mod1Mask+    , workspaces = map show [(1 :: Int) .. 9]+    , layoutHook = tall ||| mirror tall ||| full+    , borderWidth = 1+    , normalBorderColor = "#dddddd"+    , focusedBorderColor = "#ff0000"+    , titleBarMode = NoTitleBar+    , keys = defaultKeys+    }++defaultKeys :: YConfig -> Map (KeyMask, KeySym) YAction+defaultKeys conf =+  M.fromList (baseBindings ++ workspaceBindings)+  where+    modm = modMask conf+    baseBindings =+      [ ((modm .|. shiftMask, xK_Return), Spawn (terminal conf))+      , ((modm, xK_Return), ToggleFullscreen)+      , ((modm, xK_space), CycleLayout)+      , ((modm, xK_Tab), FocusPrev)+      , ((modm, xK_j), FocusPrev)+      , ((modm .|. shiftMask, xK_Tab), FocusNext)+      , ((modm, xK_ISO_Left_Tab), FocusNext)+      , ((modm .|. shiftMask, xK_ISO_Left_Tab), FocusNext)+      , ((modm, xK_k), FocusNext)+      , ((modm .|. shiftMask, xK_j), SwapPrev)+      , ((modm .|. shiftMask, xK_k), SwapNext)+      , ((modm, xK_h), ShrinkMaster)+      , ((modm, xK_l), ExpandMaster)+      , ((modm, xK_comma), IncMasterNBy 1)+      , ((modm, xK_period), IncMasterNBy (-1))+      , ((modm .|. shiftMask, xK_c), KillFocused)+      , ((modm, xK_q), ExitSession)+      , ((modm .|. shiftMask, xK_q), RecompileRestart)+      ]+    workspaceBindings = concatMap mkWorkspaceBinding (zip workspaceKeys (workspaces conf))+    mkWorkspaceBinding (key, workspaceName) =+      [ ((modm, key), ViewWorkspace workspaceName)+      , ((modm .|. shiftMask, key), MoveFocusedTo workspaceName)+      ]+    workspaceKeys = [xK_1, xK_2, xK_3, xK_4, xK_5, xK_6, xK_7, xK_8, xK_9]
+ src/YMonad/ControlCommand.hs view
@@ -0,0 +1,11 @@+module YMonad.ControlCommand (+  ControlCommand (..),+) where++import YMonad.Core (UserCommand)++data ControlCommand+  = ControlUserCommand UserCommand+  | ControlToggleFullscreen+  | ControlSpawn String+  deriving stock (Eq, Show, Read)
+ src/YMonad/Core.hs view
@@ -0,0 +1,13 @@+module YMonad.Core+  ( module YMonad.Core.Common+  , module YMonad.Core.Layout+  , module YMonad.Core.Reduce+  , module YMonad.Core.StackSet+  , module YMonad.Core.Types+  ) where++import YMonad.Core.Common+import YMonad.Core.Layout+import YMonad.Core.Reduce+import YMonad.Core.StackSet+import YMonad.Core.Types
+ src/YMonad/Core/Common.hs view
@@ -0,0 +1,130 @@+module YMonad.Core.Common (+  WorkspaceId (..),+  ScreenId (..),+  ViewId (..),+  OutputId (..),+  Point (..),+  Size (..),+  Rect (..),+  Dimension (..),+  RgbaColor (..),+  TitleBarMode (..),+  opaqueRgb8,+  parseColorString,+) where++import Data.Char qualified as Char+import Data.List qualified as List+import Data.Map.Strict qualified as M+import Data.Text qualified as T+import Numeric (readHex)++newtype WorkspaceId = WorkspaceId {unWorkspaceId :: Text}+  deriving stock (Eq, Ord, Show, Read)++newtype ScreenId = ScreenId {unScreenId :: Int}+  deriving stock (Eq, Ord, Show, Read)++newtype ViewId = ViewId {unViewId :: Int}+  deriving stock (Eq, Ord, Show, Read)++newtype OutputId = OutputId {unOutputId :: Int}+  deriving stock (Eq, Ord, Show, Read)++newtype Dimension = Dimension {unDimension :: Int}+  deriving stock (Eq, Ord, Show, Read)+  deriving newtype (Num)++data Point = Point+  { pointX :: Int+  , pointY :: Int+  }+  deriving stock (Eq, Ord, Show, Read)++data Size = Size+  { sizeWidth :: Int+  , sizeHeight :: Int+  }+  deriving stock (Eq, Ord, Show, Read)++data Rect = Rect+  { rectX :: Int+  , rectY :: Int+  , rectWidth :: Int+  , rectHeight :: Int+  }+  deriving stock (Eq, Ord, Show, Read)++data RgbaColor = RgbaColor+  { rgbaRed :: Word32+  , rgbaGreen :: Word32+  , rgbaBlue :: Word32+  , rgbaAlpha :: Word32+  }+  deriving stock (Eq, Ord, Show, Read)++data TitleBarMode+  = NoTitleBar+  | ServerSideTitleBar+  deriving stock (Eq, Ord, Show, Read)++opaqueRgb8 :: Word8 -> Word8 -> Word8 -> RgbaColor+opaqueRgb8 red green blue = rgbaFrom8Bit red green blue 255++parseColorString :: String -> Maybe RgbaColor+parseColorString raw =+  case List.stripPrefix "#" text of+    Just digits -> parseHexColor digits+    Nothing -> namedColor text+  where+    text = map Char.toLower raw++namedColor :: String -> Maybe RgbaColor+namedColor name = do+  (red, green, blue) <- M.lookup (T.pack name) namedPalette+  pure (opaqueRgb8 red green blue)++namedPalette :: Map Text (Word8, Word8, Word8)+namedPalette =+  M.fromList+    [ ("black", (0, 0, 0))+    , ("white", (255, 255, 255))+    , ("red", (255, 0, 0))+    , ("green", (0, 255, 0))+    , ("blue", (0, 0, 255))+    , ("gray", (128, 128, 128))+    , ("grey", (128, 128, 128))+    , ("yellow", (255, 255, 0))+    , ("magenta", (255, 0, 255))+    , ("cyan", (0, 255, 255))+    ]++parseHexColor :: String -> Maybe RgbaColor+parseHexColor digits =+  case digits of+    [r, g, b] -> rgbaFrom8Bit <$> dupHex r <*> dupHex g <*> dupHex b <*> pure 255+    [r, g, b, a] -> rgbaFrom8Bit <$> dupHex r <*> dupHex g <*> dupHex b <*> dupHex a+    [r1, r2, g1, g2, b1, b2] -> rgbaFrom8Bit <$> byte [r1, r2] <*> byte [g1, g2] <*> byte [b1, b2] <*> pure 255+    [r1, r2, g1, g2, b1, b2, a1, a2] -> rgbaFrom8Bit <$> byte [r1, r2] <*> byte [g1, g2] <*> byte [b1, b2] <*> byte [a1, a2]+    _other -> Nothing+  where+    dupHex ch = byte [ch, ch]+    byte chars = case readHex chars of+      [(value, "")] -> Just (fromIntegral (value :: Int))+      _ -> Nothing++rgbaFrom8Bit :: Word8 -> Word8 -> Word8 -> Word8 -> RgbaColor+rgbaFrom8Bit red green blue alpha =+  RgbaColor+    { rgbaRed = expand8Bit (premultiply red alpha)+    , rgbaGreen = expand8Bit (premultiply green alpha)+    , rgbaBlue = expand8Bit (premultiply blue alpha)+    , rgbaAlpha = expand8Bit alpha+    }++expand8Bit :: Word8 -> Word32+expand8Bit value = fromIntegral value * 0x01010101++premultiply :: Word8 -> Word8 -> Word8+premultiply channel alpha =+  fromIntegral (((fromIntegral channel :: Word32) * fromIntegral alpha + 127) `div` 255)
+ src/YMonad/Core/Layout.hs view
@@ -0,0 +1,301 @@+module YMonad.Core.Layout (+  Border (..),+  Layout (..),+  Resize (..),+  IncMasterN (..),+  ChangeLayout (..),+  CLR (..),+  LayoutMessage (..),+  tall,+  full,+  mirror,+  spacingRaw,+  spacing,+  spacingWithEdge,+  smartSpacing,+  smartSpacingWithEdge,+  (|||),+  description,+  applyLayoutMessage,+  layoutViews,+  mirrorRect,+  splitVertically,+  splitHorizontally,+  splitHorizontallyBy,+  splitVerticallyBy,+  tile,+) where++import Data.Ratio ((%))++import YMonad.Core.Common (Rect (..))+import YMonad.Core.StackSet (Stack (..), integrate)++data Border = Border+  { borderTop :: Int+  , borderBottom :: Int+  , borderRight :: Int+  , borderLeft :: Int+  }+  deriving stock (Eq, Ord, Show, Read)++data Resize = Shrink | Expand+  deriving stock (Eq, Ord, Show, Read)++newtype IncMasterN = IncMasterN Int+  deriving stock (Eq, Ord, Show, Read)++data ChangeLayout = FirstLayout | NextLayout+  deriving stock (Eq, Ord, Show, Read)++data CLR = CL | CR+  deriving stock (Eq, Ord, Show, Read)++data LayoutMessage+  = MsgResize Resize+  | MsgIncMasterN IncMasterN+  | MsgChangeLayout ChangeLayout+  | MsgJumpToLayout Text+  deriving stock (Eq, Ord, Show, Read)++data Layout+  = Full+  | Tall+      { tallNMaster :: Int+      , tallRatioIncrement :: Rational+      , tallRatio :: Rational+      }+  | Mirror Layout+  | Choose CLR Layout Layout+  | Spacing+      { spacingSmartBorder :: Bool+      , spacingScreenBorder :: Border+      , spacingScreenBorderEnabled :: Bool+      , spacingWindowBorder :: Border+      , spacingWindowBorderEnabled :: Bool+      , spacingInnerLayout :: Layout+      }+  deriving stock (Eq, Ord, Show, Read)++full :: Layout+full = Full++tall :: Layout+tall = Tall 1 (3 % 100) (1 % 2)++mirror :: Layout -> Layout+mirror = Mirror++spacingRaw :: Bool -> Border -> Bool -> Border -> Bool -> Layout -> Layout+spacingRaw = Spacing++spacing :: Int -> Layout -> Layout+spacing px = spacingRaw False zeroBorder False (uniformBorder px) True++spacingWithEdge :: Int -> Layout -> Layout+spacingWithEdge px = spacingRaw False (uniformBorder px) True (uniformBorder px) True++smartSpacing :: Int -> Layout -> Layout+smartSpacing px = spacingRaw True zeroBorder False (uniformBorder px) True++smartSpacingWithEdge :: Int -> Layout -> Layout+smartSpacingWithEdge px = spacingRaw True (uniformBorder px) True (uniformBorder px) True++(|||) :: Layout -> Layout -> Layout+(|||) = Choose CL+infixr 5 |||++description :: Layout -> Text+description layout = case layout of+  Full -> "Full"+  Tall {} -> "Tall"+  Mirror inner -> "Mirror " <> description inner+  Choose CL left _ -> description left+  Choose CR _ right -> description right+  Spacing {spacingInnerLayout = inner} -> description inner++applyLayoutMessage :: LayoutMessage -> Layout -> Layout+applyLayoutMessage message layout =+  case message of+    MsgResize resize -> applyResize resize layout+    MsgIncMasterN delta -> applyIncMaster delta layout+    MsgChangeLayout FirstLayout -> firstLayout layout+    MsgChangeLayout NextLayout -> nextLayout layout+    MsgJumpToLayout name -> fromMaybe layout (jumpToLayout name layout)++layoutViews :: Layout -> Rect -> Maybe (Stack a) -> [(a, Rect)]+layoutViews _ _ Nothing = []+layoutViews layout rect (Just stack) =+  case layout of+    Full -> [(stackFocus stack, rect)]+    Tall nmaster _ frac ->+      let windows = integrate stack+       in zip windows (tile frac rect nmaster (length windows))+    Mirror inner -> map (second mirrorRect) (layoutViews inner (mirrorRect rect) (Just stack))+    Choose CL left _ -> layoutViews left rect (Just stack)+    Choose CR _ right -> layoutViews right rect (Just stack)+    Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+      let windows = integrate stack+          applyBorders = not smart || length windows >= 2+          parentRect =+            if applyBorders && screenEnabled+              then insetRect screenBorder rect+              else rect+          childViews = layoutViews inner parentRect (Just stack)+       in if applyBorders && windowEnabled+            then map (second (insetRect windowBorder)) childViews+            else childViews++applyResize :: Resize -> Layout -> Layout+applyResize resize layout = case layout of+  Tall nmaster delta frac ->+    Tall nmaster delta (clampRatio (case resize of Shrink -> frac - delta; Expand -> frac + delta))+  Mirror inner -> Mirror (applyResize resize inner)+  Choose CL left right -> Choose CL (applyResize resize left) right+  Choose CR left right -> Choose CR left (applyResize resize right)+  Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+    Spacing smart screenBorder screenEnabled windowBorder windowEnabled (applyResize resize inner)+  Full -> Full++applyIncMaster :: IncMasterN -> Layout -> Layout+applyIncMaster (IncMasterN delta) layout = case layout of+  Tall nmaster ratioIncrement frac -> Tall (max 0 (nmaster + delta)) ratioIncrement frac+  Mirror inner -> Mirror (applyIncMaster (IncMasterN delta) inner)+  Choose CL left right -> Choose CL (applyIncMaster (IncMasterN delta) left) right+  Choose CR left right -> Choose CR left (applyIncMaster (IncMasterN delta) right)+  Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+    Spacing smart screenBorder screenEnabled windowBorder windowEnabled (applyIncMaster (IncMasterN delta) inner)+  Full -> Full++firstLayout :: Layout -> Layout+firstLayout layout = case layout of+  Choose _ left right -> Choose CL (firstLayout left) (firstLayout right)+  Mirror inner -> Mirror (firstLayout inner)+  Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+    Spacing smart screenBorder screenEnabled windowBorder windowEnabled (firstLayout inner)+  _ -> layout++nextLayout :: Layout -> Layout+nextLayout layout = fromMaybe (firstLayout layout) (nextLayoutNoWrap layout)++nextLayoutNoWrap :: Layout -> Maybe Layout+nextLayoutNoWrap layout = case layout of+  Full -> Nothing+  Tall {} -> Nothing+  Mirror inner -> Mirror <$> nextLayoutNoWrap inner+  Choose CL left right ->+    case nextLayoutNoWrap left of+      Just left' -> Just (Choose CL left' right)+      Nothing -> Just (Choose CR (firstLayout left) (firstLayout right))+  Choose CR left right ->+    Choose CR left <$> nextLayoutNoWrap right+  Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+    Spacing smart screenBorder screenEnabled windowBorder windowEnabled <$> nextLayoutNoWrap inner++jumpToLayout :: Text -> Layout -> Maybe Layout+jumpToLayout name layout+  | description layout == name = Just layout+  | otherwise =+      case layout of+        Mirror inner -> Mirror <$> jumpToLayout name inner+        Choose _ left right ->+          let left' = fromMaybe left (jumpToLayout name left)+              right' = fromMaybe right (jumpToLayout name right)+           in if description left' == name+                then Just (Choose CL left' right')+                else+                  if description right' == name+                    then Just (Choose CR left' right')+                    else Nothing+        Spacing smart screenBorder screenEnabled windowBorder windowEnabled inner ->+          Spacing smart screenBorder screenEnabled windowBorder windowEnabled <$> jumpToLayout name inner+        _ -> Nothing++clampRatio :: Rational -> Rational+clampRatio = max 0 . min 1++tile :: Rational -> Rect -> Int -> Int -> [Rect]+tile frac rect nmaster n+  | n <= 0 = []+  | n <= nmaster || nmaster == 0 = splitVertically n rect+  | otherwise = splitVertically nmaster masterRect ++ splitVertically (n - nmaster) stackRect+  where+    (masterRect, stackRect) = splitHorizontallyBy (clampRatio frac) rect++splitVertically :: Int -> Rect -> [Rect]+splitVertically n rect+  | n <= 0 = []+  | n < 2 = [rect]+  | otherwise = firstRect : splitVertically (n - 1) remainderRect+  where+    smallHeight = rectHeight rect `div` n+    firstRect =+      Rect+        { rectX = rectX rect+        , rectY = rectY rect+        , rectWidth = rectWidth rect+        , rectHeight = smallHeight+        }+    remainderRect =+      Rect+        { rectX = rectX rect+        , rectY = rectY rect + smallHeight+        , rectWidth = rectWidth rect+        , rectHeight = rectHeight rect - smallHeight+        }++splitHorizontally :: Int -> Rect -> [Rect]+splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect++splitHorizontallyBy :: Rational -> Rect -> (Rect, Rect)+splitHorizontallyBy frac rect =+  ( Rect+      { rectX = rectX rect+      , rectY = rectY rect+      , rectWidth = leftWidth+      , rectHeight = rectHeight rect+      }+  , Rect+      { rectX = rectX rect + leftWidth+      , rectY = rectY rect+      , rectWidth = rectWidth rect - leftWidth+      , rectHeight = rectHeight rect+      }+  )+  where+    leftWidth = floor (fromIntegral (rectWidth rect) * frac)++splitVerticallyBy :: Rational -> Rect -> (Rect, Rect)+splitVerticallyBy frac = both mirrorRect . splitHorizontallyBy frac . mirrorRect++mirrorRect :: Rect -> Rect+mirrorRect rect =+  Rect+    { rectX = rectY rect+    , rectY = rectX rect+    , rectWidth = rectHeight rect+    , rectHeight = rectWidth rect+    }++both :: (a -> b) -> (a, a) -> (b, b)+both f (x, y) = (f x, f y)++uniformBorder :: Int -> Border+uniformBorder px = Border px px px px++zeroBorder :: Border+zeroBorder = uniformBorder 0++insetRect :: Border -> Rect -> Rect+insetRect border rect =+  Rect+    { rectX = rectX rect + left+    , rectY = rectY rect + top+    , rectWidth = max 0 (rectWidth rect - left - right)+    , rectHeight = max 0 (rectHeight rect - top - bottom)+    }+  where+    top = max 0 (borderTop border)+    bottom = max 0 (borderBottom border)+    right = max 0 (borderRight border)+    left = max 0 (borderLeft border)
+ src/YMonad/Core/Reduce.hs view
@@ -0,0 +1,144 @@+module YMonad.Core.Reduce (+  reduce,+  relayoutRequests,+) where++import Data.List (partition)+import Data.Map.Strict qualified as M++import YMonad.Core.Layout+import YMonad.Core.StackSet+import YMonad.Core.Types++reduce :: RuntimeState -> YEvent -> Transition+reduce st ev = case ev of+  EvViewMapped vid meta ->+    let ws' = insertUp vid (rtWindowSet st)+        st' = st {rtWindowSet = ws', rtViews = M.insert vid meta (rtViews st)}+     in Transition st' (relayoutRequests st')+  EvViewUnmapped vid ->+    let ws' = delete vid (rtWindowSet st)+        st' = st {rtWindowSet = ws', rtViews = M.delete vid (rtViews st)}+     in Transition st' (ReqHideView vid : relayoutRequests st')+  EvOutputAdded oid info ->+    let currentScreen = current (rtWindowSet st)+        ws' =+          (rtWindowSet st)+            { current = currentScreen {screenRect = outputRect info}+            }+        st' = st {rtWindowSet = ws', rtOutputs = M.insert oid info (rtOutputs st)}+     in Transition st' (relayoutRequests st')+  EvOutputRemoved oid ->+    let st' = st {rtOutputs = M.delete oid (rtOutputs st)}+     in Transition st' []+  EvFocusChanged Nothing -> Transition st [ReqFocusView Nothing, ReqCommit]+  EvFocusChanged (Just vid) ->+    let ws' = focusWindow vid (rtWindowSet st)+        st' = st {rtWindowSet = ws'}+     in Transition st' (relayoutRequests st')+  EvUserCommand cmd -> reduceCommand st cmd+  EvBackendFault fault -> Transition (st {rtLastFault = Just fault}) []++reduceCommand :: RuntimeState -> UserCommand -> Transition+reduceCommand st cmd = case cmd of+  CmdFocusNext ->+    let st' = st {rtWindowSet = focusUp (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdFocusPrev ->+    let st' = st {rtWindowSet = focusDown (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdSwapNext ->+    let st' = st {rtWindowSet = swapUp (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdSwapPrev ->+    let st' = st {rtWindowSet = swapDown (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdKillFocused -> case peek (rtWindowSet st) of+    Nothing -> Transition st []+    Just vid -> Transition st [ReqCloseView vid, ReqCommit]+  CmdViewWorkspace wid ->+    let st' = st {rtWindowSet = view wid (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdMoveFocusedTo wid ->+    let st' = st {rtWindowSet = shift wid (rtWindowSet st)}+     in Transition st' (relayoutRequests st')+  CmdToggleFullscreen -> toggleCurrentWorkspaceFullscreen st+  CmdCycleLayout -> applyCurrentLayoutMessage (MsgChangeLayout NextLayout) st+  CmdShrink -> applyCurrentLayoutMessage (MsgResize Shrink) st+  CmdExpand -> applyCurrentLayoutMessage (MsgResize Expand) st+  CmdIncMasterN delta -> applyCurrentLayoutMessage (MsgIncMasterN (IncMasterN delta)) st+  CmdExitSession -> Transition st [ReqExitSession]++applyCurrentLayoutMessage :: LayoutMessage -> RuntimeState -> Transition+applyCurrentLayoutMessage message st =+  let ws' =+        modifyCurrentWorkspace+          ( \workspace ->+              let oldLayout = workspaceLayout workspace+                  newLayout = applyLayoutMessage message oldLayout+                  restoreLayout =+                    if description oldLayout == "Full" && description newLayout /= "Full"+                      then Nothing+                      else workspaceRestoreLayout workspace+               in workspace+                    { workspaceLayout = newLayout+                    , workspaceRestoreLayout = restoreLayout+                    }+          )+          (rtWindowSet st)+      st' = st {rtWindowSet = ws'}+   in Transition st' (relayoutRequests st')++relayoutRequests :: RuntimeState -> [BackendReq]+relayoutRequests st = map mkShow placementPairs ++ styleRequests ++ hideRequests ++ focusRequest ++ [ReqCommit]+  where+    currentScreen = current (rtWindowSet st)+    currentWorkspace = screenWorkspace currentScreen+    placements = layoutViews (workspaceLayout currentWorkspace) (screenRect currentScreen) (workspaceStack currentWorkspace)+    placementPairs = focusFirst focusedView placements+    active = map fst placementPairs+    hideRequests = [ReqHideView vid | vid <- M.keys (rtViews st), vid `notElem` active]+    focusRequest = case focusedView of+      Nothing -> [ReqFocusView Nothing]+      Just vid -> [ReqFocusView (Just vid)]+    styleRequests = map mkStyle active+    focusedView = peek (rtWindowSet st)+    theme = rtTheme st++    mkShow (vid, rect) = ReqSetViewRect vid rect+    mkStyle vid =+      ReqSetViewStyle+        vid+        ViewStyle+          { viewStyleTitleBarMode = themeTitleBarMode theme+          , viewStyleBorderWidth = themeBorderWidth theme+          , viewStyleBorderColor = if Just vid == focusedView then themeFocusedBorderColor theme else themeNormalBorderColor theme+          }++toggleCurrentWorkspaceFullscreen :: RuntimeState -> Transition+toggleCurrentWorkspaceFullscreen st =+  let ws' =+        modifyCurrentWorkspace+          ( \workspace ->+              let currentLayout = workspaceLayout workspace+               in if description currentLayout == "Full"+                    then+                      workspace+                        { workspaceLayout = fromMaybe currentLayout (workspaceRestoreLayout workspace)+                        , workspaceRestoreLayout = Nothing+                        }+                    else+                      workspace+                        { workspaceLayout = applyLayoutMessage (MsgJumpToLayout "Full") currentLayout+                        , workspaceRestoreLayout = Just currentLayout+                        }+          )+          (rtWindowSet st)+      st' = st {rtWindowSet = ws'}+   in Transition st' (relayoutRequests st')++focusFirst :: (Eq a) => Maybe a -> [(a, b)] -> [(a, b)]+focusFirst Nothing xs = xs+focusFirst (Just focused) xs = focusedPairs ++ otherPairs+  where+    (focusedPairs, otherPairs) = partition ((== focused) . fst) xs
+ src/YMonad/Core/StackSet.hs view
@@ -0,0 +1,230 @@+module YMonad.Core.StackSet (+  Stack (..),+  Workspace (..),+  Screen (..),+  WindowSet (..),+  emptyWorkspace,+  singleton,+  view,+  shift,+  focusWindow,+  insertUp,+  delete,+  focusUp,+  focusDown,+  swapUp,+  swapDown,+  peek,+  integrate,+  allWindows,+  modifyCurrentWorkspace,+) where++import Brolude (until)+import Data.Map.Strict qualified as M+import YMonad.Core.Common (Rect)++data Stack a = Stack+  { stackFocus :: a+  , stackUp :: [a]+  , stackDown :: [a]+  }+  deriving stock (Eq, Ord, Show)++data Workspace i l a = Workspace+  { workspaceId :: i+  , workspaceLayout :: l+  , workspaceStack :: Maybe (Stack a)+  , workspaceRestoreLayout :: Maybe l+  }+  deriving stock (Eq, Ord, Show)++data Screen sid i l a = Screen+  { screenWorkspace :: Workspace i l a+  , screenId :: sid+  , screenRect :: Rect+  }+  deriving stock (Eq, Ord, Show)++data WindowSet sid i l a = WindowSet+  { current :: Screen sid i l a+  , visible :: [Screen sid i l a]+  , hidden :: [Workspace i l a]+  , floating :: M.Map a Rect+  }+  deriving stock (Eq, Ord, Show)++emptyWorkspace :: i -> l -> Workspace i l a+emptyWorkspace wid lay =+  Workspace+    { workspaceId = wid+    , workspaceLayout = lay+    , workspaceStack = Nothing+    , workspaceRestoreLayout = Nothing+    }++singleton :: Screen sid i l a -> [Workspace i l a] -> WindowSet sid i l a+singleton scr hs =+  WindowSet+    { current = scr+    , visible = []+    , hidden = hs+    , floating = M.empty+    }++modifyCurrentWorkspace :: (Workspace i l a -> Workspace i l a) -> WindowSet sid i l a -> WindowSet sid i l a+modifyCurrentWorkspace f ws = ws {current = (current ws) {screenWorkspace = f (screenWorkspace (current ws))}}++withCurrentStack :: b -> (Stack a -> b) -> WindowSet sid i l a -> b+withCurrentStack dflt f = maybe dflt f . workspaceStack . screenWorkspace . current++modifyZ :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> WindowSet sid i l a -> WindowSet sid i l a+modifyZ dflt f ws =+  ws+    { current =+        (current ws)+          { screenWorkspace =+              (screenWorkspace (current ws))+                { workspaceStack = withCurrentStack dflt f ws+                }+          }+    }++modifyZ' :: (Stack a -> Stack a) -> WindowSet sid i l a -> WindowSet sid i l a+modifyZ' f = modifyZ Nothing (Just . f)++peek :: WindowSet sid i l a -> Maybe a+peek = withCurrentStack Nothing (Just . stackFocus)++integrate :: Stack a -> [a]+integrate st = reverse (stackUp st) ++ stackFocus st : stackDown st++allWindows :: WindowSet sid i l a -> [a]+allWindows ws = concatMap workspaceWindows (workspaces ws)+  where+    workspaceWindows wk = maybe [] integrate (workspaceStack wk)++workspaces :: WindowSet sid i l a -> [Workspace i l a]+workspaces ws = screenWorkspace (current ws) : map screenWorkspace (visible ws) ++ hidden ws++member :: (Eq a) => a -> WindowSet sid i l a -> Bool+member win ws = win `elem` allWindows ws++workspaceMember :: (Eq i) => i -> WindowSet sid i l a -> Bool+workspaceMember wid ws = wid `elem` map workspaceId (workspaces ws)++findWorkspaceIdOfWindow :: (Eq a) => a -> WindowSet sid i l a -> Maybe i+findWorkspaceIdOfWindow win ws = workspaceId <$> find containsWindow (workspaces ws)+  where+    containsWindow wk = maybe False (elem win . integrate) (workspaceStack wk)++view :: (Eq i) => i -> WindowSet sid i l a -> WindowSet sid i l a+view wid ws+  | workspaceId (screenWorkspace (current ws)) == wid = ws+  | otherwise =+      case break ((== wid) . workspaceId . screenWorkspace) (visible ws) of+        (before, target : after) ->+          ws+            { current = target+            , visible = current ws : before ++ after+            }+        (_, []) ->+          case break ((== wid) . workspaceId) (hidden ws) of+            (before, target : after) ->+              let oldCurrent = screenWorkspace (current ws)+               in ws+                    { current = (current ws) {screenWorkspace = target}+                    , hidden = before ++ [oldCurrent] ++ after+                    }+            (_, []) -> ws++insertUp :: (Eq a) => a -> WindowSet sid i l a -> WindowSet sid i l a+insertUp win ws+  | member win ws = ws+  | otherwise = modifyZ (Just (Stack win [] [])) (\(Stack focus up down) -> Just (Stack win up (focus : down))) ws++focusWindow :: (Eq a, Eq i) => a -> WindowSet sid i l a -> WindowSet sid i l a+focusWindow win ws+  | Just win == peek ws = ws+  | otherwise =+      fromMaybe ws $ do+        wid <- findWorkspaceIdOfWindow win ws+        pure $ until ((Just win ==) . peek) focusUp (view wid ws)++focusUp :: WindowSet sid i l a -> WindowSet sid i l a+focusUp = modifyZ' focusUpStack++focusDown :: WindowSet sid i l a -> WindowSet sid i l a+focusDown = modifyZ' focusDownStack++swapUp :: WindowSet sid i l a -> WindowSet sid i l a+swapUp = modifyZ' swapUpStack++swapDown :: WindowSet sid i l a -> WindowSet sid i l a+swapDown = modifyZ' swapDownStack++delete :: (Ord a) => a -> WindowSet sid i l a -> WindowSet sid i l a+delete win = sink win . delete' win++delete' :: (Eq a) => a -> WindowSet sid i l a -> WindowSet sid i l a+delete' win ws =+  ws+    { current = removeFromScreen (current ws)+    , visible = map removeFromScreen (visible ws)+    , hidden = map removeFromWorkspace (hidden ws)+    }+  where+    removeFromWorkspace wk = wk {workspaceStack = workspaceStack wk >>= filterStack (/= win)}+    removeFromScreen scr = scr {screenWorkspace = removeFromWorkspace (screenWorkspace scr)}++sink :: (Ord a) => a -> WindowSet sid i l a -> WindowSet sid i l a+sink win ws = ws {floating = M.delete win (floating ws)}++filterStack :: (a -> Bool) -> Stack a -> Maybe (Stack a)+filterStack p (Stack focus up down) =+  case filter p (focus : down) of+    focus' : down' -> Just (Stack focus' (filter p up) down')+    [] ->+      case filter p up of+        focus' : up' -> Just (Stack focus' up' [])+        [] -> Nothing++focusUpStack :: Stack a -> Stack a+focusUpStack st = case stackUp st of+  up : ups -> Stack up ups (stackFocus st : stackDown st)+  [] ->+    case reverse (stackFocus st : stackDown st) of+      [] -> st+      focus : rest -> Stack focus rest []++focusDownStack :: Stack a -> Stack a+focusDownStack = reverseStack . focusUpStack . reverseStack++swapUpStack :: Stack a -> Stack a+swapUpStack st = case stackUp st of+  up : ups -> Stack (stackFocus st) ups (up : stackDown st)+  [] -> Stack (stackFocus st) (reverse (stackDown st)) []++swapDownStack :: Stack a -> Stack a+swapDownStack = reverseStack . swapUpStack . reverseStack++reverseStack :: Stack a -> Stack a+reverseStack st = Stack (stackFocus st) (stackDown st) (stackUp st)++shift :: (Eq a, Eq i) => i -> WindowSet sid i l a -> WindowSet sid i l a+shift wid ws = case peek ws of+  Nothing -> ws+  Just win -> shiftWin wid win ws++shiftWin :: (Eq a, Eq i) => i -> a -> WindowSet sid i l a -> WindowSet sid i l a+shiftWin wid win ws = case findWorkspaceIdOfWindow win ws of+  Just from+    | workspaceMember wid ws && wid /= from -> move from ws+  _ -> ws+  where+    move from = onWorkspace wid (insertUp win) . onWorkspace from (delete' win)++onWorkspace :: (Eq i) => i -> (WindowSet sid i l a -> WindowSet sid i l a) -> WindowSet sid i l a -> WindowSet sid i l a+onWorkspace wid f ws = view currentWid (f (view wid ws))+  where+    currentWid = workspaceId (screenWorkspace (current ws))
+ src/YMonad/Core/Types.hs view
@@ -0,0 +1,146 @@+module YMonad.Core.Types (+  ViewMeta (..),+  OutputInfo (..),+  ViewStyle (..),+  RuntimeTheme (..),+  UserCommand (..),+  BackendFault (..),+  YEvent (..),+  BackendReq (..),+  RuntimeState (..),+  Transition (..),+  defaultRuntimeState,+  defaultRuntimeStateWithWorkspaces,+) where++import Data.Map.Strict qualified as M+import Data.Text qualified as T++import YMonad.Core.Common+import YMonad.Core.Layout (Layout, full, mirror, tall, (|||))+import YMonad.Core.StackSet++data ViewMeta = ViewMeta+  { viewTitle :: Text+  , viewAppId :: Text+  , viewIsFloating :: Bool+  }+  deriving stock (Eq, Ord, Show)++data OutputInfo = OutputInfo+  { outputName :: Text+  , outputRect :: Rect+  }+  deriving stock (Eq, Ord, Show)++data ViewStyle = ViewStyle+  { viewStyleTitleBarMode :: TitleBarMode+  , viewStyleBorderWidth :: Dimension+  , viewStyleBorderColor :: RgbaColor+  }+  deriving stock (Eq, Ord, Show)++data RuntimeTheme = RuntimeTheme+  { themeBorderWidth :: Dimension+  , themeNormalBorderColor :: RgbaColor+  , themeFocusedBorderColor :: RgbaColor+  , themeTitleBarMode :: TitleBarMode+  }+  deriving stock (Eq, Ord, Show)++data UserCommand+  = CmdFocusNext+  | CmdFocusPrev+  | CmdSwapNext+  | CmdSwapPrev+  | CmdKillFocused+  | CmdViewWorkspace WorkspaceId+  | CmdMoveFocusedTo WorkspaceId+  | CmdToggleFullscreen+  | CmdCycleLayout+  | CmdShrink+  | CmdExpand+  | CmdIncMasterN Int+  | CmdExitSession+  deriving stock (Eq, Ord, Show, Read)++newtype BackendFault = BackendFault+  { faultMessage :: Text+  }+  deriving stock (Eq, Ord, Show)++data YEvent+  = EvViewMapped ViewId ViewMeta+  | EvViewUnmapped ViewId+  | EvOutputAdded OutputId OutputInfo+  | EvOutputRemoved OutputId+  | EvFocusChanged (Maybe ViewId)+  | EvUserCommand UserCommand+  | EvBackendFault BackendFault+  deriving stock (Eq, Ord, Show)++data BackendReq+  = ReqShowView ViewId+  | ReqHideView ViewId+  | ReqSetViewRect ViewId Rect+  | ReqSetViewStyle ViewId ViewStyle+  | ReqFocusView (Maybe ViewId)+  | ReqCloseView ViewId+  | ReqExitSession+  | ReqCommit+  deriving stock (Eq, Ord, Show)++data RuntimeState = RuntimeState+  { rtWindowSet :: WindowSet ScreenId WorkspaceId Layout ViewId+  , rtViews :: Map ViewId ViewMeta+  , rtOutputs :: Map OutputId OutputInfo+  , rtTheme :: RuntimeTheme+  , rtLastFault :: Maybe BackendFault+  }+  deriving stock (Eq, Show)++data Transition = Transition+  { trState :: RuntimeState+  , trRequests :: [BackendReq]+  }+  deriving stock (Eq, Show)++defaultRuntimeState :: Rect -> RuntimeState+defaultRuntimeState rect =+  defaultRuntimeStateWithWorkspaces rect workspaceIds+  where+    workspaceIds :: NonEmpty WorkspaceId+    workspaceIds = WorkspaceId (T.pack "1") :| map (WorkspaceId . show) [(2 :: Int) .. 9]++defaultRuntimeStateWithWorkspaces :: Rect -> NonEmpty WorkspaceId -> RuntimeState+defaultRuntimeStateWithWorkspaces rect workspaceIds =+  RuntimeState+    { rtWindowSet = singleton screen hiddenWorkspaces+    , rtViews = M.empty+    , rtOutputs = M.empty+    , rtTheme = defaultRuntimeTheme+    , rtLastFault = Nothing+    }+  where+    workspaceFor wid = emptyWorkspace wid (tall ||| mirror tall ||| full)++    currentWorkspace = workspaceFor currentWorkspaceId+    hiddenWorkspaces = map workspaceFor hiddenWorkspaceIds++    currentWorkspaceId :| hiddenWorkspaceIds = workspaceIds++    screen =+      Screen+        { screenWorkspace = currentWorkspace+        , screenId = ScreenId 0+        , screenRect = rect+        }++defaultRuntimeTheme :: RuntimeTheme+defaultRuntimeTheme =+  RuntimeTheme+    { themeBorderWidth = 1+    , themeNormalBorderColor = opaqueRgb8 0xdd 0xdd 0xdd+    , themeFocusedBorderColor = opaqueRgb8 0xff 0x00 0x00+    , themeTitleBarMode = NoTitleBar+    }
+ src/YMonad/Keys.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module YMonad.Keys (+  KeyMask (..),+  KeySym (..),+  noModMask,+  shiftMask,+  controlMask,+  mod1Mask,+  mod3Mask,+  mod4Mask,+  mod5Mask,+  xK_Return,+  xK_return,+  xK_Tab,+  xK_ISO_Left_Tab,+  xK_space,+  xK_j,+  xK_k,+  xK_h,+  xK_l,+  xK_c,+  xK_p,+  xK_s,+  xK_q,+  xK_F1,+  xK_comma,+  xK_period,+  xK_1,+  xK_2,+  xK_3,+  xK_4,+  xK_5,+  xK_6,+  xK_7,+  xK_8,+  xK_9,+  renderKeyMask,+  renderKeySym,+  keySymToXkb,+) where++import Data.Bits (Bits, FiniteBits, (.&.))+import Data.Text qualified as T++newtype KeyMask = KeyMask+  { unKeyMask :: Word32+  }+  deriving stock (Eq, Ord, Show)+  deriving newtype (Bits, FiniteBits, Num)++newtype KeySym = KeySym+  { unKeySym :: Text+  }+  deriving stock (Eq, Ord, Show)++noModMask, shiftMask, controlMask, mod1Mask, mod3Mask, mod4Mask, mod5Mask :: KeyMask+noModMask = KeyMask 0+shiftMask = KeyMask 1+controlMask = KeyMask 4+mod1Mask = KeyMask 8+mod3Mask = KeyMask 32+mod4Mask = KeyMask 64+mod5Mask = KeyMask 128++xK_Return, xK_return, xK_Tab, xK_ISO_Left_Tab, xK_space, xK_j, xK_k, xK_h, xK_l, xK_c, xK_p, xK_s, xK_q, xK_comma, xK_period, xK_F1 :: KeySym+xK_Return = KeySym "Return"+xK_return = xK_Return+xK_Tab = KeySym "Tab"+xK_ISO_Left_Tab = KeySym "ISO_Left_Tab"+xK_space = KeySym "space"+xK_j = KeySym "j"+xK_k = KeySym "k"+xK_h = KeySym "h"+xK_l = KeySym "l"+xK_c = KeySym "c"+xK_p = KeySym "p"+xK_s = KeySym "s"+xK_q = KeySym "q"+xK_F1 = KeySym "F1"+xK_comma = KeySym "comma"+xK_period = KeySym "period"++xK_1, xK_2, xK_3, xK_4, xK_5, xK_6, xK_7, xK_8, xK_9 :: KeySym+xK_1 = KeySym "1"+xK_2 = KeySym "2"+xK_3 = KeySym "3"+xK_4 = KeySym "4"+xK_5 = KeySym "5"+xK_6 = KeySym "6"+xK_7 = KeySym "7"+xK_8 = KeySym "8"+xK_9 = KeySym "9"++renderKeyMask :: KeyMask -> Text+renderKeyMask mask+  | unKeyMask mask == 0 = "None"+  | otherwise = T.intercalate "+" (map snd (filter fst parts))+  where+    includes wanted = (unKeyMask mask .&. unKeyMask wanted) /= 0+    parts =+      [ (includes shiftMask, "Shift")+      , (includes controlMask, "Control")+      , (includes mod1Mask, "Mod1")+      , (includes mod3Mask, "Mod3")+      , (includes mod4Mask, "Mod4")+      , (includes mod5Mask, "Mod5")+      ]++renderKeySym :: KeySym -> Text+renderKeySym = unKeySym++keySymToXkb :: KeySym -> Maybe Word32+keySymToXkb (KeySym sym) =+  case sym of+    "Return" -> Just 0xFF0D+    "Escape" -> Just 0xFF1B+    "Tab" -> Just 0xFF09+    "ISO_Left_Tab" -> Just 0xFE20+    "space" -> Just 0x0020+    "comma" -> Just 0x002C+    "period" -> Just 0x002E+    "F1" -> Just 0xFFBE+    _ ->+      case toString sym of+        [ch] -> Just (fromIntegral (ord ch))+        _ -> Nothing
+ src/YMonad/Launcher.hs view
@@ -0,0 +1,134 @@+module YMonad.Launcher (+  launcherMain,+) where++import Data.Time.Clock (UTCTime)+import System.Directory+import System.Environment (getEnvironment, getExecutablePath)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, (</>))+import System.Process++import YMonad++launcherMain :: IO ()+launcherMain = do+  configPath <- getConfigPath+  configExists <- doesFileExist configPath+  if not configExists+    then ymonad def+    else do+      cacheDir <- getCacheDirectory+      createDirectoryIfMissing True cacheDir+      let buildDir = cacheDir </> "build"+          binaryPath = cacheDir </> "ymonad-config"+          errorPath = cacheDir </> "ymonad.errors"+      forceRebuild <- fmap isJust (lookupEnv "YMONAD_FORCE_REBUILD")+      shouldBuild <- if forceRebuild then pure True else shouldRebuildConfig configPath binaryPath+      when shouldBuild $ recompileConfig configPath buildDir binaryPath errorPath+      launchCompiledConfig binaryPath++getConfigPath :: IO FilePath+getConfigPath = do+  explicit <- lookupEnv "YMONAD_CONFIG"+  case explicit of+    Just path -> pure path+    Nothing -> do+      configHome <- lookupEnv "XDG_CONFIG_HOME"+      case configHome of+        Just dir -> pure (dir </> "ymonad" </> "ymonad.hs")+        Nothing -> do+          homeDir <- getHomeDirectory+          pure (homeDir </> ".config" </> "ymonad" </> "ymonad.hs")++getCacheDirectory :: IO FilePath+getCacheDirectory = do+  cacheHome <- lookupEnv "XDG_CACHE_HOME"+  case cacheHome of+    Just dir -> pure (dir </> "ymonad")+    Nothing -> do+      homeDir <- getHomeDirectory+      pure (homeDir </> ".cache" </> "ymonad")++shouldRebuildConfig :: FilePath -> FilePath -> IO Bool+shouldRebuildConfig configPath binaryPath = do+  binaryExists <- doesFileExist binaryPath+  if not binaryExists+    then pure True+    else do+      configTime <- getModificationTime configPath+      binaryTime <- getModificationTime binaryPath+      libTime <- newestLibraryTimestamp (takeDirectory configPath </> "lib")+      pure (configTime > binaryTime || maybe False (> binaryTime) libTime)++newestLibraryTimestamp :: FilePath -> IO (Maybe UTCTime)+newestLibraryTimestamp root = do+  exists <- doesDirectoryExist root+  if not exists+    then pure Nothing+    else do+      files <- listFilesRecursive root+      case files of+        [] -> pure Nothing+        firstFile : otherFiles -> do+          firstTime <- getModificationTime firstFile+          otherTimes <- mapM getModificationTime otherFiles+          pure (Just (foldl' max firstTime otherTimes))++listFilesRecursive :: FilePath -> IO [FilePath]+listFilesRecursive root = do+  names <- listDirectory root+  fmap concat . forM names $ \name -> do+    let path = root </> name+    isDir <- doesDirectoryExist path+    if isDir+      then listFilesRecursive path+      else pure [path]++recompileConfig :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()+recompileConfig configPath buildDir binaryPath errorPath = do+  createDirectoryIfMissing True buildDir+  ghcPath <- getCompilerPath+  let configDir = takeDirectory configPath+      libDir = configDir </> "lib"+      ghcArgs =+        [ "--make"+        , configPath+        , "-outputdir"+        , buildDir+        , "-o"+        , binaryPath+        , "-i" <> configDir+        , "-i" <> libDir+        , "-package"+        , "YMonad"+        ]+  (exitCode, stdoutText, stderrText) <- readProcessWithExitCode ghcPath ghcArgs ""+  let buildLog = stdoutText <> stderrText+  writeFile errorPath buildLog+  case exitCode of+    ExitSuccess -> pass+    ExitFailure exitCodeValue -> die ("Failed to compile " <> configPath <> " (exit code " <> show exitCodeValue <> "). See " <> errorPath)++getCompilerPath :: IO FilePath+getCompilerPath = do+  envPath <- lookupEnv "YMONAD_GHC"+  case envPath of+    Just path -> pure path+    Nothing -> do+      found <- findExecutable "ghc"+      case found of+        Just path -> pure path+        Nothing -> die "ghc was not found in PATH; set YMONAD_GHC or install ghc"++launchCompiledConfig :: FilePath -> IO ()+launchCompiledConfig binaryPath = do+  launcherPath <- getExecutablePath+  env0 <- getEnvironment+  let helperPath = takeDirectory launcherPath </> "ymonadctl"+      env1 =+        ("YMONAD_CTL_PATH", helperPath)+          : ("YMONAD_LAUNCHER_PATH", launcherPath)+          : filter (\(name, _value) -> name /= "YMONAD_CTL_PATH" && name /= "YMONAD_LAUNCHER_PATH") env0+  (_, _, _, ph) <- createProcess ((proc binaryPath []) {env = Just env1})+  waitForProcess ph >>= exitWith
+ src/YMonad/Layout.hs view
@@ -0,0 +1,5 @@+module YMonad.Layout (+  module YMonad.Core.Layout,+) where++import YMonad.Core.Layout
+ src/YMonad/Prompt.hs view
@@ -0,0 +1,23 @@+module YMonad.Prompt (+  YPConfig (..),+  defaultYPConfig,+) where++data YPConfig = YPConfig+  { promptProgram :: Maybe FilePath+  , promptProgramArgs :: [String]+  , promptCaseSensitive :: Bool+  , promptListLines :: Maybe Int+  , promptTerminal :: Maybe String+  }+  deriving stock (Eq, Ord, Show)++defaultYPConfig :: YPConfig+defaultYPConfig =+  YPConfig+    { promptProgram = Nothing+    , promptProgramArgs = []+    , promptCaseSensitive = True+    , promptListLines = Nothing+    , promptTerminal = Nothing+    }
+ src/YMonad/Prompt/Internal.hs view
@@ -0,0 +1,232 @@+module YMonad.Prompt.Internal (+  choosePrompt,+  getCommands,+  getSshHosts,+  getMans,+  getCommandOutput,+  runInConfiguredTerminal,+  split,+) where++import Control.Concurrent (forkIO)+import Data.Char (isDigit, isSpace)+import Data.List (dropWhileEnd)+import Data.String qualified as String+import System.Directory (doesDirectoryExist, doesFileExist, executable, findExecutable, getDirectoryContents, getHomeDirectory, getPermissions, listDirectory)+import System.Exit (ExitCode (..))+import System.FilePath (dropExtensions, takeFileName, (</>))+import System.IO qualified as SIO+import System.IO.Error (catchIOError)+import System.Process (createProcess, proc, readCreateProcessWithExitCode, shell, waitForProcess)++import YMonad.Config (YConfig (..))+import YMonad.Prompt (YPConfig (..))++choosePrompt :: YPConfig -> String -> [String] -> IO (Maybe String)+choosePrompt xpConfig promptLabel rawChoices = do+  resolved <- resolvePromptProgram xpConfig promptLabel+  case resolved of+    Nothing -> pure Nothing+    Just (programPath, args) -> do+      let choices = ordNub rawChoices+          stdinPayload = if null choices then "\n" else String.unlines choices+      (exitCode, stdoutText, _stderrText) <- readCreateProcessWithExitCode (proc programPath args) stdinPayload+      case exitCode of+        ExitSuccess -> pure (nonEmptySelection stdoutText)+        ExitFailure _ -> pure Nothing++getCommands :: IO [String]+getCommands = do+  pathValue <- fromMaybe "" <$> lookupEnv "PATH"+  let directories = filter (not . null) (split ':' pathValue)+  (fmap (ordNub . concat) . forM directories) $ \dir -> do+    exists <- doesDirectoryExist dir+    if not exists+      then pure []+      else do+        names <- catchIOError (listDirectory dir) (const (pure []))+        filterM (isExecutableFile . (dir </>)) names++getSshHosts :: IO [String]+getSshHosts = do+  localHosts <- getLocalSshHosts+  globalHosts <- getGlobalSshHosts+  pure (ordNub (localHosts ++ globalHosts))++getMans :: IO [String]+getMans = do+  pathsText <- do+    p1 <- getCommandOutput "manpath -g 2>/dev/null"+    p2 <- getCommandOutput "manpath 2>/dev/null"+    pure (intercalate ":" (String.lines (p1 ++ p2)))+  let sections = ["man" <> show n | n <- [(1 :: Int) .. 9]]+      directories = [baseDir </> section | baseDir <- split ':' pathsText, not (null baseDir), section <- sections]+  nested <- forM (ordNub directories) $ \dir -> do+    exists <- doesDirectoryExist dir+    if exists+      then map dropExtensions <$> getDirectoryContents dir+      else pure []+  pure (filter validEntry (ordNub (concat nested)))++getCommandOutput :: String -> IO String+getCommandOutput cmd = do+  (exitCode, stdoutText, _stderrText) <- readCreateProcessWithExitCode (shell cmd) ""+  pure $ case exitCode of+    ExitSuccess -> stdoutText+    ExitFailure _ -> ""++runInConfiguredTerminal :: YConfig -> YPConfig -> String -> IO ()+runInConfiguredTerminal yConfig xpConfig commandText = do+  let terminalCommand = fromMaybe (terminal yConfig) (promptTerminal xpConfig)+      fullCommand = terminalCommand <> " -e sh -lc " <> shellQuote commandText+  (_, _, _, processHandle) <- createProcess (shell fullCommand)+  void (forkIO (void (waitForProcess processHandle)))++resolvePromptProgram :: YPConfig -> String -> IO (Maybe (FilePath, [String]))+resolvePromptProgram xpConfig promptLabel = do+  resolvedProgram <- case promptProgram xpConfig of+    Just explicit -> pure (Just explicit)+    Nothing -> firstJustM findExecutable ["wmenu", "bemenu", "fuzzel", "tofi", "rofi", "dmenu"]+  pure $ fmap (\programPath -> (programPath, promptArgs (takeFileName programPath) xpConfig promptLabel)) resolvedProgram++promptArgs :: FilePath -> YPConfig -> String -> [String]+promptArgs programName xpConfig promptLabel =+  case programName of+    "wmenu" -> promptProgramArgs xpConfig ++ ignoreCaseArg ++ listLinesArg ++ ["-p", promptLabel]+    "bemenu" -> promptProgramArgs xpConfig ++ ignoreCaseArg ++ ["-p", promptLabel]+    "fuzzel" -> promptProgramArgs xpConfig ++ ["--dmenu", "--prompt", promptLabel]+    "tofi" -> promptProgramArgs xpConfig ++ ["--prompt-text", promptLabel]+    "rofi" -> promptProgramArgs xpConfig ++ ["-dmenu", "-p", promptLabel] ++ ignoreCaseArg+    _ -> promptProgramArgs xpConfig ++ ["-p", promptLabel] ++ ignoreCaseArg+  where+    ignoreCaseArg = ["-i" | not (promptCaseSensitive xpConfig) && programName `elem` ["wmenu", "bemenu", "rofi", "dmenu"]]+    listLinesArg = maybe [] (\lineCount -> ["-l", show lineCount]) (promptListLines xpConfig)++nonEmptySelection :: String -> Maybe String+nonEmptySelection output =+  let stripped = strip output+   in if null stripped then Nothing else Just stripped++{-+ordNub :: (Ord a) => [a] -> [a]+ordNub = go S.empty+  where+    go _seen [] = []+    go seen (x : xs)+      | S.member x seen = go seen xs+      | otherwise = x : go (S.insert x seen) xs+-}++split :: (Eq a) => a -> [a] -> [[a]]+split delimiter = go+  where+    go [] = [[]]+    go (x : xs)+      | x == delimiter = [] : go xs+      | otherwise =+          case go xs of+            [] -> [[x]]+            (segment : segments) -> (x : segment) : segments++strip :: String -> String+strip = dropWhileEnd isSpace . dropWhile isSpace++shellQuote :: String -> String+shellQuote value = "'" <> concatMap escapeChar value <> "'"+  where+    escapeChar '\'' = "'\\''"+    escapeChar ch = [ch]++validEntry :: String -> Bool+validEntry entry =+  not (null entry)+    && entry /= "."+    && entry /= ".."++isExecutableFile :: FilePath -> IO Bool+isExecutableFile path = do+  exists <- doesFileExist path+  if not exists+    then pure False+    else do+      permissions <- getPermissions path+      pure (executable permissions)++getLocalSshHosts :: IO [String]+getLocalSshHosts = do+  homeDir <- getHomeDirectory+  knownHosts <- sshHostsFromKnownHosts (homeDir </> ".ssh" </> "known_hosts")+  configHosts <- sshHostsFromConfig (homeDir </> ".ssh" </> "config")+  pure (knownHosts ++ configHosts)++getGlobalSshHosts :: IO [String]+getGlobalSshHosts = do+  envKnownHosts <- lookupEnv "SSH_KNOWN_HOSTS"+  let candidates = maybeToList envKnownHosts ++ ["/usr/local/etc/ssh/ssh_known_hosts", "/usr/local/etc/ssh_known_hosts", "/etc/ssh/ssh_known_hosts", "/etc/ssh_known_hosts"]+  existing <- filterM doesFileExist candidates+  case existing of+    [] -> pure []+    firstKnownHosts : _rest -> sshHostsFromKnownHosts firstKnownHosts++sshHostsFromKnownHosts :: FilePath -> IO [String]+sshHostsFromKnownHosts path = do+  exists <- doesFileExist path+  if not exists+    then pure []+    else do+      contents <- catchIOError (SIO.readFile path) (const (pure ""))+      pure+        [ getWithPort host+        | line <- String.lines contents+        , nonComment line+        , firstField <- take 1 (String.words line)+        , host <- split ',' firstField+        , not (null host)+        , not ("|" `isPrefixOf` host)+        ]++sshHostsFromConfig :: FilePath -> IO [String]+sshHostsFromConfig path = do+  exists <- doesFileExist path+  if not exists+    then pure []+    else do+      contents <- catchIOError (SIO.readFile path) (const (pure ""))+      pure+        [ candidate+        | ws <- map String.words (String.lines contents)+        , isHostDirective ws+        , candidate <- drop 1 ws+        , isConcreteHost candidate+        ]++isHostDirective :: [String] -> Bool+isHostDirective (directive : _values) = directive == "Host"+isHostDirective _ = False++isConcreteHost :: String -> Bool+isConcreteHost value = not (null value) && not (any (`elem` ['*', '?']) value) && value /= "!"++getWithPort :: String -> String+getWithPort host =+  case break (== ':') host of+    (baseHost, []) -> baseHost+    (baseHost, suffix) ->+      case suffix of+        ':' : portDigits | all isDigit portDigits -> baseHost+        _other -> host++nonComment :: String -> Bool+nonComment line =+  case dropWhile isSpace line of+    [] -> False+    ('#' : _) -> False+    _ -> True++firstJustM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)+firstJustM _ [] = pure Nothing+firstJustM f (x : xs) = do+  result <- f x+  case result of+    Just value -> pure (Just value)+    Nothing -> firstJustM f xs
+ src/YMonad/Protocol/Wayland/Types.hs view
@@ -0,0 +1,117 @@+module YMonad.Protocol.Wayland.Types (+  MessageRole (..),+  ArgType (..),+  ArgSpec (..),+  MessageSpec (..),+  InterfaceSpec (..),+  ProtocolSpec (..),+  ArgValue (..),+  WireMessage (..),+  RawFrame (..),+  mkInterfaceSpec,+  mergeProtocolSpecs,+  lookupInterface,+  lookupRequest,+  lookupEventByOpcode,+) where++import Data.Map.Strict qualified as M++data MessageRole+  = MessageRequest+  | MessageEvent+  deriving stock (Eq, Ord, Show)++data ArgType+  = ArgInt+  | ArgUint+  | ArgString+  | ArgObject (Maybe Text)+  | ArgNewId (Maybe Text)+  deriving stock (Eq, Ord, Show)++data ArgSpec = ArgSpec+  { argSpecName :: Text+  , argSpecType :: ArgType+  , argSpecAllowNull :: Bool+  }+  deriving stock (Eq, Ord, Show)++data MessageSpec = MessageSpec+  { messageSpecName :: Text+  , messageSpecOpcode :: Word16+  , messageSpecRole :: MessageRole+  , messageSpecArgs :: [ArgSpec]+  }+  deriving stock (Eq, Ord, Show)++data InterfaceSpec = InterfaceSpec+  { interfaceName :: Text+  , interfaceVersion :: Word32+  , interfaceRequestsByName :: Map Text MessageSpec+  , interfaceRequestsByOpcode :: Map Word16 MessageSpec+  , interfaceEventsByName :: Map Text MessageSpec+  , interfaceEventsByOpcode :: Map Word16 MessageSpec+  }+  deriving stock (Eq, Ord, Show)++data ProtocolSpec = ProtocolSpec+  { protocolName :: Text+  , protocolInterfaces :: Map Text InterfaceSpec+  }+  deriving stock (Eq, Ord, Show)++data ArgValue+  = ArgIntValue Int32+  | ArgUintValue Word32+  | ArgStringValue (Maybe Text)+  | ArgObjectValue (Maybe Word32)+  | ArgNewIdValue Word32+  deriving stock (Eq, Ord, Show)++data WireMessage = WireMessage+  { wireObjectId :: Word32+  , wireInterface :: Text+  , wireMessageName :: Text+  , wireOpcode :: Word16+  , wireArgs :: [ArgValue]+  }+  deriving stock (Eq, Ord, Show)++data RawFrame = RawFrame+  { rawObjectId :: Word32+  , rawOpcode :: Word16+  , rawPayload :: !ByteString+  }+  deriving stock (Eq, Ord, Show)++mkInterfaceSpec :: Text -> Word32 -> [MessageSpec] -> [MessageSpec] -> InterfaceSpec+mkInterfaceSpec name version requests events =+  InterfaceSpec+    { interfaceName = name+    , interfaceVersion = version+    , interfaceRequestsByName = M.fromList [(messageSpecName msg, msg) | msg <- requests]+    , interfaceRequestsByOpcode = M.fromList [(messageSpecOpcode msg, msg) | msg <- requests]+    , interfaceEventsByName = M.fromList [(messageSpecName msg, msg) | msg <- events]+    , interfaceEventsByOpcode = M.fromList [(messageSpecOpcode msg, msg) | msg <- events]+    }++mergeProtocolSpecs :: ProtocolSpec -> ProtocolSpec -> ProtocolSpec+mergeProtocolSpecs a b =+  ProtocolSpec+    { protocolName = protocolName a+    , protocolInterfaces = M.union (protocolInterfaces a) (protocolInterfaces b)+    }++lookupInterface :: ProtocolSpec -> Text -> Maybe InterfaceSpec+lookupInterface spec name = M.lookup name (protocolInterfaces spec)++lookupRequest :: ProtocolSpec -> Text -> Text -> Maybe MessageSpec+lookupRequest spec ifaceName msgName = do+  iface <- lookupInterface spec ifaceName+  M.lookup msgName (interfaceRequestsByName iface)++lookupEventByOpcode :: ProtocolSpec -> Text -> Word16 -> Maybe MessageSpec+lookupEventByOpcode spec ifaceName opcode = do+  iface <- lookupInterface spec ifaceName+  M.lookup opcode (interfaceEventsByOpcode iface)
+ src/YMonad/Protocol/Wayland/Wire.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}++module YMonad.Protocol.Wayland.Wire (+  encodeWireMessage,+  encodeWireBatch,+  decodeRawFrames,+  decodeMessageArgs,+) where++import Data.Binary.Get+import Data.Binary.Put+import Data.Bits ((.&.))+import Data.ByteString qualified as BS++import YMonad.Protocol.Wayland.Types++encodeWireMessage :: WireMessage -> BS.ByteString+encodeWireMessage msg = toStrict $ runPut $ do+  let payload = toStrict (runPut (mapM_ putArgValue (wireArgs msg)))+      size = fromIntegral (8 + BS.length payload) :: Word16+  putWord32le (wireObjectId msg)+  putWord16le (wireOpcode msg)+  putWord16le size+  putByteString payload++encodeWireBatch :: [WireMessage] -> BS.ByteString+encodeWireBatch = BS.concat . map encodeWireMessage++decodeRawFrames :: BS.ByteString -> Either String ([RawFrame], BS.ByteString)+decodeRawFrames input = go input id+  where+    go bytes acc+      | BS.length bytes < 8 = Right (acc [], bytes)+      | otherwise =+          let header = runGet getHeader (fromStrict (BS.take 8 bytes))+              payloadLen = fromIntegral (frameSize header) - 8+           in if frameSize header < 8+                then Left "Wayland frame shorter than header"+                else+                  if BS.length bytes < fromIntegral (frameSize header)+                    then Right (acc [], bytes)+                    else+                      let payload = BS.take payloadLen (BS.drop 8 bytes)+                          rest = BS.drop (fromIntegral (frameSize header)) bytes+                          frame = RawFrame (frameObjectId header) (frameOpcode header) payload+                       in go rest (acc . (frame :))++    getHeader = do+      objectId <- getWord32le+      opcode <- getWord16le+      Header objectId opcode <$> getWord16le++decodeMessageArgs :: MessageSpec -> BS.ByteString -> Either String [ArgValue]+decodeMessageArgs spec payload =+  case runGetOrFail (mapM getArgValue (messageSpecArgs spec)) (fromStrict payload) of+    Left (_, _, err) -> Left err+    Right (_, _, args) -> Right args++putArgValue :: ArgValue -> Put+putArgValue arg = case arg of+  ArgIntValue n -> putInt32le n+  ArgUintValue n -> putWord32le n+  ArgObjectValue Nothing -> putWord32le 0+  ArgObjectValue (Just n) -> putWord32le n+  ArgNewIdValue n -> putWord32le n+  ArgStringValue Nothing -> putWord32le 0+  ArgStringValue (Just txt) -> do+    let bytes = encodeUtf8 txt+        total = BS.length bytes + 1+    putWord32le (fromIntegral total)+    putByteString bytes+    putWord8 0+    putPadding total++getArgValue :: ArgSpec -> Get ArgValue+getArgValue spec = case argSpecType spec of+  ArgInt -> ArgIntValue <$> getInt32le+  ArgUint -> ArgUintValue <$> getWord32le+  ArgObject _ -> do+    oid <- getWord32le+    pure $ ArgObjectValue (if oid == 0 then Nothing else Just oid)+  ArgNewId _ -> ArgNewIdValue <$> getWord32le+  ArgString -> do+    len <- getWord32le+    if len == 0+      then pure (ArgStringValue Nothing)+      else do+        let total = fromIntegral len+            contentLen = max 0 (total - 1)+        bytes <- getByteString contentLen+        _nul <- getWord8+        skipPadding total+        case decodeUtf8' bytes of+          Left err -> fail (show err)+          Right txt -> pure (ArgStringValue (Just txt))++putPadding :: Int -> Put+putPadding payloadLen = replicateM_ (padLength payloadLen) (putWord8 0)++skipPadding :: Int -> Get ()+skipPadding payloadLen = do+  _ <- getByteString (padLength payloadLen)+  pass++padLength :: Int -> Int+padLength n = (4 - (n .&. 3)) .&. 3++data Header = Header !Word32 !Word16 !Word16++frameObjectId :: Header -> Word32+frameObjectId (Header objectId _ _) = objectId++frameOpcode :: Header -> Word16+frameOpcode (Header _ opcode _) = opcode++frameSize :: Header -> Word16+frameSize (Header _ _ size) = size
+ src/YMonad/Protocol/Wayland/Xml.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE OverloadedStrings #-}++module YMonad.Protocol.Wayland.Xml (+  loadProtocolSpec,+) where++import Data.Map.Strict qualified as M+import Text.XML.HXT.Core++import YMonad.Protocol.Wayland.Types++loadProtocolSpec :: FilePath -> IO (Either String ProtocolSpec)+loadProtocolSpec path = do+  specs <- runX (readDocument [withValidate no, withRemoveWS yes] path >>> parseProtocol)+  pure $ case specs of+    [] -> Left ("No <protocol> element found in: " <> path)+    spec : _ -> Right spec++parseProtocol :: IOSArrow XmlTree ProtocolSpec+parseProtocol =+  deep (isElem >>> hasName "protocol") >>> proc proto -> do+    name <- getAttrValue "name" -< proto+    interfaces <- listA (getChildren >>> isElem >>> hasName "interface" >>> parseInterface) -< proto+    returnA+      -<+        ProtocolSpec+          { protocolName = toText name+          , protocolInterfaces = M.fromList [(interfaceName iface, iface) | iface <- interfaces]+          }++parseInterface :: IOSArrow XmlTree InterfaceSpec+parseInterface = proc iface -> do+  name <- getAttrValue "name" -< iface+  versionTxt <- getAttrValue "version" -< iface+  requests <- listA (getChildren >>> isElem >>> hasName "request" >>> parseRequest) -< iface+  events <- listA (getChildren >>> isElem >>> hasName "event" >>> parseEvent) -< iface+  let version = parseWord32 1 versionTxt+  returnA -< mkInterfaceSpec (toText name) version (assignOpcodes MessageRequest requests) (assignOpcodes MessageEvent events)++parseRequest :: IOSArrow XmlTree MessageSpec+parseRequest = parseMessage MessageRequest++parseEvent :: IOSArrow XmlTree MessageSpec+parseEvent = parseMessage MessageEvent++parseMessage :: MessageRole -> IOSArrow XmlTree MessageSpec+parseMessage role = proc msg -> do+  name <- getAttrValue "name" -< msg+  args <- listA (getChildren >>> isElem >>> hasName "arg" >>> parseArg) -< msg+  returnA+    -<+      MessageSpec+        { messageSpecName = toText name+        , messageSpecOpcode = 0+        , messageSpecRole = role+        , messageSpecArgs = args+        }++parseArg :: IOSArrow XmlTree ArgSpec+parseArg = proc arg -> do+  name <- getAttrValue "name" -< arg+  typeName <- getAttrValue "type" -< arg+  iface <- getAttrValue "interface" -< arg+  allowNull <- getAttrValue "allow-null" -< arg+  returnA+    -<+      ArgSpec+        { argSpecName = toText name+        , argSpecType = parseArgType (toText typeName) (toMaybeText iface)+        , argSpecAllowNull = allowNull == "true"+        }++assignOpcodes :: MessageRole -> [MessageSpec] -> [MessageSpec]+assignOpcodes role = zipWith assign [0 :: Word16 ..]+  where+    assign opcode spec = spec {messageSpecOpcode = opcode, messageSpecRole = role}++parseArgType :: Text -> Maybe Text -> ArgType+parseArgType typeName iface = case typeName of+  "int" -> ArgInt+  "uint" -> ArgUint+  "string" -> ArgString+  "object" -> ArgObject iface+  "new_id" -> ArgNewId iface+  _ -> ArgString++parseWord32 :: Word32 -> String -> Word32+parseWord32 fallback raw = fromMaybe fallback (readMaybe raw)++toMaybeText :: String -> Maybe Text+toMaybeText "" = Nothing+toMaybeText raw = Just (toText raw)
+ src/YMonad/Run.hs view
@@ -0,0 +1,511 @@+{-# LANGUAGE BangPatterns #-}++module YMonad.Run (+  ymonad,+) where++import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.STM (TQueue, newTQueueIO, tryReadTQueue, writeTQueue)+import Control.Exception (AsyncException (ThreadKilled), bracket, try)+import Control.Monad (foldM)+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as B8+import Data.Map.Strict qualified as M+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Network.Socket+import Network.Socket.ByteString qualified as NSB+import System.Directory (removePathForcibly)+import System.Environment (getEnvironment, getExecutablePath)+import System.FilePath ((</>))+import System.IO.Error (catchIOError)+import System.Process (createProcess, env, proc, shell)+import System.Timeout (timeout)++import YMonad.Backend.River+import YMonad.Config+import YMonad.ControlCommand+import YMonad.Core+import YMonad.Keys+import YMonad.Prompt.Internal (choosePrompt, getCommands, getMans, getSshHosts, runInConfiguredTerminal)++ymonad :: YConfig -> IO ()+ymonad conf = do+  controlPath <- getControlPath+  queue <- newTQueueIO+  withControlServer controlPath queue $ do+    logTrace ("control socket ready: " <> toText controlPath)+    runtimeResult <- loadRiverRuntime+    riverRt0 <- case runtimeResult of+      Left err -> die ("Failed to load river protocol: " <> err)+      Right rt -> pure rt+    socketResult <- connectRiver Nothing+    sock <- case socketResult of+      Left fault -> die ("Failed to connect to river: " <> toString (faultMessage fault))+      Right connected -> pure connected+    bracket+      (pure sock)+      close+      ( \activeSock -> do+          startupResult <- acquireRiverManager activeSock riverRt0+          (runtimeSt0, riverRt1) <- case startupResult of+            Left fault -> die ("Failed to acquire river window manager: " <> toString (faultMessage fault))+            Right (startupEvents, riverRt') -> foldM (\(st, rt) event -> applyEvent st rt event) (runtimeStateFromConfig conf, riverRt') startupEvents+          riverRt2 <- maybeInstallKeyBindings conf riverRt1+          loop conf activeSock queue runtimeSt0 riverRt2+      )++runtimeStateFromConfig :: YConfig -> RuntimeState+runtimeStateFromConfig conf =+  runtimeSt0+    { rtWindowSet =+        windowSet0+          { current = (current windowSet0) {screenWorkspace = seedLayout (screenWorkspace (current windowSet0))}+          , hidden = map seedLayout (hidden windowSet0)+          }+    , rtTheme =+        RuntimeTheme+          { themeBorderWidth = borderWidth conf+          , themeNormalBorderColor = fromMaybe (opaqueRgb8 0xdd 0xdd 0xdd) (parseColorString (normalBorderColor conf))+          , themeFocusedBorderColor = fromMaybe (opaqueRgb8 0xff 0x00 0x00) (parseColorString (focusedBorderColor conf))+          , themeTitleBarMode = titleBarMode conf+          }+    }+  where+    runtimeSt0 = defaultRuntimeStateWithWorkspaces (Rect 0 0 1920 1080) workspaceIds+    windowSet0 = rtWindowSet runtimeSt0++    seedLayout workspace = workspace {workspaceLayout = layoutHook conf}++    workspaceIds = case map (WorkspaceId . T.pack) (workspaces conf) of+      [] -> WorkspaceId "1" :| map (WorkspaceId . show) [(2 :: Int) .. 9]+      firstWorkspace : remainingWorkspaces -> firstWorkspace :| remainingWorkspaces++data RiverPoll = RiverPoll+  { riverPollRuntime :: RiverRuntime+  , riverPollCallbacks :: [RiverCallback]+  , riverPollSteps :: [RiverPollStep]+  }++data RiverPollStep+  = RiverPollAction YAction+  | RiverPollEvent YEvent++loop :: YConfig -> Socket -> TQueue ControlCommand -> RuntimeState -> RiverRuntime -> IO ()+loop conf sock queue runtimeSt riverRt = do+  polled <- pollRiverEvents sock riverRt+  case polled of+    Left fault -> stopAfterFault runtimeSt riverRt fault+    Right poll -> do+      logCallbacks (riverPollCallbacks poll)+      (runtimeSt0, riverRt0) <- foldM (applyPollStep conf) (runtimeSt, riverPollRuntime poll) (riverPollSteps poll)++      pendingCommands <- atomically (drainQueue queue)+      (runtimeSt1, riverRt1) <- foldM applyControlCommand (runtimeSt0, riverRt0) pendingCommands+      riverRt2 <- maybeInstallKeyBindings conf riverRt1++      flushed <- flushTransportLogged sock riverRt2+      case flushed of+        Left fault -> stopAfterFault runtimeSt1 riverRt2 fault+        Right riverRt3 -> loop conf sock queue runtimeSt1 riverRt3+  where+    stopAfterFault runtimeSt' riverRt' fault = do+      _ <- applyEvent runtimeSt' riverRt' (EvBackendFault fault)+      logTrace "stopping river event loop after transport failure"++applyPollStep :: YConfig -> (RuntimeState, RiverRuntime) -> RiverPollStep -> IO (RuntimeState, RiverRuntime)+applyPollStep conf state' step =+  case step of+    RiverPollAction action -> applyAction conf state' action+    RiverPollEvent event -> let (runtimeSt, riverRt) = state' in applyEvent runtimeSt riverRt event++applyEvent :: RuntimeState -> RiverRuntime -> YEvent -> IO (RuntimeState, RiverRuntime)+applyEvent runtimeSt riverRt event = do+  case event of+    EvBackendFault fault -> logBackendFault fault+    _otherEvent -> pass+  let transition = reduce runtimeSt event+      requests = trRequests transition+      !requestCount = length requests+      !runtimeSt' = trState transition+      !riverRt' = pumpPending (stageRequests riverRt requests)+  requestCount `seq` pass+  pure (runtimeSt', riverRt')++applyAction :: YConfig -> (RuntimeState, RiverRuntime) -> YAction -> IO (RuntimeState, RiverRuntime)+applyAction conf (runtimeSt, riverRt) action =+  case action of+    Spawn cmd -> do+      _ <- createProcess (shell cmd)+      pure (runtimeSt, riverRt)+    ToggleFullscreen ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdToggleFullscreen)+    ViewWorkspace workspaceName ->+      applyEvent runtimeSt riverRt (EvUserCommand (CmdViewWorkspace (WorkspaceId (T.pack workspaceName))))+    MoveFocusedTo workspaceName ->+      applyEvent runtimeSt riverRt (EvUserCommand (CmdMoveFocusedTo (WorkspaceId (T.pack workspaceName))))+    FocusNext ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdFocusNext)+    FocusPrev ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdFocusPrev)+    SwapNext ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdSwapNext)+    SwapPrev ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdSwapPrev)+    KillFocused ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdKillFocused)+    CycleLayout ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdCycleLayout)+    ShrinkMaster ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdShrink)+    ExpandMaster ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdExpand)+    IncMasterNBy delta ->+      applyEvent runtimeSt riverRt (EvUserCommand (CmdIncMasterN delta))+    ExitSession ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdExitSession)+    RecompileRestart -> do+      restartYMonad+      pure (runtimeSt, riverRt)+    ShellPrompt xpConfig -> do+      commands <- getCommands+      selection <- choosePrompt xpConfig "Run: " commands+      case selection of+        Nothing -> pure (runtimeSt, riverRt)+        Just commandText -> do+          _ <- createProcess (shell commandText)+          pure (runtimeSt, riverRt)+    SafePrompt commandPath xpConfig -> do+      selection <- choosePrompt xpConfig "Run: " []+      case selection of+        Nothing -> pure (runtimeSt, riverRt)+        Just argument -> do+          _ <- createProcess (proc commandPath [argument])+          pure (runtimeSt, riverRt)+    UnsafePrompt commandPrefix xpConfig -> do+      selection <- choosePrompt xpConfig "Run: " []+      case selection of+        Nothing -> pure (runtimeSt, riverRt)+        Just argument -> do+          _ <- createProcess (shell (commandPrefix <> " " <> argument))+          pure (runtimeSt, riverRt)+    SshPrompt xpConfig -> do+      hosts <- getSshHosts+      selection <- choosePrompt xpConfig "SSH to: " hosts+      case selection of+        Nothing -> pure (runtimeSt, riverRt)+        Just host -> do+          runInConfiguredTerminal conf xpConfig ("ssh " <> host)+          pure (runtimeSt, riverRt)+    ManPrompt xpConfig -> do+      pages <- getMans+      selection <- choosePrompt xpConfig "Manual page: " pages+      case selection of+        Nothing -> pure (runtimeSt, riverRt)+        Just page -> do+          runInConfiguredTerminal conf xpConfig ("man " <> page)+          pure (runtimeSt, riverRt)++restartYMonad :: IO ()+restartYMonad = do+  launcherPath <- getLauncherPath+  env0 <- getEnvironment+  let env1 =+        ("YMONAD_FORCE_REBUILD", "1")+          : filter ((/= "YMONAD_FORCE_REBUILD") . fst) env0+  _ <- createProcess ((proc launcherPath []) {env = Just env1})+  logTrace ("spawned restart via " <> toText launcherPath)+  exitSuccess++getLauncherPath :: IO FilePath+getLauncherPath = do+  explicit <- lookupEnv "YMONAD_LAUNCHER_PATH"+  maybe getExecutablePath pure explicit++applyControlCommand :: (RuntimeState, RiverRuntime) -> ControlCommand -> IO (RuntimeState, RiverRuntime)+applyControlCommand (runtimeSt, riverRt) command =+  case command of+    ControlSpawn cmd -> do+      _ <- createProcess (shell cmd)+      pure (runtimeSt, riverRt)+    ControlToggleFullscreen ->+      applyEvent runtimeSt riverRt (EvUserCommand CmdToggleFullscreen)+    ControlUserCommand userCmd ->+      applyEvent runtimeSt riverRt (EvUserCommand userCmd)++pollRiverEvents :: Socket -> RiverRuntime -> IO (Either BackendFault RiverPoll)+pollRiverEvents sock riverRt = do+  recvResult <- (try (timeout 10000 (NSB.recv sock 65535)) :: IO (Either SomeException (Maybe BS.ByteString)))+  case recvResult of+    Left ex -> pure (Left (BackendFault ("Wayland recv failed: " <> toText (displayException ex))))+    Right mChunk ->+      case mChunk of+        Nothing -> pure (Right (RiverPoll riverRt [] []))+        Just chunk+          | BS.null chunk -> pure (Left (BackendFault "Wayland socket closed by compositor"))+          | otherwise ->+              pure $ do+                (riverRt', callbacks) <- ingestBytes riverRt chunk+                steps <- fmap concat (mapM callbackToSteps callbacks)+                let !callbackCount = length callbacks+                    !stepCount = length steps+                callbackCount `seq` stepCount `seq` Right (RiverPoll riverRt' callbacks steps)++pollEventsFromSteps :: [RiverPollStep] -> [YEvent]+pollEventsFromSteps steps = [event | RiverPollEvent event <- steps]++callbackToSteps :: RiverCallback -> Either BackendFault [RiverPollStep]+callbackToSteps callback =+  case callback of+    RiverActionTriggered action -> Right [RiverPollAction action]+    _otherCallback -> map RiverPollEvent <$> decodeCallback callback++acquireRiverManager :: Socket -> RiverRuntime -> IO (Either BackendFault ([YEvent], RiverRuntime))+acquireRiverManager sock riverRt0 = do+  flushed <- flushTransportLogged sock riverRt0+  case flushed of+    Left fault -> pure (Left fault)+    Right riverRt1 -> waitForRegistryRoundtrip 200 [] riverRt1+  where+    waitForRegistryRoundtrip :: Int -> [YEvent] -> RiverRuntime -> IO (Either BackendFault ([YEvent], RiverRuntime))+    waitForRegistryRoundtrip remaining acc riverRt+      | startupReady riverRt =+          case rrManagerObject riverRt of+            Nothing ->+              pure+                ( Left+                    ( BackendFault+                        "Compositor did not advertise river_window_manager_v1 during startup; YMonad requires River's window management protocol"+                    )+                )+            Just _managerObject -> do+              logTrace "river_window_manager_v1 acquired"+              pure (Right (acc, riverRt))+      | remaining <= 0 =+          pure+            ( Left+                ( BackendFault+                    "Timed out waiting for wl_registry roundtrip while acquiring river_window_manager_v1"+                )+            )+      | otherwise = do+          polled <- pollRiverEvents sock riverRt+          case polled of+            Left fault -> pure (Left fault)+            Right poll -> do+              logCallbacks (riverPollCallbacks poll)+              let pollEvents = pollEventsFromSteps (riverPollSteps poll)+              case firstBackendFault pollEvents of+                Just fault -> pure (Left fault)+                Nothing -> do+                  flushed' <- flushTransportLogged sock (riverPollRuntime poll)+                  case flushed' of+                    Left fault -> pure (Left fault)+                    Right riverRt' -> waitForRegistryRoundtrip (remaining - 1) (acc ++ pollEvents) riverRt'++    startupReady :: RiverRuntime -> Bool+    startupReady riverRt =+      rrRegistryReady riverRt+        && isJust (rrManagerObject riverRt)+        && case rrXkbBindingsObject riverRt of+          Nothing -> True+          Just _ -> isJust (rrSeat riverRt)++flushTransportLogged :: Socket -> RiverRuntime -> IO (Either BackendFault RiverRuntime)+flushTransportLogged sock riverRt = do+  let prepared = pumpPending riverRt+  logOutgoingMessages (rrOutgoing prepared)+  flushTransportIO sock riverRt++maybeInstallKeyBindings :: YConfig -> RiverRuntime -> IO RiverRuntime+maybeInstallKeyBindings conf riverRt+  | rrBindingsInstalled riverRt = pure riverRt+  | otherwise =+      case (rrXkbBindingsObject riverRt, rrSeat riverRt) of+        (Nothing, _)+          | rrRegistryReady riverRt -> do+              logTrace "river_xkb_bindings_v1 was not advertised; key bindings are unavailable"+              pure (riverRt {rrBindingsInstalled = True})+        (Just _bindingsObject, Just _seat) -> do+          let (warnings, riverRt') = stageConfiguredBindings conf riverRt+          mapM_ logTrace warnings+          logTrace "installed river xkb key bindings"+          pure riverRt'+        _notReadyYet -> pure riverRt++stageConfiguredBindings :: YConfig -> RiverRuntime -> ([Text], RiverRuntime)+stageConfiguredBindings conf riverRt0 =+  let (warnings, riverRt1) = foldl' registerBinding ([], riverRt0) (M.toList (keys conf conf))+      riverRt2 = riverRt1 {rrBindingsInstalled = True}+   in (warnings, riverRt2)+  where+    bindingsObjectId = fromMaybe 0 (rrXkbBindingsObject riverRt0)+    seatObjectId = maybe 0 riverSeatObjectId (rrSeat riverRt0)++    registerBinding :: ([Text], RiverRuntime) -> ((KeyMask, KeySym), YAction) -> ([Text], RiverRuntime)+    registerBinding (warnings, riverRt) ((mask, keySym), action) =+      case keySymToXkb keySym of+        Nothing ->+          ( warnings ++ ["skipping unsupported key symbol for river xkb bindings: " <> renderKeySym keySym]+          , riverRt+          )+        Just keysym ->+          let (bindingObjectId, riverRt1) = allocateObjectId riverRt+              createBinding =+                WireMessage+                  { wireObjectId = bindingsObjectId+                  , wireInterface = "river_xkb_bindings_v1"+                  , wireMessageName = "get_xkb_binding"+                  , wireOpcode = requestOpcode riverRt1 "river_xkb_bindings_v1" "get_xkb_binding"+                  , wireArgs =+                      [ ArgObjectValue (Just seatObjectId)+                      , ArgNewIdValue bindingObjectId+                      , ArgUintValue keysym+                      , ArgUintValue (unKeyMask mask)+                      ]+                  }+              enableBinding =+                WireMessage+                  { wireObjectId = bindingObjectId+                  , wireInterface = "river_xkb_binding_v1"+                  , wireMessageName = "enable"+                  , wireOpcode = requestOpcode riverRt1 "river_xkb_binding_v1" "enable"+                  , wireArgs = []+                  }+              riverRt2 =+                riverRt1+                  { rrBindingActions = M.insert bindingObjectId action (rrBindingActions riverRt1)+                  , rrObjectInterfaces = M.insert bindingObjectId "river_xkb_binding_v1" (rrObjectInterfaces riverRt1)+                  , rrOutgoing = rrOutgoing riverRt1 ++ [createBinding]+                  , rrPendingManage = rrPendingManage riverRt1 ++ [enableBinding]+                  }+           in (warnings, riverRt2)++requestOpcode :: RiverRuntime -> Text -> Text -> Word16+requestOpcode riverRt ifaceName name = maybe 0 messageSpecOpcode (lookupRequest (rrProtocol riverRt) ifaceName name)++logCallbacks :: [RiverCallback] -> IO ()+logCallbacks = mapM_ logCallback++logCallback :: RiverCallback -> IO ()+logCallback callback = case callback of+  RiverTrace msg -> logTrace msg+  RiverProtocolFault _msg -> pass+  RiverViewCreated vid _meta -> logTrace ("view created: " <> renderText vid)+  RiverViewDestroyed vid -> logTrace ("view destroyed: " <> renderText vid)+  RiverOutputDiscovered oid info ->+    logTrace ("output discovered: " <> renderText oid <> " " <> T.pack (show (outputRect info)))+  RiverOutputLost oid -> logTrace ("output removed: " <> renderText oid)+  RiverSeatFocus mVid -> logTrace ("seat focus: " <> maybe "none" renderText mVid)+  RiverManageStart -> pass+  RiverRenderStart -> pass+  RiverUserCommand userCommand -> logTrace ("user command: " <> renderText userCommand)+  RiverActionTriggered action -> logTrace ("binding pressed: " <> renderText action)++logOutgoingMessages :: [WireMessage] -> IO ()+logOutgoingMessages = mapM_ (logTrace . ("-> " <>) . renderWireMessage)++renderWireMessage :: WireMessage -> Text+renderWireMessage msg =+  wireInterface msg+    <> "."+    <> wireMessageName msg+    <> "(object="+    <> renderText (wireObjectId msg)+    <> ", args=["+    <> T.intercalate ", " (map renderArgValue (wireArgs msg))+    <> "])"++renderArgValue :: ArgValue -> Text+renderArgValue arg = case arg of+  ArgIntValue n -> renderText n+  ArgUintValue n -> renderText n+  ArgStringValue Nothing -> "null"+  ArgStringValue (Just txt) -> txt+  ArgObjectValue Nothing -> "object:null"+  ArgObjectValue (Just oid) -> "object:" <> renderText oid+  ArgNewIdValue oid -> "new_id:" <> renderText oid++renderText :: (Show a) => a -> Text+renderText = T.pack . show++logBackendFault :: BackendFault -> IO ()+logBackendFault fault = logTrace ("backend fault: " <> faultMessage fault)++logTrace :: Text -> IO ()+logTrace msg = TIO.hPutStrLn stderr ("[ymonad] " <> msg)++firstBackendFault :: [YEvent] -> Maybe BackendFault+firstBackendFault [] = Nothing+firstBackendFault (event : rest) = case event of+  EvBackendFault fault -> Just fault+  _otherEvent -> firstBackendFault rest++getControlPath :: IO FilePath+getControlPath = do+  explicit <- lookupEnv "YMONAD_SOCKET"+  case explicit of+    Just path -> pure path+    Nothing -> do+      runtimeDir <- lookupEnv "XDG_RUNTIME_DIR"+      case runtimeDir of+        Just dir -> pure (dir </> "ymonad.sock")+        Nothing -> pure "/tmp/ymonad.sock"++withControlServer :: FilePath -> TQueue ControlCommand -> IO a -> IO a+withControlServer path queue action = bracket acquire releaseResource (const action)+  where+    acquire = do+      removePathForcibly path `catchIOError` const pass+      server <- socket AF_UNIX Stream defaultProtocol+      bind server (SockAddrUnix path)+      listen server 5+      tid <- forkIO (acceptLoop server)+      pure (server, tid)++    releaseResource (server, tid) = do+      killThread tid+      close server+      removePathForcibly path `catchIOError` const pass++    acceptLoop server = forever $ do+      accepted <- (try (accept server) :: IO (Either SomeException (Socket, SockAddr)))+      case accepted of+        Left ex+          | isControlServerShutdown ex -> pass+          | otherwise -> logTrace ("control socket accept failed: " <> toText (displayException ex))+        Right (conn, _) -> do+          commandResult <- (try (recvAll conn) :: IO (Either SomeException BS.ByteString))+          close conn+          case commandResult of+            Left ex -> logTrace ("control socket recv failed: " <> toText (displayException ex))+            Right commandBytes ->+              case readMaybe (B8.unpack commandBytes) of+                Nothing -> logTrace ("ignored malformed control command: " <> decodeUtf8With lenientDecode commandBytes)+                Just command -> do+                  _ <- evaluateWHNF command+                  atomically (writeTQueue queue command)++isControlServerShutdown :: SomeException -> Bool+isControlServerShutdown ex =+  case fromException ex of+    Just ThreadKilled -> True+    _ -> "Bad file descriptor" `T.isInfixOf` toText (displayException ex)++recvAll :: Socket -> IO BS.ByteString+recvAll conn = go id+  where+    go chunks = do+      chunk <- NSB.recv conn 4096+      if BS.null chunk+        then pure (BS.concat (chunks []))+        else go (chunks . (chunk :))++drainQueue :: TQueue a -> STM [a]+drainQueue queue = go id+  where+    go acc = do+      next <- tryReadTQueue queue+      case next of+        Nothing -> pure (acc [])+        Just value -> go (acc . (value :))
+ src/YMonad/StackSet.hs view
@@ -0,0 +1,5 @@+module YMonad.StackSet (+  module YMonad.Core.StackSet,+) where++import YMonad.Core.StackSet
+ ymonad.cabal view
@@ -0,0 +1,122 @@+cabal-version: 3.4+name:          ymonad+version:       0.1.0.0+license:       AGPL-3.0-or-later+license-file:  LICENSE+author:        Edward Tjörnhammar+maintainer:    ed@cflags.cc+build-type:    Simple+synopsis:      The Wayland Yutani-Monad+description:+  ymonad is a tiling window manager for Wayland that utilizes river for+  low-level Wayland integration. It is designed to offer an API surface similar+  to xmonad, ensuring familiarity for existing xmonad users and delivering a+  composable, keyboard-driven workflow on Wayland.++data-files:    protocol/river/*.xml+homepage:      https://ymonad.org+bug-reports:   https://codeberg.org/ymonad/ymonad/issues+tested-with:   GHC ==9.10.3+category:      System++source-repository head+  type:     git +  location: https://codeberg.org/ymonad/ymonad++flag dev+  description: Enable strict warnings (-Werror) for development.+  manual:      True+  default:     False++common warnings+  ghc-options:+    -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns+    -Wmissing-deriving-strategies -Wunused-foralls -Wunused-foralls+    -fprint-explicit-foralls -fprint-explicit-kinds++  if flag(dev)+    ghc-options: -Werror++common shared+  mixins:+    base (Prelude as Brolude),+    base hiding (Prelude),+    relude (Relude as Prelude, Relude.Container.One),+    relude++  hs-source-dirs:     src+  build-depends:+    , base        >=4.14 && <5+    , binary      >=0.8  && <0.9+    , bytestring  >=0.12 && <0.13+    , containers  >=0.7  && <0.8+    , directory   >=1.3  && <1.4+    , effectful   >=2.6  && <2.7+    , filepath    >=1.5  && <1.6+    , hxt         >=9.3  && <9.4+    , network     >=3.2  && <3.3+    , process     >=1.6  && <1.7+    , relude      >=1    && <2+    , stm         >=2.5  && <2.6+    , text        >=2.1  && <2.2+    , time        >=1.12 && <1.13++  default-extensions:+    DerivingStrategies+    GeneralizedNewtypeDeriving+    ImportQualifiedPost+    OverloadedStrings+    StrictData++  default-language:   Haskell2010++library+  import:          warnings, shared+  exposed-modules:+    YMonad+    YMonad.Config+    YMonad.Core+    YMonad.Layout+    YMonad.StackSet++  other-modules:+    Paths_ymonad+    YMonad.Backend.River+    YMonad.Backend.River.Decode+    YMonad.Backend.River.Encode+    YMonad.Backend.River.Interpreter+    YMonad.Backend.River.Protocol+    YMonad.Backend.River.Translate+    YMonad.Backend.River.Types+    YMonad.ControlCommand+    YMonad.Core.Common+    YMonad.Core.Layout+    YMonad.Core.Reduce+    YMonad.Core.StackSet+    YMonad.Core.Types+    YMonad.Keys+    YMonad.Prompt+    YMonad.Prompt.Internal+    YMonad.Protocol.Wayland.Types+    YMonad.Protocol.Wayland.Wire+    YMonad.Protocol.Wayland.Xml+    YMonad.Run++  autogen-modules: Paths_ymonad++executable ymonad+  import:          warnings, shared+  main-is:         Main.hs+  other-modules:+    Paths_ymonad+    YMonad.Launcher++  autogen-modules: Paths_ymonad+  build-depends:   ymonad++executable ymonadctl+  import:          warnings, shared+  main-is:         ControlMain.hs+  other-modules:   Paths_ymonad+  autogen-modules: Paths_ymonad+  build-depends:   ymonad