diff options
58 files changed, 11447 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4bc61c3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +# Per-project tooling (local only) +.ai/ +/todo.org + +# --- elisp build / test tooling --- +*.elc +*.eln +/.eask/ +/.coverage/ +/makefile-local +/tests/makefile-local +/tests/*-output.log +/pearl-autoloads.el +/tests/tests-autoloads.el + +# Emacs backup files +*~ @@ -0,0 +1,25 @@ +;; -*- mode: eask; lexical-binding: t -*- + +(package "pearl" + "1.0.0" + "Linear.app integration") + +(website-url "https://github.com/cjennings/pearl") +(keywords "tools") + +(package-file "pearl.el") + +(source 'gnu) +(source 'nongnu) +(source 'melpa) + +(depends-on "emacs" "27.1") +(depends-on "request" "0.3.0") +(depends-on "dash" "2.17.0") +(depends-on "s" "1.12.0") +(depends-on "transient" "0.3.0") + +(development + (depends-on "elisp-lint") + (depends-on "package-lint") + (depends-on "undercover")) @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<https://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<https://www.gnu.org/licenses/why-not-lgpl.html>. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..621cf95 --- /dev/null +++ b/Makefile @@ -0,0 +1,156 @@ +# Makefile for pearl.el +# Test targets delegate to tests/Makefile. +# setup / compile / coverage operate at project root. +# Run 'make help' for available commands. + +EASK ?= eask +EMACS_BATCH = $(EASK) emacs --batch +# Coverage / test loops need default-directory = tests/ so test files' +# relative paths (../pearl.el, sibling test files) resolve as they do +# under tests/Makefile. +EMACS_BATCH_TESTS = $(EASK) emacs --batch --eval '(cd "tests/")' + +TEST_DIR = tests +SOURCE_FILE = pearl.el + +# Coverage configuration +COVERAGE_DIR = .coverage +COVERAGE_FILE = $(COVERAGE_DIR)/simplecov.json + +# Test-file list used by the coverage loop, mirroring tests/Makefile. +# Coverage runs every test file so the report represents the full suite. +ALL_TESTS = $(filter-out $(TEST_DIR)/test-bootstrap.el, \ + $(wildcard $(TEST_DIR)/test-*.el)) + +# Include local overrides if present (per-machine knobs, not committed) +-include makefile-local + +.PHONY: help test test-all test-unit test-integration test-file test-one test-name \ + count list validate lint check-deps clean \ + setup compile coverage coverage-clean + +help: + @$(MAKE) -C $(TEST_DIR) help + +# Test target delegations +test: + @$(MAKE) -C $(TEST_DIR) test + +test-all: + @$(MAKE) -C $(TEST_DIR) test-all + +test-unit: + @$(MAKE) -C $(TEST_DIR) test-unit + +test-integration: + @$(MAKE) -C $(TEST_DIR) test-integration + +test-file: + @$(MAKE) -C $(TEST_DIR) test-file FILE="$(FILE)" + +test-one: + @$(MAKE) -C $(TEST_DIR) test-one TEST="$(TEST)" + +test-name: + @$(MAKE) -C $(TEST_DIR) test-name TEST="$(TEST)" + +count: + @$(MAKE) -C $(TEST_DIR) count + +list: + @$(MAKE) -C $(TEST_DIR) list + +validate: + @$(MAKE) -C $(TEST_DIR) validate + +lint: + @$(MAKE) -C $(TEST_DIR) lint + +check-deps: + @$(MAKE) -C $(TEST_DIR) check-deps + +clean: + @$(MAKE) -C $(TEST_DIR) clean + @rm -rf $(COVERAGE_DIR) + +# +# Project-root targets — operate on pearl.el at root level +# + +# Install runtime + development dependencies via eask +setup: + @if ! command -v $(EASK) >/dev/null 2>&1; then \ + echo "[✗] eask not found on PATH"; \ + echo " Install: npm install -g @emacs-eask/cli"; \ + echo " Or: https://emacs-eask.github.io/Getting-Started/Install-Eask/"; \ + exit 1; \ + fi + @echo "[i] Installing dependencies via eask..." + @$(EASK) install-deps --dev + @echo "[i] Verifying runtime deps landed in the sandbox..." + @# eask skips a dep when an identical version sits in its GLOBAL store + @# (~/.eask/<ver>/elpa/), but `eask emacs' only activates the project + @# sandbox — so a globally-present dep is "installed" yet unloadable here. + @# Install any such skipped runtime dep straight into the sandbox. + @$(EASK) emacs --batch --eval "(progn \ + (package-initialize) \ + (dolist (pkg '(request dash s)) \ + (unless (package-installed-p pkg) \ + (message \" installing %s into sandbox...\" pkg) \ + (unless package-archive-contents (package-refresh-contents)) \ + (package-install pkg))))" + @echo "[✓] Dependencies installed in .eask/" + +# Byte-compile pearl.el — surfaces free-variable / unused-let / +# suspicious-call warnings that checkdoc and elisp-lint don't catch. +# byte-compile-error-on-warn is t so any warning fails the build. +compile: + @echo "[i] Byte-compiling $(SOURCE_FILE)..." + @$(EMACS_BATCH) \ + --eval "(progn \ + (setq byte-compile-error-on-warn t) \ + (batch-byte-compile))" $(SOURCE_FILE) + @echo "[✓] Compilation complete" + +# +# Coverage (undercover + simplecov JSON) +# +# Each test file runs in its own Emacs process (matching test-unit); +# tests/run-coverage-file.el instruments pearl.el before the source +# is loaded, and undercover merges per-file results into a single simplecov +# JSON. + +coverage: coverage-clean $(COVERAGE_DIR) + @echo "[i] Cleaning .elc files so undercover can instrument source..." + @find . -name "*.elc" -delete + @echo "[i] Running coverage across $(words $(ALL_TESTS)) test file(s)..." + @echo " (slower than 'make test' — each file runs in its own Emacs)" + @failed=0; \ + for test in $(ALL_TESTS); do \ + echo " Coverage: $$test..."; \ + testfile=$$(basename $$test); \ + $(EMACS_BATCH_TESTS) \ + -l ert \ + -l run-coverage-file.el \ + -l ../$(SOURCE_FILE) \ + -l $$testfile \ + --eval "(ert-run-tests-batch-and-exit t)" || failed=$$((failed + 1)); \ + done; \ + if [ $$failed -gt 0 ]; then \ + echo "[!] $$failed test file(s) failed during coverage run"; \ + exit 1; \ + fi + @coverage_file="$${COVERAGE_FILE_ACTUAL:-$(COVERAGE_FILE)}"; \ + [ -n "$$CI" ] && coverage_file="$(COVERAGE_DIR)/coveralls.json"; \ + if [ -f "$$coverage_file" ]; then \ + echo "[✓] Coverage report: $$coverage_file ($$(du -h $$coverage_file | cut -f1))"; \ + else \ + echo "[!] No coverage file produced; check that undercover is installed"; \ + exit 1; \ + fi + +coverage-clean: + @rm -f $(COVERAGE_FILE) + +$(COVERAGE_DIR): + @mkdir -p $(COVERAGE_DIR) diff --git a/README.org b/README.org new file mode 100644 index 0000000..633baf4 --- /dev/null +++ b/README.org @@ -0,0 +1,335 @@ +#+TITLE: pearl — Linear.app for Emacs +#+OPTIONS: toc:2 num:nil + +[[https://www.gnu.org/licenses/gpl-3.0][https://img.shields.io/badge/License-GPLv3-blue.svg]] + +=pearl= is an integration between Emacs and [[https://linear.app][Linear.app]]: fetch, read, edit, and create Linear issues as org-mode entries without leaving Emacs. Issues render as an org outline; their descriptions and comments live in the entry body, structured fields live in a property drawer, and dedicated commands push changes back to Linear. + +* Features + +- *Fetch what you want.* List your open issues, narrow by project, build an ad-hoc filter interactively, run a Linear Custom View, or run a named local saved query. +- *Issues as readable org.* Each issue is a heading; its description renders in the body (markdown converted to org), its comments render as a chronological sub-thread, and its structured fields (state, priority, assignee, labels, team, project) live in a namespaced =LINEAR-*= drawer. +- *Edit and push back.* Edit a description in the body and sync it; change the title; set priority, state, assignee, or labels by command; add a comment, or edit one of your own. Each push is explicit and confirmed against the remote. +- *Conflict-aware sync.* Pushing a description or title compares the local edit, the last-fetched baseline, and the current remote — a no-op sends nothing, a clean edit pushes, and a both-sides-changed case is refused and reported rather than clobbering. +- *Self-describing active file.* The generated file records the source it came from, so one command refreshes it; refresh a single issue at point, or the whole view. +- *Org TODO state sync.* Changing an issue's TODO keyword in org pushes the matching Linear workflow state. +- *One menu for everything.* =M-x pearl-menu= opens a transient dispatcher (magit-style) with every command grouped and a key away. + +* Installation + +** Prerequisites + +A Linear API key (Settings → Account → API → Personal API Keys) and the =request=, =dash=, =s=, and =transient= packages (=transient= ships with Emacs 28+). + +#+begin_src elisp +(require 'package) +(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) +(package-initialize) +#+end_src + +** MELPA (coming soon) + +#+begin_src +M-x package-install RET pearl RET +#+end_src + +** Manual + +#+begin_src shell +git clone https://github.com/cjennings/pearl.git +#+end_src + +#+begin_src elisp +(add-to-list 'load-path "/path/to/pearl") +(require 'pearl) +;; dependencies, if not already present: +;; M-x package-install RET request RET +;; M-x package-install RET dash RET +;; M-x package-install RET s RET +#+end_src + +** Doom Emacs + +In =packages.el=: + +#+begin_src elisp +(package! pearl + :recipe (:host github :repo "cjennings/pearl" :files ("*.el"))) +#+end_src + +In =config.el=: + +#+begin_src elisp +(use-package! pearl + :commands (pearl-list-issues pearl-new-issue + pearl-run-view pearl-enable-org-sync) + :init + (setq pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory)) + :config + (pearl-load-api-key-from-env)) +#+end_src + +* Configuration + +** The API key + +Three ways, least to most secure: + +#+begin_src elisp +;; 1. Direct (not recommended -- ends up in your config). +(setq pearl-api-key "lin_api_...") + +;; 2. Environment variable LINEAR_API_KEY. +(pearl-load-api-key-from-env) +#+end_src + +3. =auth-source= (recommended). Add to =~/.authinfo.gpg=: + +#+begin_src +machine api.linear.app login apikey password YOUR_API_KEY +#+end_src + +then load it: + +#+begin_src elisp +(setq pearl-api-key + (auth-source-pick-first-password :host "api.linear.app")) +#+end_src + +The host (=api.linear.app=) and login (=apikey=) must match the entry. macOS Keychain users can instead run =security add-generic-password -a apikey -s api.linear.app -w YOUR_API_KEY=. + +** Output file + +Issues are written to one active file, =pearl-org-file-path= (default =gtd/linear.org= under =org-directory=): + +#+begin_src elisp +(setq pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory)) +#+end_src + +Running a different query or view *replaces* this file's contents (behind a dirty-buffer guard); one issue appears in one place. + +** Default team + +#+begin_src elisp +(setq pearl-default-team-id "your-team-id") ; skips the team prompt on create +#+end_src + +* The command menu + +=M-x pearl-menu= opens a transient dispatcher with every command grouped by what it does: fetch, view, the issue at point, create and org-sync, and setup. It's the fastest way to reach a command without remembering its name. Bind it to a key if you use it often: + +#+begin_src elisp +(with-eval-after-load 'pearl + (global-set-key (kbd "C-c L") #'pearl-menu)) +#+end_src + +Every command below is also available directly via =M-x=. + +* The active org file + +A fetched file carries a self-describing header and one heading per issue: + +#+begin_src org +#+title: Linear — My open issues +#+STARTUP: show3levels +#+TODO: TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE +#+LINEAR-SOURCE: (:type filter :name "My open issues" :filter (:assignee :me :open t)) +#+LINEAR-RUN-AT: 2026-05-23 19:30 +#+LINEAR-FILTER: assignee: me, open +#+LINEAR-COUNT: 12 +#+LINEAR-TRUNCATED: no +# +# Body = the issue description; edit it, then M-x pearl-sync-current-issue to push. +# Comments subtree = the thread; add with M-x pearl-add-comment. +# Drawer fields change via M-x pearl-set-priority / -state / -assignee / -labels. +# Refresh with M-x pearl-refresh-current-view (whole file) or -current-issue (one). + +* My open issues +** TODO [#B] ENG-123 Issue title +:PROPERTIES: +:LINEAR-ID: <uuid> +:LINEAR-IDENTIFIER: ENG-123 +:LINEAR-URL: https://linear.app/.../ENG-123 +:LINEAR-TEAM-ID: <id> +:LINEAR-TEAM-NAME: Engineering +:LINEAR-PROJECT-NAME: Platform +:LINEAR-STATE-NAME: In Progress +:LINEAR-ASSIGNEE-NAME: Craig +:LINEAR-LABELS: [bug, p1] +:LINEAR-DESC-SHA256: <hash of the last-fetched description markdown> +:LINEAR-DESC-ORG-SHA256: <hash of the rendered Org body> +:LINEAR-DESC-UPDATED-AT: <remote timestamp> +:LINEAR-TITLE-SHA256: <hash of the rendered title> +:END: + +The issue description renders here as org, edited in place. + +*** Comments +**** Author Name — 2026-05-23T10:00:00.000Z +A comment, oldest first. +#+end_src + +Every issue nests under one top-level heading named after the view (here =My open issues=), so you can sort the whole set with =C-c ^= on that parent. The =#+LINEAR-SOURCE:= line records what produced the file so =refresh-current-view= can re-run it. The =LINEAR-*= drawer stores ids and display names separately; commands show names and mutate by id, so there is no per-render network lookup. The =SHA256= properties are provenance for the sync conflict gate. + +* Fetching issues + +| Command | What it fetches | +|---------+-----------------| +| =pearl-list-issues= | your open issues | +| =pearl-list-issues-by-project= | open issues in a chosen project | +| =pearl-list-issues-filtered= | an ad-hoc filter built interactively | +| =pearl-run-view= | a Linear Custom View, run server-side | +| =pearl-run-saved-query= | a named local saved query | +| =pearl-refresh-current-view= | re-runs the file's recorded source | +| =pearl-refresh-current-issue= | re-fetches the issue at point | + +=list-issues-filtered= picks a team (which scopes the rest), then completes the state, project, and labels from that team's actual values rather than free text, so a typo can't silently return nothing. It can save the filter as a local query. + +** Saved queries + +Name local queries in =pearl-saved-queries=, then run them with =pearl-run-saved-query=: + +#+begin_src elisp +(setq pearl-saved-queries + '(("My open work" :filter (:assignee :me :open t) :sort updated :order desc) + ("Open bugs" :filter (:labels ("bug") :open t) :sort priority :order asc))) +#+end_src + +Each entry is a filter plist plus optional =:sort= (=updated=, =priority=, or =title=) and =:order= (=asc= / =desc=). Sorting happens after fetch, so a refresh always lays headings out the same way. Queries are AND-only; for OR logic, build a Linear Custom View and run it with =run-view=. + +* Editing issues + +All issue commands work from anywhere inside an issue's subtree. + +** Description and title + +Edit the description in the body, then =M-x pearl-sync-current-issue=. The push is gated: unchanged since fetch sends nothing; a local edit against an unchanged remote pushes; if the remote also changed since the fetch the push is refused and the conflict reported (refresh to reconcile). =pearl-sync-current-issue-title= does the same for the heading title (note: square brackets are stripped from titles, so a synced title drops them). + +** Fields + +| Command | Effect | +|---------+--------| +| =pearl-set-priority= | None / Urgent / High / Medium / Low | +| =pearl-set-state= | a workflow state from the issue's team | +| =pearl-set-assignee= | a team member | +| =pearl-set-labels= | team labels (empty selection clears) | + +Each completes by display name, resolves to the Linear id, pushes, and updates the drawer. + +** Comments + +Comments render oldest-first under a =*** Comments= subtree, in both the bulk list and a single-issue refresh. =pearl-add-comment= posts a new comment and appends it. + +You can also edit your *own* comments. Edit a comment's body in place, then =M-x pearl-edit-current-comment= from inside its subtree. The push is gated like the description sync: unchanged sends nothing, a clean edit pushes, and a both-sides-changed case is refused (refresh to reconcile). Matching Linear's permissions, only comments you authored are editable — others (and bot or integration comments) are refused without a network call. Editability is shown by color: your own comments render green, everyone else's render greyed. Run =M-x pearl-highlight-comments= to recolor a buffer by hand. + +** Other commands + +| Command | Effect | +|---------+--------| +| =pearl-open-current-issue= | open the issue's URL in the browser | +| =pearl-open-current-view-in-linear= | open the active view's URL | +| =pearl-delete-current-issue= | delete the issue (confirms; soft delete to Trash) | +| =pearl-new-issue= | create an issue | +| =pearl-clear-cache= | clear the team/state/collection/view lookup caches | + +* State mapping and org TODO sync + +=pearl-state-to-todo-mapping= maps Linear workflow states to org TODO keywords for *rendering only* — it no longer decides which issues are fetched (inclusion is server-side via the filter). Default: + +#+begin_src elisp +'(("Todo" . "TODO") + ("In Progress" . "IN-PROGRESS") + ("In Review" . "IN-REVIEW") + ("Backlog" . "BACKLOG") + ("Blocked" . "BLOCKED") + ("Done" . "DONE")) +#+end_src + +Customize it to match your workflow, and make sure your =org-todo-keywords= include every keyword you map to. With org sync enabled, changing an issue's TODO keyword pushes the corresponding Linear state: + +#+begin_src elisp +(add-hook 'find-file-hook + (lambda () + (when (and buffer-file-name + (string-equal (file-truename buffer-file-name) + (file-truename pearl-org-file-path))) + (pearl-enable-org-sync)))) +#+end_src + +=pearl-enable-org-sync= / =pearl-disable-org-sync= toggle the save-and-TODO-change hooks for the active file. + +* Customization + +| Variable | Purpose | +|----------+---------| +| =pearl-org-file-path= | the active output file | +| =pearl-state-to-todo-mapping= | Linear state ↔ org keyword (render/sync) | +| =pearl-saved-queries= | named local queries | +| =pearl-default-team-id= | default team for issue creation | +| =pearl-max-issue-pages= | pagination cap (default 10) | +| =pearl-request-timeout= | API request timeout (seconds) | +| =pearl-fold-after-update= | re-fold the page after a fetch/refresh (default on) | +| =pearl-surface-buffer= | bring the active buffer to a window after a command (default on) | +| =pearl-surface-select-window= | also move focus to that window (default off) | +| =pearl-debug= | enable debug logging | + +* FAQ + +** I edited the title in the heading and ran the description sync, but the title didn't change. + +Title and description push through separate commands. =pearl-sync-current-issue= pushes the body; the heading title is =pearl-sync-current-issue-title= (menu =t=). Fields and comments are their own commands too — each edit pushes independently. + +** My title lost its square brackets after syncing. + +The renderer strips =[= and =]= from titles so org doesn't misparse them, so the heading holds the stripped form and a title push sends that. =Fix [URGENT] bug= becomes =Fix URGENT bug=. Keep brackets out of titles you mean to round-trip. + +** A markdown heading or =*italic*= in a description turned into bold after I synced it. + +Two markdown constructs are intentionally lossy on the round-trip: a markdown =# heading= renders as a bold line on fetch and pushes back as bold (it never returns to a heading), and single-asterisk =*italic*= is read as bold. Edit a description containing either and push, and it comes back rewritten. Use =**bold**= and real Org sub-structure deliberately; don't rely on md headings surviving. + +** My comment edit was refused with "You can only edit your own comments." + +By design — Pearl matches Linear's permissions. Only comments you authored are editable; another person's comment, or a bot or integration comment, is refused with no API call. Your own comments render green, everyone else's greyed. + +** A sync or comment edit was refused as a conflict. + +The push is gated three ways: unchanged since fetch sends nothing; a local edit against an unchanged remote pushes; if the remote also changed since your last fetch, the push is refused and the conflict reported. Refresh to reconcile, or take the use-local / use-remote / merge prompt — any destructive choice stashes your local text in =*pearl-conflict-backup*= first, so nothing is lost. + +** I hand-edited a drawer field (priority, state, assignee, labels) and it didn't push. + +=LINEAR-*= drawer fields change by command, not by hand: =pearl-set-priority=, =-state=, =-assignee=, =-labels=. Each resolves a display name to the Linear id, pushes, and rewrites the drawer. A value typed into the drawer by hand won't push and gets overwritten on the next refresh. + +** My fetch seems to be missing issues. + +The fetch is capped at =pearl-max-issue-pages= (default 10 pages × 100 = 1000 issues). A capped fetch sets =#+LINEAR-TRUNCATED: yes= in the header. Raise =pearl-max-issue-pages= if you're assigned more. + +** Names (team, state, assignee) are stale after I renamed them in Linear. + +Pearl caches those lookups so it doesn't hit the network on every render. Run =M-x pearl-clear-cache=. + +** The page collapses after every refresh — can I keep it expanded? + +After a fetch or refresh Pearl re-folds the page to its =#+STARTUP= visibility (issue headings shown; descriptions, comments, and drawers folded), because =#+STARTUP= on its own only applies on a file's first visit. Set =pearl-fold-after-update= to nil to leave the buffer however you had it. + +** Can I hide the property drawers completely, not just fold them? + +Pearl folds drawers with the rest of the page, but an expanded issue still shows the one-line =:PROPERTIES:= stub. For a tidier look, [[https://github.com/jxq0/org-tidy][org-tidy]] replaces each drawer with a small glyph. It composes with Pearl rather than fighting it: Pearl folds the outline (descriptions and comments) to a scannable list, and org-tidy collapses the drawers on top — even on an expanded issue. Editing still works, since org-tidy only adds display overlays and never touches the drawer text, and a Pearl fetch re-applies it cleanly. Turn it on with =M-x org-tidy-mode= (or =global-org-tidy-mode=); if a partial refresh ever leaves a drawer showing, =M-x org-tidy= re-tidies. + +* Troubleshooting + +- =M-x pearl-test-connection= — check the API key and connectivity. +- =M-x pearl-check-setup= — confirm the key loaded. +- =M-x pearl-toggle-debug= (or =(setq pearl-debug t)=) — log requests and responses to =*Messages*=. +- Stale names after renaming things in Linear → =M-x pearl-clear-cache=. + +* Contributing + +Contributions are welcome — open an issue or a pull request. + +* Acknowledgments + +Based on and inspired by Gael Blanchemain's linear-emacs. + +* License + +GPL-3.0. See [[file:LICENSE][LICENSE]]. diff --git a/TESTING.org b/TESTING.org new file mode 100644 index 0000000..6d7abd2 --- /dev/null +++ b/TESTING.org @@ -0,0 +1,66 @@ +#+TITLE: Testing pearl +#+OPTIONS: toc:2 + +* Overview + +pearl uses [[https://github.com/jorgenschaefer/emacs-lisp-mode][ERT]] for tests, [[https://emacs-eask.github.io/][Eask]] to manage the test sandbox and dependencies, and [[https://github.com/undercover-el/undercover.el][undercover]] for coverage reports. A root =Makefile= drives everything and delegates test targets to =tests/Makefile=. + +* Prerequisites + +- Emacs 27.1+ +- [[https://emacs-eask.github.io/Getting-Started/Install-Eask/][Eask]] on =PATH= (=npm install -g @emacs-eask/cli=, or the standalone installer) + +* First-time setup + +#+begin_src shell +make setup +#+end_src + +Installs runtime deps (=request=, =dash=, =s=) and development deps (=elisp-lint=, =package-lint=, =undercover=) into a project-local =.eask/= sandbox. + +** Note on Eask's global package store + +Eask keeps a global package store at =~/.eask/<emacs-version>/elpa/=. When a dependency already sits there at the version the project wants, =eask install-deps= skips installing it into the project sandbox — but =eask emacs= (which runs the tests) only activates the project sandbox, so the dependency ends up "installed" yet unloadable. =make setup= guards against this: after =eask install-deps= it verifies each runtime dep is present in the sandbox and installs any that were skipped. The guard is a no-op where the global store is empty (fresh clones, CI). + +* Running tests + +#+begin_src shell +make test # all tests, excluding :slow +make test-all # all tests, including :slow +make test-unit # unit tests only +make test-integration # integration tests only +make test-file FILE=mapping # one file (fuzzy match on name) +make test-one TEST=priority # one test (fuzzy match on name) +make test-name TEST='pattern' # tests matching an ERT name pattern +#+end_src + +* Coverage + +#+begin_src shell +make coverage +#+end_src + +Cleans =.elc= files (so undercover can instrument the source), runs every test file in its own Emacs process with =pearl.el= instrumented, and merges per-file results into =.coverage/simplecov.json=. Under CI (=CI=true=) it emits =.coverage/coveralls.json= instead for upload. + +* Other targets + +#+begin_src shell +make validate # parens-balance check (no deps needed) +make compile # byte-compile pearl.el (warnings are errors) +make lint # elisp-lint over pearl.el +make count # count tests per file +make list # list all test names +make clean # remove .elc, logs, and .coverage +make help # full target list +#+end_src + +=make compile= (warnings as errors), =make lint=, and =eask lint checkdoc= are all clean; keep them that way as part of normal maintenance. + +* Writing tests + +- One test file per source function/area: =tests/test-pearl-<area>.el=. +- Start each file with =(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))= — it loads the deps and the package source. +- Name tests =test-pearl-<function>-<scenario>-<expected>=. +- Cover Normal, Boundary, and Error cases. +- Tag slow tests with =:tags '(:slow)= so the default =make test= skips them. +- Integration files are named =tests/test-integration-*.el=. diff --git a/docs/issue-comment-editing-spec.org b/docs/issue-comment-editing-spec.org new file mode 100644 index 0000000..6a1b0c8 --- /dev/null +++ b/docs/issue-comment-editing-spec.org @@ -0,0 +1,117 @@ +#+TITLE: pearl — Comment Editing Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-24 +#+STARTUP: showall + +* Status + +*APPROVED — open questions resolved 2026-05-24 (see [[*Resolved decisions][Resolved decisions]]). Implementation in progress.* Nothing in =pearl.el= had changed at the time of writing. + +Companion to [[file:issue-representation-spec.org][issue-representation-spec.org]] (rendering + description/title editing) and [[file:issue-query-spec.org][issue-query-spec.org]] (fetching). This doc covers the one editing path those two parked as vNext: editing an existing comment. It reuses their org→Linear write path, their conflict-gate pattern, and the single active-file model. + +* Problem + +Comments are render-and-add only. You can read the thread and post a new comment, but you can't fix a typo in your own comment without leaving Emacs for the Linear web UI. Linear lets a user edit only their own comments, so the feature has to carry a permission check: a comment authored by someone else (or by a bot or integration) must not be editable from Emacs, and the attempt must fail clearly rather than bounce off the server with an opaque error. + +The representation spec already parked this (its decision 2): "editing existing comments is vNext, and then only comments authored by the current Linear user, matching Linear's permissions." This is that vNext. + +* Current state (what exists today) + +- *Fetch.* =pearl--fetch-issue-async= (=pearl.el:~737=) pulls each comment as =id=, =body=, =createdAt=, =user { id name displayName }=, =botActor { name }=, =externalUser { name }=. The single-issue fetch carries comments; the bulk list omits them. +- *Normalize.* =pearl--normalize-comment= (=l.568=) returns =(:id :body :created-at :author)=. The =:author= is the *display name only* — the user's =id= is fetched but dropped. There is no viewer identity anywhere in the package. +- *Render.* =pearl--format-comment= (=l.1612=) renders =***** <author> — <timestamp>= followed by the body (markdown → org). The comment =id= is not written into the org; nothing per-comment is recoverable after render. +- *Add.* =pearl--create-comment-async= (=l.1949=, =commentCreate=) + =pearl--append-comment-to-issue= (=l.1975=). +- *Conflict pattern to reuse.* Description sync (representation spec) hashes the last-fetched body into =LINEAR-DESC-SHA256=, compares last-fetched / current-org / current-remote, and does no-op / push / refuse-on-both-changed. + +Three things are therefore missing for editing: the *viewer's identity*, per-comment *id + author id + provenance* in the org, and a =commentUpdate= write path with the same conflict gate. + +* Proposed design + +** 1. Viewer identity + +Add an async =viewer { id name }= query with a cached id, mirroring the team/state caches: + +- =pearl--viewer-async (callback)= → normalized =(:id :name)=. +- =pearl--viewer-id= → cached id, fetched once per session. +- Add the viewer cache to =pearl-clear-cache=. + +This is the identity the permission check compares against. + +** 2. Retain the comment author id + +Extend =pearl--normalize-comment= to keep =:author-id= (the =user.id=). Bot and external comments have no editable user, so =:author-id= is nil for them — which the permission check reads as "not editable." + +** 3. Per-comment provenance in the org + +To target a comment for =commentUpdate= and to decide editability, each rendered comment heading needs its id, its author id, and a body hash. A small property drawer under each =*****= comment heading, mirroring the issue drawer: + +#+begin_src org +**** Comments +***** Craig — 2026-05-24T10:00:00.000Z +:PROPERTIES: +:LINEAR-COMMENT-ID: <uuid> +:LINEAR-COMMENT-AUTHOR-ID: <user-uuid or empty> +:LINEAR-COMMENT-SHA256: <hash of the last-fetched body> +:END: +The comment body renders here as org, edited in place. +#+end_src + +=org-tidy= folds the drawer the same way it folds the issue drawer, so the thread still reads cleanly. The =SHA256= is the last-fetched-body provenance for the conflict gate, exactly like =LINEAR-DESC-SHA256=. + +** 4. The edit command + +=pearl-edit-current-comment= (name is an open question), run from anywhere inside a comment's subtree: + +1. Locate the enclosing =*****= comment heading and read its drawer. +2. *Permission gate.* If =LINEAR-COMMENT-AUTHOR-ID= is empty or ≠ the viewer id, =user-error= "You can only edit your own comments" and stop. No network call. +3. Render the comment's current org body to markdown (the description sync's org→md path). +4. *Conflict gate* (mirrors description sync, v1 = detect / refuse / message): + - current org-rendered hash = =LINEAR-COMMENT-SHA256= → unchanged → no-op, no API call. + - changed locally, remote unchanged since fetch → =commentUpdate= push. + - both changed (re-fetch the remote comment body; its hash ≠ the stored last-fetched hash) → refuse, report, suggest refresh. +5. On success, update =LINEAR-COMMENT-SHA256= and re-render the comment body from the returned comment. + +** 5. The write path + +=pearl--update-comment-async (comment-id body callback)= over =commentUpdate(id: $id, input: { body: $body }) { success comment { ... } }=, normalizing the returned comment. (*Exact mutation shape to be live-verified during implementation*, the way =commentCreate= and the issue mutations were verified against the real workspace.) + +** 6. Editability highlighting (own = green, others = grey) + +"Comments by other users must not appear editable." The permission gate in step 4.2 enforces the behavior; this section makes it *visible* so a user sees what's editable before trying. + +Each comment heading is colored by editability when the active file is displayed and after every refresh: + +- the viewer's own comments → =pearl-editable-comment= face (green), +- everyone else's, plus bot and external comments → =pearl-readonly-comment= face (greyed, inherits =shadow=, reads as disabled). + +Two custom faces so users can theme them. Because the active file is generated and written to disk, faces can't be stored in the file — they're applied at *display time*. Mechanism (proposed): an overlay pass that runs during render and re-runs on the refresh / find-file hook, reading each comment's =LINEAR-COMMENT-AUTHOR-ID= drawer and comparing it to the cached viewer id. Overlays are preferred over a font-lock matcher because they don't contend with org's own fontification and the highlighted set is small. The viewer id must be resolved before the highlight pass — fetch it alongside the single-issue fetch that already pulls comments, so it's in hand at render. + +** 7. Refresh interaction + +Refreshing the issue (=refresh-current-issue=) replaces the subtree, so an unpushed comment edit would be lost — the same risk description edits already carry. The existing dirty-buffer guard covers it; no new merge logic in v1. + +* Proposed v1 decisions + +1. Only the viewer's own comments are editable. Others' comments (and bot/external comments) refuse with a =user-error=, no network call. +2. Each rendered comment carries a drawer with its id, author id, and last-fetched body hash. +3. Conflict handling is detect / refuse / message — identical to description sync v1. Interactive merge is vNext. +4. Edit-in-place: edit the comment's org body, then run the command from inside the comment subtree (consistent with how descriptions sync). No separate prompt buffer. +5. Comment *deletion* stays out of scope (read / add / edit only). Deletion is its own vNext item if wanted. +6. Editability is shown by color: own comments green, others greyed (decision from the 2026-05-24 review). +7. The edit command is named =pearl-edit-current-comment= and is added to the transient menu under "Issue at point." + +* vNext (out of scope here) + +- Comment deletion. +- Interactive conflict resolution (diff / local-wins / remote-wins) — shared with the description/title conflict vNext. +- Editing via a dedicated prompt buffer instead of in-place. +- Threaded replies (parent comment id). + +* Resolved decisions + +Settled with Craig, 2026-05-24: + +1. *Per-comment drawer* — yes. Each comment heading carries =LINEAR-COMMENT-ID= / =-AUTHOR-ID= / =-SHA256=, consistent with the issue drawer. +2. *Editability visibility* — refuse is enough for behavior, plus color: others' comments render greyed (disabled-looking), the viewer's own render green (see [[*6. Editability highlighting (own = green, others = grey)][Editability highlighting]]). +3. *Command name* — =pearl-edit-current-comment=. +4. *Transient* — yes, add it under "Issue at point" once implemented. diff --git a/docs/issue-conflict-handling-spec.org b/docs/issue-conflict-handling-spec.org new file mode 100644 index 0000000..09acaf6 --- /dev/null +++ b/docs/issue-conflict-handling-spec.org @@ -0,0 +1,74 @@ +#+TITLE: pearl — Interactive Conflict Handling Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-24 +#+STARTUP: showall + +* Status + +*IMPLEMENTED (2026-05-24).* Shipped in two increments: the use-local / use-remote / cancel core, then the smerge rewrite-in-buffer path and the refresh hardening. The open questions are resolved; see "Decisions" at the end. + +Companion to [[file:issue-representation-spec.org][issue-representation-spec.org]] (description/title editing) and [[file:issue-comment-editing-spec.org][issue-comment-editing-spec.org]] (comment editing). All three share the conflict gate this doc proposes to extend. + +* Problem + +v1's conflict handling is detect / refuse / message: when a description, title, or comment changed both locally and on Linear since the last fetch, the push is refused and a message tells the user to refresh. That protects the remote, but it leaves the user stuck. The only way forward is a manual refresh — which replaces the subtree and *discards the local edit*. So the safe-by-default behavior has a data-loss trap one keystroke away, and no in-Emacs path to actually reconcile the two versions. + +Craig's direction (2026-05-24): keep it simple — offer use-local, use-remote, or rewrite-in-an-Emacs-buffer. Error messages must be descriptive. And there must be a way through that never silently discards the user's input, because that counts as data loss. + +* Current state + +- =pearl--sync-decision= (=pearl.el:~1682=) returns =:noop= / =:push= / =:conflict= from the three-way hash compare (local-rendered vs last-fetched vs current-remote). +- =pearl-sync-current-issue=, =-sync-current-issue-title=, and =pearl-edit-current-comment= all =pcase= on that and, for =:conflict=, just =message= and stop. +- =refresh-current-issue= has a dirty-buffer guard that refuses to refresh when the body has unpushed edits — so a refresh can't clobber silently *today*, but it also can't help resolve; the user has to throw away their edit to move on. + +* Proposed design + +On =:conflict=, instead of only refusing, prompt the user to choose a resolution. One shared helper drives all three call sites (description, title, comment) so the behavior is identical everywhere. + +** The resolution prompt + +=completing-read= (or a transient) with three choices, each with a descriptive label: + +1. *Use local* — push my version, overwriting the remote. Advances the stored hash to the local text. +2. *Use remote* — discard my local edit and take Linear's current version. **Guarded against data loss** (see below): the local text is stashed before it's replaced. +3. *Rewrite in a buffer* — open a reconciliation buffer showing both versions; the user produces the merged text and pushes that. + +A fourth implicit option is always cancel (=C-g=) — leaves everything untouched, same as today's refuse. + +** No data loss — the hard requirement + +"Use remote" and "rewrite" both risk throwing away what the user typed. Before either path replaces the local text, stash it so it's always recoverable: + +- Push the local version onto the =kill-ring= (so =yank= brings it back), and +- write it to a dedicated =*pearl-conflict-backup*= buffer with a heading naming the issue/field and timestamp. + +The stash happens unconditionally on any destructive resolution. The message after "use remote" says where the old text went ("your local version is on the kill-ring and in =*pearl-conflict-backup*="). + +** The rewrite-in-a-buffer flow + +Open a reconciliation buffer prefilled so the user can see and edit both sides. Chosen mechanism (decision 1): *smerge*. Write the two versions as a =<<<<<<< LOCAL / ======= / >>>>>>> REMOTE= conflict and drop the user into =smerge-mode=, so =smerge-keep-current= / =-other= / =-all= and the rest work without custom keys. A short banner names the push/abort keys. (Considered and rejected: a plain two-section buffer — simpler but reinvents conflict navigation; and =ediff= — too heavy for a one-field reconcile.) + +On finish, the reconciled text (markers resolved) is pushed via the same =--update-*= path, and the stored hash advances to it. + +** Descriptive errors + +The conflict prompt and messages name specifics: the field (description / title / comment), the issue identifier, that both sides changed since the last fetch, and the remote's =updatedAt= so the user knows how stale their copy is. No bare "conflict detected". + +* Proposed v1 decisions (this feature) + +1. One shared resolution helper across description, title, and comment. +2. Three resolutions plus cancel: use-local, use-remote, rewrite-in-buffer. +3. Any destructive resolution stashes the local text to the kill-ring *and* a backup buffer first — never discard input. +4. Messages and the prompt are field- and issue-specific. + +* vNext / out of scope + +- Field-level 3-way auto-merge (only the changed lines). +- Conflict resolution for the drawer fields (state/priority/assignee/labels) — those are command-set, not free-text, so they don't have the same merge problem. + +* Decisions (Craig, 2026-05-24) + +1. *Rewrite-buffer mechanism*: =smerge=. Write the two versions as a =<<<<<<< / ======= / >>>>>>>= conflict and drop the user into =smerge-mode=; the =smerge-keep-*= commands work out of the box and the UX matches git muscle memory. No heavy dependency. +2. *Stash location*: kill-ring + a =*pearl-conflict-backup*= buffer. In-memory recovery (yank, or read the named buffer); no file-backup layer in v1. +3. *Default resolution on RET*: cancel. A bare =RET= at the prompt leaves everything untouched, the same as today's refuse — the safest default. +4. *"Use remote" guard scope*: yes. =refresh-current-issue= adopts the same stash-before-replace guarantee, so no refresh path can lose an unpushed edit. (The merge refresh already keeps dirty subtrees rather than overwriting; this hardens the single-issue refresh, which today refuses on a dirty body — it will stash then proceed instead.) diff --git a/docs/issue-query-spec.org b/docs/issue-query-spec.org new file mode 100644 index 0000000..75dcc4b --- /dev/null +++ b/docs/issue-query-spec.org @@ -0,0 +1,258 @@ +#+TITLE: pearl — Issue Query & Saved Reports Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-23 +#+STARTUP: showall + +* Status + +*DRAFT — review incorporated (2026-05-23), awaiting final go-ahead.* Design proposal; nothing in =pearl.el= has changed. The v1 scope is now decided (see [[*Agreed v1 decisions][Agreed v1 decisions]]); deferred items are in [[*vNext][vNext]]. Modifications/rejections of review recommendations are documented in [[*Review dispositions][Review dispositions]]. + +Companion: [[file:issue-representation-spec.org][issue-representation-spec.org]] covers how an issue is *rendered and edited* in org once fetched. This doc covers *which* issues get fetched and *where* they land. They meet at the shared org→Linear write path and the single active-file output model. + +* Problem + +Today the package fetches one thing: issues assigned to me, optionally narrowed to a single project. Everything else — by status, by project regardless of assignee, by project + status, by label, priority, assignee, cycle — has no path, and there's no way to name a query and run it again. + +The ask, verbatim: + +- all open issues assigned to me +- all open issues from a project +- all open issues in a particular status +- all open issues in a particular status in a particular project +- many of these should be saved preferences +- general enough to also cover labels, priorities, etc. + +A follow-up reframed the "saved preferences" half: Linear already has *Custom Views* (saved filters in the UI). Rather than invent a parallel local-only "reports" concept, read the user's existing views, run them from Emacs, and (later) push our own filters up. The answer (verified below) is largely yes. + +So this is one general filter model plus saved entry points on top of it — not a command per ask. + +* Current state (what exists today) + +Grounded in =pearl.el= (line refs drift): + +- *One query shape, hardcoded to "me".* All fetches go through =--get-issues-page-async= (l.368), sending =GetAssignedIssues= against =viewer { assignedIssues(...) }= (l.377-433). No use of the top-level =issues(filter:)= query. +- *The only filter is project* — =filter: { project: { id: { eq: $projectId } } }=. No assignee/state/label/priority/team/cycle filter anywhere. +- *State filtering is client-side and coupled to rendering.* =pearl-issues-state-mapping= (l.94) doubles as a global include-filter: only issues whose state is in the mapping get written (l.106-108). Adding a state mapping silently changes which issues appear. +- *Pagination* is =first: 100= + =after:= cursor, capped at =pearl-max-issue-pages= (l.125, default 10). +- *Output is single-file, single-title.* =--update-org-from-issues= (l.1201) writes =pearl-org-file-path= (l.87) with a hardcoded =#+title: Linear issues assigned to me= (l.1182). The sync hook matches the buffer against the hardcoded regex =linear\.org$= (l.956), independent of the defcustom. +- *Name→ID resolution* exists for teams (=--get-team-id-by-name=, l.745, case-sensitive) and states (=--get-state-id-by-name=, l.709, per-team, case-insensitive). Projects have no name→ID helper. Labels, assignees, cycles: none. +- *Saved filters / reports: none.* + +The fetch layer is the constraint: it can only ask Linear one question. Replacing that one hardcoded query with a general one is the spec's center of gravity. + +* Linear's API: what makes a general model possible + +The top-level =issues(filter: IssueFilter, first:, after:)= query plus the composable =IssueFilter= input type cover every item in the ask: + +| Ask | IssueFilter fragment | +|---------------------------+----------------------------------------------------------| +| assigned to me | =assignee: { isMe: { eq: true } }= | +| assigned to a person | =assignee: { email: { eq: "x@y.com" } }= | +| from a project | =project: { id: { eq: $projectId } }= | +| in a status (by name) | =state: { name: { eq: "In Progress" } }= | +| open (not done/cancelled) | =state: { type: { nin: ["completed", "canceled", "duplicate"] } }= | +| in a team | =team: { key: { eq: "ENG" } }= | +| with a label | =labels: { some: { name: { eq: "bug" } } }= | +| by priority | =priority: { eq: 2 }= (0 none,1 urgent,2 high,3 med,4 low) | +| in a cycle | =cycle: { id: { eq: $cycleId } }= | + +Two facts make "general enough" tractable: =IssueFilter= AND-s sibling fields and composes with =and=/=or= (so "open + status + project" is three sibling fields in one object); and workflow-state =type= (=triage / backlog / unstarted / started / completed / canceled / duplicate=, verified — seven values) is the workspace-independent "open" primitive, where "open" excludes =completed=, =canceled=, and =duplicate=. So one query (=issues(filter:)=) plus a Lisp→=IssueFilter= compiler covers it. + +* Linear Custom Views (verified against the published schema) + +Linear's product "Custom Views" are fully API-accessible. Verified facts (=linear/linear= master GraphQL schema): + +- *Read views:* =customViews(filter: CustomViewFilter, first:, after:, ...)= → =CustomViewConnection=; single via =customView(id)=. Each carries =name=, =description=, =team= (null = workspace-wide), =owner=, =creator=, =shared=, =icon=, =color=. +- *Run a view server-side:* =CustomView.issues(filter: IssueFilter, first:, after:, ...)= resolves the view's own filter on Linear's side. We pass the view id and paginate — no local filter translation. +- *Write views:* =customViewCreate/Update/Delete=; create input requires =name=, optional =filterData: IssueFilter=, =teamId=, etc. (vNext — see decisions.) +- *No "default view" in the API.* "Default" is a UI concept only; a default must be a local preference naming a view. + +*Filter-format asymmetry (the crux).* On *write*, =CustomViewCreateInput.filterData= is typed =IssueFilter= — the same type Layer 1 compiles to. On *read*, =CustomView.filterData= is an opaque =JSONObject!=; the schema does *not* guarantee it round-trips as a re-usable =IssueFilter=. *Conclusion: never re-execute a fetched =filterData= locally.* Use the server-side =CustomView.issues= connection to run a view. (These findings are an implementation prerequisite to re-verify — see below.) + +* Agreed v1 decisions + +Settled in the 2026-05-23 review. These are no longer open. + +1. *Active-file output model.* One configured =pearl-org-file-path= shows *one active view/query at a time*. Running a different saved query or Custom View *replaces* the file contents after dirty-buffer/conflict checks. One Linear issue appears in exactly one place in the active view. (Resolves the output-model question, which gates user-visible multi-query commands — so it's decided up front, not deferred.) +2. *Stable IDs in saved queries.* Saved local queries store stable Linear IDs; human names/keys are display metadata only. Interactive prompts show names; the compiled query executes by ID wherever the API supports it. +3. *=pearl-list-issues= means "my open issues"* — =(:assignee :me :open t)=. No back-compat constraint (no users yet); this is the cleaner default. +4. *Local saved queries are AND-only in v1.* OR is vNext; users needing OR create a Linear Custom View and run it from Emacs. +5. *Sort/order in the query model.* Local saved queries support explicit =:sort= and =:order=, defaulting to =updated= / =desc=. Server-side ordering is limited to Linear's public =orderBy: PaginationOrderBy= — =createdAt= or =updatedAt=, recency-descending, with no direction argument (verified against the schema; the richer per-field =sort: [IssueSortInput!]= arg is marked =[INTERNAL]= and unstable, so v1 avoids it). So =:sort updated= / =:sort created= map to =orderBy= server-side; any other sort field (priority, title, …) or an explicit ascending =:order= is a deterministic client-side sort after fetch (so refresh doesn't reorder headings into noise). +6. *Custom Views are read-only/run-only in v1.* Create/update/delete and pushing local queries up as views are vNext. + +* Implementation prerequisites — schema verification (complete) + +Both the published-schema pass and the live run are done, so this prerequisite is cleared. + +*Published-schema pass* (2026-05-23, against =linear/linear= master =schema.graphql=). Confirmed: + +- =issues(filter:)= takes every planned fragment; =IssueFilter= field/sub-filter names check out — assignee.isMe/email, state.name/type, project.id, team.key, labels.some/every (*no* =none=), priority =NullableNumberComparator= (eq/in/nin), cycle.id, and =and=/=or=. +- Workflow-state =type= values: triage/backlog/unstarted/started/completed/canceled/*duplicate* (seven, not six). +- Issues ordering is =orderBy: PaginationOrderBy= = createdAt/updatedAt only (see decision 5; the per-field =sort= arg is =[INTERNAL]=). +- =CustomView.issues= → =CustomViewConnection= (nodes/pageInfo). =commentCreate(input: CommentCreateInput!)= → =CommentPayload= (comment/success/lastSyncId), input body+issueId(+parentId), all input fields nullable. =Comment.user= is *nullable* (bot/integration comments — see the representation spec). + +*Live run* (2026-05-23, deepsat workspace, via the package's own GraphQL layer with the key from =.authinfo.gpg=). Confirmed: =customViews= returns both shared *and* personal views for the key (6 shared + 1 personal); =issues(filter:)= with =assignee.isMe= + =state.type nin [completed,canceled,duplicate]= + =orderBy: updatedAt= returns the right open issues; =customView.issues= runs a view's filter server-side; comment read works; =commentCreate= on a test issue succeeds (test comment deleted after). The committed fixtures in =tests/testutil-fixtures.el= stay *synthetic* — real workspace data doesn't belong in a public repo — and were confirmed to match the live shapes. =CustomViewCreateInput.filterData= = =IssueFilter= stays unverified-by-use until view-write lands (vNext). + +* Proposed design + +** Layer 1 — the filter DSL (+ validation) + +*Authoring form* (convenient, names allowed; used for ad-hoc filters and hand-written queries). Each key optional; present keys AND-ed: + +#+begin_src elisp +(:assignee :me ; :me | "email@addr" | nil + :open t ; t => state.type nin [completed,canceled,duplicate] + :state "In Progress" ; state name (needs team context) or :state-type + :state-type ("started" "unstarted") ; direct workflow-state type control + :project "Foo" ; project name (needs team context) or id + :team "ENG" ; team key or name + :labels ("bug" "p1") ; label names -> labels.some + :priority high ; symbol (none/urgent/high/medium/low) or 0-4 + :cycle "Cycle 12" ; id, current/upcoming symbol, or team+number/name + :sort updated :order desc) +#+end_src + +*Stored form* (saved queries): the resolved-to-IDs filter plus display metadata plus sort/order. The interactive builder resolves names→IDs at save time; the stored query executes by ID. + +*Selector semantics* (names are ambiguous — projects/labels/states/cycles can collide across teams): + +- =:team= — key or ID; ID internally. +- =:project= — ID, or =(team . name)= for disambiguation. +- =:state= — state type, or state ID/name *with team context*. +- =:labels= — names only when team/project context removes ambiguity; otherwise prompt on multiple matches. +- =:cycle= — ID, =current=/=upcoming= symbols, or team + cycle number/name. +- =:open= and explicit =:state=/=:state-type= — if both set, the explicit state wins (it's more specific). =:open t= ≡ =type nin [completed,canceled,duplicate]= ≡ type in =triage/backlog/unstarted/started=. + +*Validation.* =pearl--validate-issue-filter= runs before compilation: rejects unknown keys, bad priority symbols, incompatible combinations, ambiguous fields lacking team context, empty strings, unsupported value shapes — with clear error messages (tested). A plist silently accepts typos; validation is what makes a user-facing saved-query defcustom safe. + +*Compiler.* =pearl--build-issue-filter (plist)= → the GraphQL =filter:= object, via small pure predicate helpers (=--eq=, =--nin=, =--some=, =--compile-priority=, =--compile-state-filter=), each unit-tested. Adding a dimension is a clause here, not a new command. + +** Layer 2 — general fetch over a normalized pager + +A single =pearl--page-issues= helper accepts a (query-builder . extractor) pair and returns *normalized* issue objects, owning the page cap, vector→list coercion, progress messages, and partial-error behavior in one place. Two callers: + +- =--query-issues-async (filter)= → top-level =issues(filter:)=. +- =--query-view-async (view-id)= → =customView(id) { issues(...) }= (server applies the view's filter). + +The existing assigned-issues fetch becomes the first caller (=filter = {assignee:{isMe:{eq:true}}}=), collapsing the two hardcoded query variants. + +*Error shape.* Internal callbacks distinguish *no results* / *request failed* / *invalid filter* rather than collapsing all to =nil=; user commands collapse them to messages. (V1 minimum: enough to tell an empty result from a failure.) + +** Layer 3 — saved reports (Linear views first, local queries as complement) + +*Read side (main path).* =pearl-run-view= does =completing-read= over the user's =customViews= (cached), then fetches via the view primitive. "Run one of my saved Linear reports from Emacs" with zero local config. + +*Local saved queries (complement).* A defcustom of named filters for ad-hoc / Emacs-only reports, storing IDs + display metadata + sort/order (Agreed decisions 2, 5): + +#+begin_src elisp +(defcustom pearl-saved-queries + '(("My open work" + :filter (:assignee :me :open t) :sort updated :order desc)) + "Named local issue queries. Stored form keeps resolved IDs; +display names are metadata. AND-only in v1; use a Linear Custom +View for OR logic." + ...) +#+end_src + +*Default report.* No API field, so a local =pearl-default-view= names a view (or saved query) run by the bare zero-arg command. (See [[*Review dispositions][Review dispositions]] on why a separate =default-issue-filter= is *not* added.) + +** State mapping vs filter — break the coupling + +Split the two jobs =issues-state-mapping= conflates today: + +- =pearl-state-to-todo-mapping= — render/sync Linear state ↔ org TODO keyword. Rendering only. +- *Query filters* — inclusion/exclusion (=:open=, =:state=, =:state-type=). A filter, not a mapping. + +So adding a state-to-TODO mapping no longer changes which issues appear. + +** Output model — concrete + +One active file (=pearl-org-file-path=). Running a view/query replaces its contents after the dirty-buffer guard (and the representation spec's conflict check). The *file header* records the active source so refresh re-runs it without asking: + +- query/view name, +- run timestamp, +- filter summary, +- issue count, +- truncation warning if the page cap was hit (also =message='d), +- source: local query vs Linear custom view. + +This makes reports self-describing and bug reports legible. The sync hook must recognize the configured =org-file-path=, not just =linear\.org$=. + +** Orientation & refresh commands + +- =pearl-refresh-current-view= — re-run the active source from the header. +- =pearl-refresh-current-issue= — re-fetch the issue at point. +- =pearl-open-current-view-in-linear= — if the source view has a URL. + +** Caching + +Caches for teams/states/projects/labels/views power both filters and interactive completion. V1 cache control: + +- =pearl-clear-cache= command, +- a force-refresh argument on interactive selectors, +- cache keys that include team ID where relevant. + +(Automatic TTL is vNext — see [[*Review dispositions][Review dispositions]].) + +** Layer 4 — commands + +- =pearl-list-issues= — zero-arg "my open issues" (Agreed 3), over Layer 2. +- =pearl-run-view= — =completing-read= over Linear custom views; run server-side. Main saved-report path. +- =pearl-run-saved-query= — pick a local saved query, run it. +- =pearl-list-issues-filtered= — build an ad-hoc filter interactively; *complete from fetched* teams/projects/states/labels/cycles (not free text) to avoid typo'd-filter empty-result confusion; optionally save as a local query. +- =pearl-list-issues-by-project= — keep; reimplement as a thin =(:project X :open t)= call. + +(A transient menu is a separate todo task and the natural front door once these exist.) + +* Phased implementation + +1. *Layer 1 + validation + tests.* Pure =--build-issue-filter= + =--validate-issue-filter= + predicate helpers. Normal/Boundary/Error + pairwise over dimension combinations. No API. Lands green. +2. *Layer 2a — normalized pager + =--query-issues-async=.* Reimplement the assigned-issues fetch over it; characterization test proves =list-issues= still works, then flip it to "my open issues" (Agreed 3). +3. *State-mapping/filter split* + project name→ID helper + =list-issues-filtered= (ad-hoc, complete-from-fetched). +4. *Active-file output model* — header metadata, refresh-current-view, sync-hook recognizes the configured path. (Decided up front, implemented here because everything user-visible depends on it.) +5. *Layer 2b + view read* — =--query-view-async=, =customViews= listing/cache, =run-view=, default-view preference. +6. *Local saved queries* defcustom + =run-saved-query= + =:sort=/=:order=. + +vNext (gated, not in v1): view writes, OR DSL, automatic TTL, per-query/multi-view files. + +* Test strategy + +*Pure unit (first):* valid fragments for assignee me/email, open, state name/type, project ID, team key/ID, labels, priority, cycle; AND composition; =:state= vs =:open= precedence; bad keys / unresolvable names raise clear errors; priority symbol/number normalization; AND-only enforced (OR documented unsupported locally). + +*Query/pagination (request stubs):* top-level =issues(filter:)= uses the compiled variables; pagination follows =hasNextPage=/=endCursor=; page cap reports truncation; a partial error does not masquerade as an empty success; =customView.issues= extracts the same normalized shape. + +*Command/output:* =list-issues= = my open issues; =list-issues-by-project= is a thin general-query caller; running a saved query/view replaces the active file with accurate header metadata; sync hook recognizes the configured =org-file-path=; a dirty active file is not overwritten. + +*Fixtures:* small representative JSON for =issues=, =customViews=, =customView.issues=; normalize vectors / =null= / missing optional fields consistently. + +* Relationship to existing todo.org tasks + +Supersedes / absorbs three open feature tasks once approved — fold them into the phased plan rather than tracking separately: + +- =More issue filters (assignee, label, state, cycle)= — this *is* that task, generalized. +- =Fetch scope beyond assigned issues= — Layer 2 + the =:assignee= dimension. +- =list-issues-by-project= — a thin caller of the general path. + +* Open decisions + +None blocking v1 — the six agreed decisions resolved them. Remaining judgment calls are implementation-level (exact ad-hoc prompt flow, header wording) and don't gate the start. + +* vNext + +- OR support in the local saved-query DSL. +- Interactive sort/order changes (command/menu). +- Sync default sort/order back to Linear Custom Views if the API supports it. +- Create/update/delete Custom Views from Emacs (workspace-mutating; explicit confirmation + shared/personal prompt). +- Optional per-query files or multi-view files — only with demonstrated need *and* a designed duplicate-issue semantics. +- Automatic cache TTL. +- Batch/staged prefetch for interactive prompts (first team choice scopes and fetches the rest) — a perf refinement; v1 can fetch on demand. + +* Review dispositions + +All review recommendations were accepted and incorporated above except the following, modified with reasons: + +1. *Cache TTL defcustom → modified (deferred to vNext).* The review recommended an optional TTL defcustom alongside =clear-cache= and force-refresh. For a single-user tool, an automatic TTL adds invalidation complexity (stale-while-revalidate semantics, per-cache tuning) with little benefit over an explicit force-refresh. V1 ships =clear-cache= + a force-refresh arg on selectors; TTL is listed in vNext if a real need appears. +2. *Separate =pearl-default-issue-filter= defcustom → rejected.* The review floated it ("possibly") as the default for the bare command. With Agreed decision 3 fixing =list-issues= to "my open issues" and =pearl-default-view= covering a user-chosen default report, a third default-filter knob is redundant surface area. The two existing mechanisms cover the need. +3. *Structured error propagation → accepted but scoped.* Adopted as a v1 design principle (distinguish no-results / failure / invalid-filter at the internal boundary), but not a full callback-protocol refactor — v1 implements the minimum needed to keep "empty" and "failed" distinct, leaving a richer error type for later if the command surface grows. + +Everything else — active-file output model, ID-based selectors, state-mapping/filter split, filter validation, sort/order, schema-prerequisite checklist, normalized pager, GraphQL predicate helpers, self-describing headers, refresh/orientation commands, complete-from-fetched prompts, server-side filtering, store-IDs-in-properties, and the full test strategy — was accepted as written. diff --git a/docs/issue-representation-spec.org b/docs/issue-representation-spec.org new file mode 100644 index 0000000..912cee9 --- /dev/null +++ b/docs/issue-representation-spec.org @@ -0,0 +1,230 @@ +#+TITLE: pearl — Issue Org Representation & Editing Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-23 +#+STARTUP: showall + +* Status + +*DRAFT — review incorporated (2026-05-23), awaiting final go-ahead.* Design proposal; nothing in =pearl.el= has changed. v1 scope is decided (see [[*Agreed v1 decisions][Agreed v1 decisions]]); deferred items in [[*vNext][vNext]]; modifications/rejections in [[*Review dispositions][Review dispositions]]. + +Companion to [[file:issue-query-spec.org][issue-query-spec.org]] (which covers *fetching/filtering*). This doc covers how an issue is *rendered and edited* once it's in org. They share the org→Linear write path and the single active-file output model. + +* Problem + +Open a fetched issue in org and the body below the drawer is empty — and with =org-tidy= folding the drawer, the whole entry looks blank. The one piece of free-text the issue has (its description) isn't missing; it's misfiled into a *property*. Users can't tell what they're allowed to edit. + +Grounded in =pearl--format-issue-as-org-entry= (=pearl.el:1114-1173=): the description is written into a =:DESCRIPTION: |= property as 2-space-indented lines (=l.1154-1158=), inside the drawer; the body after =:END:= (=l.1171=) is empty; =org-tidy= then hides the drawer and the entry reads as blank. That's the root of "I opened the task and there's nothing there / I'm not sure what I can edit." + +* Current rendering (what exists today) + +Each issue is a =***= heading =*** <TODO-state> <priority> <title>= (=l.1146=) plus a drawer carrying =:ID:= (Linear UUID), =:ID-LINEAR:= (the =ENG-123= identifier), =:TEAM:=, =:DESCRIPTION:= (the misfiled body), =:PRIORITY:=, =:LABELS:=, =:PROJECT:=, =:LINK:=, =:PROJECT-ID:= (=l.1148-1171=). Nothing below the drawer. The fetch query pulls =description= (=l.1119=) but *not* comments. State sync resolves team name → ID by network lookup each time (slow, fragile on rename/collision). The renderer strips =[ ]= from titles (=l.1145=) — existing lossy title behavior. + +* Agreed v1 decisions + +Settled in the 2026-05-23 review. + +1. *The org issue body is entirely Linear-owned in v1.* No local-only notes area. The active org file is a synchronized representation of Linear, not a mixed local/remote workspace. +2. *Fetched comments are remote-owned display content.* Users can *add* comments; editing existing comments is vNext (and then only comments authored by the current Linear user, matching Linear's permissions). +3. *New entries use only namespaced =LINEAR-*= properties.* No compatibility layer for the old =:ID:= / =:ID-LINEAR:= shape (no users yet). +4. *Description sync starts as an explicit command only.* Automatic save-triggered description sync is vNext, after no-op detection and conflict handling are proven. +5. *V1 conflict handling is detect / refuse / message.* Interactive diff-merge or local/remote choice is vNext. + +* Content ownership and refresh semantics + +The hard part isn't moving the description — it's distinguishing machine-owned fetched content from user edits once refresh, comments, and sync coexist. v1 makes this simple by fiat (decision 1: the whole body is Linear-owned), but the layout and refresh model still have to be explicit. + +** Generated entry layout + +#+begin_src org +*** TODO [#B] ENG-123 Title +:PROPERTIES: +:LINEAR-ID: <uuid> +:LINEAR-IDENTIFIER: ENG-123 +:LINEAR-URL: https://linear.app/.../ENG-123 +:LINEAR-TEAM-ID: <id> +:LINEAR-TEAM-NAME: ENG +:LINEAR-PROJECT-ID: <id> +:LINEAR-PROJECT-NAME: Foo +:LINEAR-STATE-ID: <id> +:LINEAR-STATE-NAME: In Progress +:LINEAR-ASSIGNEE-ID: <id> +:LINEAR-ASSIGNEE-NAME: Craig +:LINEAR-LABELS: [bug, p1] +:LINEAR-DESC-SHA256: <hash of last-fetched markdown> +:LINEAR-DESC-UPDATED-AT: <remote timestamp> +:END: + +Description text managed by Linear (org-rendered). + +**** Comments +***** <author> — <timestamp> +comment body +#+end_src + +*Store IDs and display names separately* for team, project, assignee, state, labels (and later cycle). Commands display names; they mutate by ID. This kills the per-render network name-lookup. + +*Provenance for the description* lives as a *hash + remote timestamp* in properties — not the full raw markdown. A large multiline markdown property is awkward in org and bad with folding. When the sync/no-op check needs the exact last-fetched markdown, fetch current remote markdown before deciding, or keep it in an internal cache keyed by =LINEAR-ID=. (See [[*Conflict handling][Conflict handling]].) + +** Refresh model — merge by ID, reconciled with the active-file output model + +The query spec's output model says *switching to a different view/query replaces the active file*. This spec's refresh says *don't wholesale-rewrite*. Both hold, for different actions: + +- *Switching source* (run a different view/query) → the issue set changes; replace the file contents after the dirty-buffer + conflict checks. One issue appears in one place. +- *Refreshing the same source* (=refresh-current-view=, =refresh-current-issue=) → *merge by =LINEAR-ID===: update each existing issue subtree in place, add new matches, drop issues no longer in the result. Per subtree, run the conflict check before overwriting a description that was edited locally but not yet pushed. + +A wholesale rewrite on same-source refresh would clobber un-pushed description edits; merge-by-ID + per-subtree conflict check is what protects them. + +* Proposed model — body is editable content, drawer is machine-managed metadata + +Organizing principle: the body holds what a human reads and writes (description, comments); the drawer holds structured fields commands manage. An =org-tidy= user edits body text + runs commands and never touches the drawer. + +** Description → body + +Render the description as the heading body (org-converted — see [[*Markdown vs org — the conversion question][conversion]]). Opening a task now shows its description; the org-tidy blank-entry problem disappears. The body is the editable region; an explicit command (decision 4) pushes edits back, behind the conflict gate. + +** Drawer = command-managed fields + +State (TODO keyword), priority, labels, project, assignee live in the drawer/heading and change via dedicated commands ("Set assignee, priority, labels" task), which resolve names→IDs. =org-tidy= users never need to open the drawer. + +** Comments as a body subtree + +Fetch comments (needs a query change — not pulled today) and render *oldest-first* as =****= → =*****= sub-headings (=<author> — <timestamp>=, body beneath), so the thread reads chronologically and "add comment" appends at the end. =pearl-add-comment= creates a new comment via =commentCreate= and inserts/refreshes the returned comment. Fetched comments are remote-owned (decision 2): editing an existing comment heading does *not* sync back in v1. + +*Comment shape (verified against the published schema).* =Issue.comments= → =CommentConnection= (nodes/pageInfo); each =Comment= has =body= (markdown — runs through the same conversion tier as the description), =createdAt=, and =user=. *=user= is nullable* — comments from integrations or bots have no user, carrying =botActor= / =externalUser= instead. The renderer must fall back to the bot/external actor name (or a literal like "(automation)") for the author rather than assuming a =user.name=. =commentCreate(input: CommentCreateInput!)= returns =CommentPayload= (=comment=, =success=); the input takes =body= + =issueId= (and optional =parentId=), with success checked the same way as issue creation before reporting. + +** Affordance + discoverable commands + +A one-line preamble note (body = description, edit + sync via command; Comments subtree = thread, add via command; fields = drawer, change via commands). But commands matter more than a note — expose discoverable ones that work from *anywhere inside an issue subtree*: + +=pearl-sync-current-issue=, =pearl-open-current-issue=, =pearl-add-comment=, =pearl-set-priority=, =pearl-set-assignee=, =pearl-refresh-current-issue=. + +** Sub-issues (later) + +Optional nested headings; out of scope for v1. + +* Markdown vs org — the conversion question + +Linear stores descriptions/comments as *markdown*; we want *org* in the body. The directions differ in difficulty. + +- *org → markdown (push):* =ox-md= is built in, but it is *not* round-trip-faithful for the subset Linear uses (see [[*ox-md rejected for push][ox-md rejected for push]]). Push is therefore a hand-rolled inverse of the fetch converter. +- *markdown → org (fetch):* no built-in. The only place pandoc is tempting. + +** ox-md rejected for push + +The original recommendation was =org-export-string-as ... 'md= for the push direction. Empirical testing (2026-05-23) of =org→md(md→org(x))= over the conversion matrix showed *zero of nine samples round-trip cleanly*. =ox-md= injects a =# Table of Contents= header, inverts emphasis (org =*italic*= → md =**bold**=), *drops checkbox markers* (=- [x] done= → =- done=), converts fenced code to 4-space indented blocks (losing the language), and reindents lists. + +This breaks the conflict gate two ways: the no-op guard compares =hash(org→md(body))= against the stored =LINEAR-DESC-SHA256= (hash of the last-fetched markdown), so a lossy push makes *every* no-op sync look like an edit; and the lossy output would *corrupt content pushed back to Linear* (dropped checkboxes, lost code-fence languages). This is the same lossy-round-trip failure mode the spec already rejected pandoc for — it applies to =ox-md= too. + +The push converter (=pearl--org-to-md=) is therefore hand-rolled as the symmetric inverse of the fetch converter (=pearl--md-to-org=), which makes round-trips byte-stable for the supported subset. Owning both directions also keeps the conversion tier self-consistent. *Two documented lossy edges remain* (inherent to the fetch converter, not the push side): a markdown =# heading= renders to a bold line on fetch and stays a bold line on push (restoring =#= would fork the org outline); single-asterisk markdown italics are unsupported on fetch (only =_underscore_= italics convert). + +** Pandoc — pros/cons + +- *Pros:* full-fidelity bidirectional GFM↔org; one tool; battle-tested. +- *Cons:* hard external-binary dependency (MELPA-hostile; users without it get broken sync); subprocess per conversion; *lossy round-trip* (pandoc reflows/normalizes → spurious diffs on no-op fetch/push); cross-platform/version drift. + +** Recommendation — pure-elisp default, pandoc optional + +Hand-roll *both* directions: push via =pearl--org-to-md= (the inverse of the fetch pass — see [[*ox-md rejected for push][ox-md rejected for push]]), fetch via the lightweight md→org pass. No dependency, byte-stable round-trips. Pandoc is an *optional* enhancement: if =(executable-find "pandoc")= and a defcustom opts in, route both directions through it. Detected, never required — MELPA-safe. + +** Conversion matrix (the testable contract) + +"High-frequency constructs" needs a precise, testable subset. Unsupported constructs are *preserved as literal text*, never emitted as malformed org. + +| Markdown | Org | Note | +|----------+-----+------| +| =**bold**= | =*bold*= | | +| =*italic*= / =_italic_= | =/italic/= | underscores in identifiers must not trigger emphasis | +| =`code`= | =~code~= | | +| =```lang ... ```= | =#+begin_src lang ... #+end_src= | language preserved | +| =- item= / =* item= | =- item= | | +| =1. item= | =1. item= | | +| =- [ ]= / =- [x]= | =- [ ]= / =- [X]= | checkboxes | +| =[text](url)= | =[[url][text]]= | | +| => quote= | =#+begin_quote ... #+end_quote= | | +| =# Heading= | *bold line*, NOT an org heading | an org heading would fork the issue subtree and corrupt structure | +| tables / HTML / footnotes | literal pass-through | preserved, not converted | + +The =# Heading= → bold-line rule is load-bearing: converting a markdown heading inside a description to a real org heading would split the issue's subtree. + +* Conflict handling + +The round-trip-drift guard is necessary but not sufficient — it prevents no-op churn; it doesn't define conflicts. Promote it from a note to a *phase gate on sync-back*. The sync command compares three things: + +- *last-fetched* Linear markdown (hash in =:LINEAR-DESC-SHA256:=), +- *current org-rendered* markdown (re-render the body to md, hash it), +- *current remote* markdown / =updatedAt= (fetch before pushing). + +Outcomes: + +- org == last-fetched → no local edit → *no API call* (no-op guard). +- org changed, remote == last-fetched → clean push. +- org changed *and* remote changed since last fetch → *conflict*: stop, refuse to push, message the user (decision 5). Resolution workflows (diff/merge, local/remote-wins) are vNext. + +* Parsing — org-element, not regex + +Current parsing assumes a level-3 heading with a drawer immediately after and walks lines/regex. Once bodies and comment subtrees exist, that's brittle (misread drawers, nested comment headings mistaken for issues). Spec an =org-element=-based parser: locate issue headings by the durable =:LINEAR-ID:= property, read properties via org APIs, treat depth structurally — never =^\*\*\*= regexes. + +* Internal representation + +Normalize API responses into internal plists/structs *before* rendering, so the renderer never sees whether Linear returned a vector, =null=, or an omitted field. Comments, assignees, cycles, and views multiply the missing/null/vector handling otherwise. Model boundaries (filter compilation, API transport, issue/comment models, org rendering, org parsing, sync orchestration, commands) stay as *logical* sections — see [[*Review dispositions][Review dispositions]] on keeping a single file. + +* Actions a user wants in the body space + +- *Edit the description* in place → explicit sync (push, behind the conflict gate). +- *Read the comment thread* without leaving Emacs. +- *Add a comment* → =commentCreate= (append a sub-heading). +- (later) navigate sub-issues. + +Field changes (assignee/priority/labels/state) stay command-driven, not body edits. + +* Impact on existing todo.org tasks + +Gives concrete shape to three already-open feature tasks; implement them together: + +- =Sync title and description back to Linear= — description-in-body + explicit push. *Phase title sync separately* from description (its own last-fetched-title hash + conflict behavior; note the existing bracket-stripping lossiness). Keep TODO-keyword state sync as the only automatic heading mutation in the first body-editing phase. +- =Add a comment to an issue from Emacs= — the comment subtree + =commentCreate=. +- =Set assignee, priority, and labels from Emacs= — command-driven drawer fields (mutate by ID). + +Cross-cuts the query spec at the shared write path and the active-file/refresh model. + +* Phased implementation + +1. *Description → body (read-only) + namespaced properties.* Move description out of =:DESCRIPTION:= into the body; switch to =LINEAR-*= properties storing IDs + display names; provenance hash + timestamp. Characterization test of the old shape first, then the new render; confirm =org-tidy= no longer shows a blank entry. +2. *org-element parser.* Locate by =:LINEAR-ID:=, structural depth; replaces regex parsing before subtrees land. +3. *Conversion tier.* Hand-rolled org→md push (inverse of the fetch pass; =ox-md= rejected for lossy round-trips) + lightweight md→org fetch per the matrix; unit-test the matrix (Normal/Boundary/Error) and the no-op round-trip invariant. +4. *Refresh = merge by ID* + per-subtree conflict check; reconcile with the active-file replace-on-switch model. +5. *Description sync-back (explicit command)* behind the conflict gate (the round-trip guard is the phase gate). Title sync as a separate step. +6. *Comments* — add to the fetch query; render oldest-first; =add-comment= via =commentCreate=. +7. *Pandoc optional path* + the affordance line + discoverable commands. +8. *(later)* sub-issues, comment editing, local notes, save-hook automation, interactive conflict resolution. + +* Test strategy + +*Characterization (before changing rendering):* old shape renders description in =:DESCRIPTION:= with empty body; dirty visiting buffer not overwritten; state sync uses only matching issue headings; current parser behavior with drawer placement. + +*Per phase:* description after =:END:= with no =:DESCRIPTION:= property; org-element parser extracts properties even with body text + comment subtrees; comments render with IDs/timestamps oldest-first; =add-comment= makes one mutation and inserts/refreshes the returned comment; no-op description sync makes *no* API call; local-edit + remote-unchanged pushes the expected markdown; local-edit + remote-changed refuses with a conflict message; unsupported markdown stays readable and doesn't corrupt org. + +*Golden rendering:* small, intentional string snapshots of representative issue entries. + +* Open decisions + +None blocking v1 — the five agreed decisions resolved the ownership, conflict, sync-trigger, comment-immutability, and property-naming questions. Remaining calls are implementation-level (exact converter edge handling, command key bindings). + +* vNext + +- Local-only notes under issues, if a clean ownership representation emerges. +- Editing existing comments — only those authored by the current Linear user. +- Automatic description sync on save (after no-op detection + conflict handling are proven). +- Interactive conflict handling: diff/merge, local-wins, remote-wins, manual merge. +- Read-only text properties on remote-owned regions (after the command UX exists). +- Sub-issue rendering. + +* Review dispositions + +All review recommendations were accepted and incorporated above except the following, modified with reasons: + +1. *"Split representation from network/API code" into modules → modified.* Adopted the *logical* boundaries (filter compilation / transport / models / rendering / parsing / sync / commands) and the "normalize before rendering" discipline, but *kept a single file* for v1. The package is a single-file =pearl.el= aiming at MELPA, where single-file is a virtue; splitting into multiple files is a larger restructuring with its own review. Logical sections + pure helpers get the unit-testability the review wants without the file split. Revisit multi-file only if size forces it. + +2. *Read-only text properties on remote-owned regions → deferred (the review's own lighter recommendation).* v1 detects edits to remote-owned generated areas and warns/refuses to push rather than making regions buffer-read-only, which would frustrate org users and complicate tests. Hard read-only is in vNext. + +Everything else — Linear-owned body, namespaced =LINEAR-*= properties, IDs-with-display-names, hash+timestamp provenance (not raw-markdown-in-property), merge-by-ID refresh reconciled with active-file replace, conflict detect/refuse/message as a phase gate, explicit-command sync, separate title/description sync, org-element parsing, the conversion matrix, oldest-first read/add-only comments, normalized model objects, discoverable subtree commands, and the full test strategy — was accepted as written. diff --git a/docs/issue-sort-order-spec.org b/docs/issue-sort-order-spec.org new file mode 100644 index 0000000..f49e869 --- /dev/null +++ b/docs/issue-sort-order-spec.org @@ -0,0 +1,65 @@ +#+TITLE: pearl — Interactive Sort/Order Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-24 +#+STARTUP: showall + +* Status + +*DRAFT — design proposal; nothing in =pearl.el= has changed.* Open questions for Craig at the end. + +Companion to [[file:issue-query-spec.org][issue-query-spec.org]], which defines the =:sort= / =:order= the saved-query layer already supports. This doc covers changing the order of the *current* view interactively, without hand-editing a saved query. + +* Problem + +v1 supports =:sort= (=updated= / =priority= / =title=) and =:order= (=asc= / =desc=) on saved queries. But to change how the active file is ordered, the user has to edit =pearl-saved-queries= (or the source plist) by hand and re-run. There's no "sort this view by priority, descending" command. For a view you're actually looking at, that's the natural thing to want. + +* Current state + +- =pearl--sort-issues= (query spec) applies =:sort= / =:order= client-side at the render boundary, so a refresh always lays headings out the same way. +- =:sort= = =priority= / =title= are client-side; =created= / =updated= map to the server =orderBy= (the only fields Linear's API orders on). The query spec documents this split. +- The active file's =#+LINEAR-SOURCE:= header records the source plist, including any =:sort= / =:order=, so =refresh-current-view= reproduces the ordering. + +* Proposed design + +** The command + +=pearl-set-sort= (interactive), run in the active file: + +1. =completing-read= the sort key: =updated=, =created=, =priority=, =title=. +2. =completing-read= (or a toggle) the order: =asc= / =desc=. +3. Update the =:sort= / =:order= in the active file's recorded =#+LINEAR-SOURCE:=. +4. Re-order the view (see below). + +A =pearl-toggle-sort-order= convenience command just flips =asc=/=desc= on the current sort and re-orders. Both go on the transient menu (a small "Sort" group, or under View). + +** Re-order in place vs refetch + +The split matters for whether a sort change needs the network: + +- *Client-side sorts* (=priority=, =title=): the issues are already in the buffer. Re-sort in place — reparse the issue subtrees, reorder them, rewrite. No refetch. Fast, works offline. +- *Server-side sorts* (=created=, =updated=): the ordering comes from the server =orderBy=, and the fetch may have been truncated at the page cap, so the correct order needs a refetch with the new =orderBy=. Re-run the source (the =refresh-current-view= path) with the updated sort. + +So =set-sort= decides: client-side key → re-sort the buffer; server-side key → refetch. The command reports which it did. + +** Persistence + +The change updates the active file's =#+LINEAR-SOURCE:= so a later =refresh-current-view= keeps the new order. Whether it also writes back to a named saved query in =pearl-saved-queries= is open question 3 — my lean is no by default (the active file is the scratch view; saved queries are the durable definitions), with an explicit "save this ordering to the query" as a separate step. + +* Proposed v1 decisions (this feature) + +1. =pearl-set-sort= + =pearl-toggle-sort-order=, both on the transient menu. +2. Client-side keys re-sort the buffer in place; server-side keys refetch. +3. The change updates the active file's recorded source so refresh preserves it. +4. Completion is over the known keys/orders, never free text. + +* vNext / out of scope + +- Multi-key sort (e.g. priority then updated). +- Per-heading manual reordering that sticks across refresh. +- Exposing the full Linear =orderBy= surface if the API later un-gates the =[INTERNAL]= per-field sort. + +* Open questions for Craig + +1. *Command vs transient-only*: a plain =M-x pearl-set-sort= with two completing-reads, or a dedicated transient sub-menu with one-key sort toggles (=p= priority, =u= updated, =t= title, =o= flip order)? The transient reads faster for a frequent action. +2. *In-place re-sort fidelity*: re-sorting client-side means reparsing and rewriting issue subtrees in the buffer. Acceptable, or prefer always-refetch for simplicity even when a client-side sort wouldn't need it? +3. *Write-back*: should changing the sort offer to persist it to the originating saved query, or only ever update the active file's header? diff --git a/docs/labels-as-org-tags-spec.org b/docs/labels-as-org-tags-spec.org new file mode 100644 index 0000000..a1bb413 --- /dev/null +++ b/docs/labels-as-org-tags-spec.org @@ -0,0 +1,81 @@ +#+TITLE: pearl — Render Linear Labels as Org Tags Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-24 +#+STARTUP: showall + +* Status + +PROPOSED — awaiting review. Implements the =todo.org= task "Org tags should reflect the issue's Linear labels" (filed 2026-05-24 after a hardcoded personal =#+filetags:= value was removed from the header writer in 952cfe7). + +* Problem + +Pearl used to stamp a hardcoded personal =#+filetags:= value on every fetched file — file-wide, unrelated to any issue. That's gone. What's missing is the useful behavior: an issue's Linear labels should appear as org tags *on that issue's heading*, so the org-native gestures work — filter by tag, build a tag agenda, sparse-tree on =:bug:=. Today labels live only in the =:LINEAR-LABELS:= drawer (=[bug, backend]=), which org's tag machinery can't see. + +* Current state + +- =pearl--format-issue-as-org-entry= renders the heading as =** <STATE> [#P] <title>= with no tags, and writes the labels into the =:LINEAR-LABELS:= drawer as =[name, name]=. +- =pearl--normalize-issue= gives each issue =:labels= as a list of plists with =:name=. +- =pearl--issue-title-at-point= already extracts the title with =(org-get-heading t t t t)= — the four flags strip the keyword, priority cookie, *tags*, and comment markers. So title sync is already tag-aware; adding heading tags will not corrupt the title round-trip. +- =pearl-set-labels= changes an issue's labels (completing-read over team labels), pushes, and rewrites the =:LINEAR-LABELS:= drawer. + +* Proposed design + +** Tag slugify: label name → org tag + +A new pure helper =pearl--label-name-to-tag=. Org tags are restricted to =[[:alnum:]_@#%]= — notably *no hyphens or spaces* (unlike TODO keywords, which allow hyphens). So this slugify differs from the keyword one: + +- Downcase (tags are case-sensitive in Org; lowercase is the convention). +- Replace each run of characters outside =[[:alnum:]_]= with a single =_=. +- Trim leading/trailing =_=. + +Examples: =Bug= → =bug=, =Needs Review= → =needs_review=, =P1= → =p1=, =backend/api= → =backend_api=, =UI/UX= → =ui_ux=. A label that slugifies to empty is dropped. + +(Contrast with =pearl--state-name-to-keyword= from the workflow-states spec, which upcases and uses hyphens. Two different targets, two different slugify rules — keep them as separate, clearly-named helpers.) + +** Render tags on the issue heading + +=pearl--format-issue-as-org-entry= appends the issue's label tags to the heading line in org tag syntax: + +: ** TODO [#B] Fix the thing :bug:backend: + +Slugify each label name, de-duplicate (preserving order), and join as =:t1:t2:=. No labels → no tag string. The =:LINEAR-LABELS:= drawer stays as the canonical structured store (it holds the exact Linear names, which the tag form lossily slugifies); the heading tags are the derived, org-native view. + +Only *issue* headings get tags. The parent view heading and the Comments / individual-comment headings carry none. + +** Keep the drawer authoritative; tags are a view + +The =:LINEAR-LABELS:= drawer remains the source of truth for the issue's labels (it survives slugify collisions and preserves the display names). =pearl-set-labels= continues to push and rewrite the drawer, and additionally re-renders the heading's tag string so the two stay consistent after a label change. + +** v1 is render-only (fetch direction) + +Editing the heading's tags by hand does *not* push to Linear in v1. The way to change labels stays =pearl-set-labels= (which now updates both the drawer and the heading tags). Bidirectional sync — parse the heading's tags on save and reconcile them against Linear's label set — is deferred (see out of scope); it needs the same kind of conflict gate the description/title/comment syncs have, and label *creation* semantics (a tag with no matching Linear label) to be decided. + +* Files touched + +- =pearl.el=: new =pearl--label-name-to-tag=; =pearl--format-issue-as-org-entry= (append tag string to the heading); =pearl-set-labels= (re-render heading tags after a label change). The =:LINEAR-LABELS:= drawer line is unchanged. +- Tests: new cases for =pearl--label-name-to-tag= (normal, multiword, punctuation, collision, empty); a render test (issue with labels → heading carries the slugified tags); a regression test that =pearl--issue-title-at-point= / title sync still returns the bare title with tags present; a =pearl-set-labels= test that the heading tag string updates. +- =README.org=: note in the Fields / "active org file" section that labels render as heading tags; mention the drawer remains the structured store. + +* Test plan + +- *Tag slugify*: =Bug=→=bug=, =Needs Review=→=needs_review=, =UI/UX=→=ui_ux=, =P1=→=p1=, collision de-dup, empty-after-slug dropped. +- *Render*: an issue with labels =("Bug" "Backend")= renders =** … :bug:backend:= and still carries =:LINEAR-LABELS: [Bug, Backend]= in the drawer. +- *Title-sync regression*: with tags on the heading, =pearl--issue-title-at-point= returns the bare title (no tags, no keyword), so a no-op title sync still matches and a title edit still round-trips. +- *set-labels*: after changing labels, the heading tag string reflects the new set (and the drawer too). + +* Migration + +Additive — no breaking change. Existing files gain heading tags on the next fetch. The removed =#+filetags= is already gone (952cfe7). No defcustom changes. + +* Open questions for review + +1. *Tag case.* Lowercase (=Bug= → =bug=) for org-tag convention, or preserve Linear's case (=Bug= → =Bug=)? Lowercase is my lean; it matches how most org users tag and avoids =Bug= vs =bug= duplication. +2. *=#+TAGS:= declaration.* Should the file declare =#+TAGS:= with the union of label slugs (for tag-completion in the buffer), the way the workflow-states spec derives =#+TODO:=? Bonus, not required for the feature. My lean: defer to a follow-up to keep v1 focused. +3. *Tag inheritance.* Org tag inheritance is on by default, so an issue's tags apply to its Comments subtree in agenda/inheritance contexts. Harmless (a comment "inheriting" =:bug:= rarely matters), but flagging. Disable inheritance for these files, or accept it? My lean: accept it. +4. *Bidirectional sync* (edit heading tags → push labels) — confirm it's out of scope for v1. + +* vNext / out of scope + +- Bidirectional tag editing (heading tags → Linear labels) with a conflict gate and label-creation semantics. +- =#+TAGS:= completion declaration. +- Color/face mapping from Linear label colors to org tag faces. diff --git a/docs/todo-keywords-from-workflow-states-spec.org b/docs/todo-keywords-from-workflow-states-spec.org new file mode 100644 index 0000000..fc0a51c --- /dev/null +++ b/docs/todo-keywords-from-workflow-states-spec.org @@ -0,0 +1,209 @@ +#+TITLE: pearl — Derive Org TODO Keywords from Linear Workflow States Spec +#+AUTHOR: Craig Jennings +#+DATE: 2026-05-24 +#+STARTUP: showall + +* Status + +READY — implementation-ready, awaiting Craig's final go. Reviews incorporated (2026-05-24, rounds 1–4); round 4 returned a Ready verdict with no blocking findings. Implements the =todo.org= task "Derive the org TODO keywords from the Linear workflow states". One implementation prerequisite remains (verify =WorkflowState.position=; see prerequisites). + +* Problem + +The generated file's =#+TODO:= line is fixed — either the hardcoded =TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE= or a copy of the user's global =org-todo-keywords= — and =pearl-state-to-todo-mapping= is a static six-entry default. Neither reflects a team's real Linear states (Dev Review, PM Acceptance, Icebox, Grooming, …). + +Org only cycles a heading to a keyword listed in the file's =#+TODO:=. So you cannot move a ticket to "Dev Review" by cycling its TODO keyword: the keyword isn't in the line, and there's no mapping entry for it. =pearl-set-state= already reaches any state (id-based, header-independent), but the keyword-cycle path — the natural org gesture — is stuck on the hardcoded six. + +The =#+TODO:= line therefore becomes *generated infrastructure* for the sync-back write path. If it is missing a rendered keyword, stale after a merge refresh, or ambiguous after slugification, org-native state changes silently stop being a trustworthy write path. The header-and-reverse-lookup contract below is written to that bar. + +* Current state + +- =pearl--build-org-content= writes =#+TODO:= from =org-todo-keywords= (or the hardcoded fallback). It's a pure function. +- =pearl--map-linear-state-to-org= renders an issue's keyword by =assoc= on =pearl-state-to-todo-mapping= (fallback =TODO=). +- =pearl--map-org-state-to-linear= resolves a cycled keyword back to a Linear state *name* by =rassoc= on the same mapping; =pearl--process-heading-at-point= then calls =pearl--update-issue-state-async= with that name + team id. +- =pearl--get-todo-states-pattern= builds the full-file scan regex from the mapping's keywords (cached in =pearl-todo-states-pattern=). +- =pearl--team-states= is a *synchronous, cached* accessor (blocks via =pearl--wait-for= on first fetch, then serves from =pearl--cache-states=). =pearl-set-state= already calls it synchronously from command context. +- The team-states GraphQL query fetches =id name color= only. Issue queries already fetch state =type= (but not workflow-state =position=). +- The same-source refresh path (=pearl--merge-query-result= → =pearl--merge-issues-into-buffer=) updates issue subtrees in place and only rewrites the run-at / count / truncation header lines via =pearl--update-source-header=. It does *not* rebuild the file, so it does not touch =#+TODO:= today. + +* Decisions + +Settled inputs for v1 (A1 / B2 / C-yes agreed with Craig 2026-05-24; the remainder resolved from review): + +- *A1 — union.* A file may hold issues from several teams. Build one =#+TODO:= line from the union of all involved teams' states, de-duplicated by slug. +- *B2 — derived replaces.* The keyword is always the slugified Linear state name. =pearl-state-to-todo-mapping= is *removed*, not layered. One source of truth (Linear), an honest header, a deterministic round-trip (keyword = =slugify(name)= everywhere, no stored reverse map). +- *C-yes — defer cross-team slug collisions.* Documented known limitation (see out of scope). +- *Done-side types.* =completed=, =canceled=, *and* =duplicate= render after the =|=; =triage=, =backlog=, =unstarted=, =started= before it. Split by =type=, never by name. +- *Header coverage guarantee.* Every keyword visible on a heading in the buffer must be declared in =#+TODO:= — that header powers org cycling and sync-back. The header is the slug-union of (a) every visible issue heading's state and (b) every team's full state set that was fetched successfully. (a) guarantees coverage even when a team's state fetch fails; (b) makes absent states cyclable when available. A failed team's only degradation is that you can't cycle to a state none of its visible headings is in. The hardcoded line is used only when there are no states at all. The "visible headings" set differs by path: a full rebuild reads the normalized issue list; a merge refresh reads the *final buffer* (so retained/skipped dirty subtrees are covered — see below). +- *Merge coverage via final-buffer scan.* For merge refresh the header is rebuilt from the final displayed buffer (scan every Linear issue heading's current TODO keyword) unioned with the fetched team states — not from the fetched issue list alone, which omits retained dirty subtrees. The buffer scan subsumes the fetched issues (they're in the buffer) and directly validates the invariant users see. +- *Issue-own / position-less ordering.* Full workflow states (from team-states) order by =position=; states drawn from headings or the issue list carry no workflow =position=, so they append in first-seen order within their active/done partition, de-duped by slug. +- *Slugify is Unicode-aware and locale-independent.* +- *Same-team slug collision.* The pure gather/derive layer returns collision metadata (the colliding slug + states); the render/sync layer logs it. The header de-dups; sync-back resolves the keyword to the *first state by =position=*. Returning the metadata keeps the lossy transform testable without capturing =message=. +- *Unknown keyword behavior splits by path.* Interactive current-heading sync (an =org-todo= cycle) whose keyword resolves to no team state raises a =user-error= naming the keyword + team. The full-file save scan reports and *skips* the unknown heading and continues to the rest — one stale heading must not abort syncing the others or surface as an after-save-hook error. +- *Store the state type in the drawer.* Render a =:LINEAR-STATE-TYPE:= drawer field (the issue query already fetches state =type=). The active/done side of a keyword is a function of =type=, and the merge final-buffer scan recovers a retained heading's keyword but not its type from name/id alone — so the type must travel with the heading. Classification on the merge scan: by the heading's own =:LINEAR-STATE-TYPE:= when present (deterministic); else (a legacy heading written before this field) preserve the keyword's current side from the buffer's parsed TODO config — done side if the keyword is in =org-done-keywords=, active otherwise; else (no parseable =#+TODO:= / keyword unknown to Org) default to the active side and log a warning naming the keyword and issue. Retained headings thus keep their old Org done/active semantics until a clean refresh re-derives them from Linear. + +* Proposed design + +** Slugify: state name → org keyword + +A new pure helper =pearl--state-name-to-keyword=: + +- Upcase (locale-independent — Emacs =upcase=, no locale-sensitive casing). +- Replace each run of characters *not* matched by =[[:alnum:]]= with a single hyphen. =[[:alnum:]]= is Unicode-aware in Emacs, so accented and non-Latin letters are preserved rather than stripped. +- Trim leading/trailing hyphens. +- If the result is empty (an all-punctuation/symbol name), fall back to =TODO=. + +Expected outputs: + +| Input | Output | +|--------------------+-------------------| +| =Dev Review= | =DEV-REVIEW= | +| =In Progress= | =IN-PROGRESS= | +| =Todo= | =TODO= | +| =PM Acceptance= | =PM-ACCEPTANCE= | +| =Backlog (prioritized)= | =BACKLOG-PRIORITIZED= | +| =Dev-Review= | =DEV-REVIEW= | +| =Ångström= | =ÅNGSTRÖM= | +| =!!!= | =TODO= (empty fallback) | + +Note =Dev Review= and =Dev-Review= both produce =DEV-REVIEW= — a same-team collision (handled below). The existing default mapping was effectively slugify already (=Todo=→=TODO=, =In Progress=→=IN-PROGRESS=, …), so slugify reproduces today's keywords for those states. + +** Same-team slug collisions + +When two states in one team slugify to the same keyword (=Dev Review= and =Dev-Review=), the =#+TODO:= line lists the keyword once (de-dup, first-seen by =position= wins its slot). Sync-back resolves that keyword to the *first state by =position=* and logs a one-line warning naming the colliding states, so the behavior is deterministic and visible. Cross-team collisions are deferred (out of scope) — sync still resolves correctly per the heading's own team, but the header can't distinguish them. + +** Derive the =#+TODO:= line + +A new pure helper =pearl--derive-todo-line= takes an ordered list of states (each =(:name :type :position)=) and returns the keyword string: + +- Partition by =type=: done-side = =completed=/=canceled=/=duplicate=; active-side = everything else. +- Within each side, preserve the input order (the caller supplies states already ordered — see Multi-team ordering). +- Slugify each name; de-duplicate by slug, preserving first-seen order. +- Result: ="ACTIVE-1 ACTIVE-2 … | DONE-1 DONE-2 …"=. + +When the state list is empty, return the hardcoded =TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE= so the file is always valid. + +** Multi-team ordering + +=position= is meaningful within a team, not across teams. To keep the header deterministic: + +1. Teams are ordered by *first-seen order in the sorted issue list* (the issues are already sorted before render). +2. Within each team, states are ordered by Linear =position=. +3. The union concatenates teams in that order, then de-dups by slug (first-seen wins), then the derive-line partitions by type. + +So the header order is stable across runs regardless of hash/traversal order. + +** Gather the states (pipeline) + +Because =pearl--team-states= is synchronous-with-cache and =pearl-set-state= already calls it from command context, the render path gathers states synchronously without restructuring into async callbacks: + +1. After issues are normalized and sorted, collect the distinct =LINEAR-TEAM-ID= values in first-seen order. +2. For each team, call =pearl--team-states= (cached after the first hit). Show a progress message while a fetch blocks; on a team's fetch failure, log it and continue (per the coverage guarantee). +3. Build the union: every displayed issue's own state, plus the full states of each team that fetched. Order per Multi-team ordering, de-dup by slug. +4. Hand the union to =pearl--build-org-content=. + +=pearl--build-org-content= stays pure: it gains a =states= argument (the ordered union list) and writes the derived =#+TODO:= via =pearl--derive-todo-line=. The async layer does the synchronous gather just before calling it. One synchronous, cached team-states fetch per distinct team per session — usually one or two; multi-team views do N bounded blocking fetches. + +The team-states query gains =type= and =position= (currently =id name color=), and the cache entry keeps them. + +** Render each issue's keyword + +=pearl--format-issue-as-org-entry= renders the heading keyword as =pearl--state-name-to-keyword(issue-state-name)= instead of =pearl--map-linear-state-to-org=. Safe because the header always includes each displayed issue's own state (coverage guarantee). It also writes a =:LINEAR-STATE-TYPE:= drawer field next to =:LINEAR-STATE-ID:= / =:LINEAR-STATE-NAME:=, so a later merge scan can classify a retained heading onto the correct side of the =|= from the heading itself (see the classification decision). + +** Generated header update on refresh + +The same-source merge refresh must keep the header honest: a refresh can add an issue from a team whose state keyword isn't yet declared, or surface a renamed/added/removed state — *and* it retains existing subtrees that the merge skips. =pearl--merge-issues-into-buffer= keeps a dirty existing subtree (unpushed body edits) without re-rendering it, and keeps a dirty issue that's absent from the refreshed result rather than dropping it. Those headings stay visible after the refresh, so their keywords must be declared too. + +A new helper =pearl--update-derived-todo-header= rewrites the =#+TODO:= line in place (creating it if absent). It derives from the *final displayed buffer*: scan every Linear issue heading (one carrying =LINEAR-ID=) for its current TODO keyword *and its =:LINEAR-STATE-TYPE:= drawer*, union those with the fetched team states (per the ordering rules), classify each onto the active/done side (by type when known; otherwise the fallback in the classification decision), and rewrite the line. =pearl--merge-query-result= calls it after the merge and the state gather, alongside =pearl--update-source-header=. Scanning the final buffer — rather than building from the fetched issue list — is what guarantees retained/skipped subtrees are covered, and it directly validates the invariant: every keyword visible in the buffer is declared on the correct side of the bar. + +** Sync-back: cycled keyword → Linear state + +=pearl--process-heading-at-point= resolves the cycled keyword via the heading's team rather than the removed mapping: + +1. Read the heading's TODO keyword + =LINEAR-TEAM-ID=. +2. =pearl--team-states= (cached) for that team; find the state whose =slugify(name)= equals the keyword (first by =position= on a collision). +3. If a state matches, push it via =pearl--update-issue-state-async= (unchanged; it resolves name → id per team). +4. If *no* state matches (stale buffer keyword after a workflow change, or an old mapped keyword from a pre-upgrade file), the behavior depends on the path. Interactive current-heading sync (an =org-todo= cycle) raises a =user-error= naming the keyword + team and suggesting a refresh or =pearl-clear-cache=. The full-file save scan (=pearl-sync-org-to-linear=, non-=org-todo= path) reports the unknown heading (a =pearl--log= / message) and *skips* it, continuing to the rest — one stale heading must not abort the scan or fail an after-save hook. Neither path ever silently no-ops or pushes a wrong state. + +No persisted reverse map: the keyword is always =slugify(name)=, so the match recomputes from the team's live states. + +** The full-file scan pattern + +=pearl--get-todo-states-pattern= no longer builds from the mapping. The full-file sync scan (=pearl-sync-org-to-linear=, non-=org-todo= path) builds its keyword alternation from the buffer's own =org-todo-keywords-1= (what Org parsed from =#+TODO:=), so it matches whatever the derived header declared, with no stale cache. The =pearl-todo-states-pattern= / =pearl--todo-states-pattern-source= caches are removed with the mapping. + +** User-facing errors + +None of these fail silently: an unknown heading keyword on sync-back (=user-error= naming keyword + team), a missing =LINEAR-TEAM-ID= on a heading being synced, a team state fetch that fails during render (logged + progress/skip message), and a same-team slug collision (logged warning). Each names the offending value. + +* Implementation prerequisites + +- *Verify =WorkflowState.position=* against the current Linear schema or a live query before implementation. Issue queries fetch state =type= today but not workflow-state =position=. If =position= is unavailable, fall back to the order the API returns states in (still deterministic per fetch) and note it. +- Confirm the Linear state =type= enum is =triage/backlog/unstarted/started/completed/canceled/duplicate= (already verified in =docs/issue-query-spec.org=). +- Only =pearl--team-states= gains the =type=/=position= fields. =pearl-get-states-async= / =pearl-get-states= (used by creation flows) fetch =id name color= and are intentionally left unchanged — this feature doesn't depend on them. The two query shapes diverging is acceptable for v1; aligning them is optional follow-up cleanup. + +* Phased implementation plan + +Ordered so dependencies land first. + +1. *Pure core.* =pearl--state-name-to-keyword= and =pearl--derive-todo-line= + their tests (no I/O). Everything else depends on these. +2. *Query + gather.* Add =type=/=position= to the team-states query (after the position verification); add the synchronous gather helper (distinct teams → union with coverage guarantee + multi-team ordering). +3. *Full rebuild.* =pearl--build-org-content= takes =states=, writes the derived header; =pearl--format-issue-as-org-entry= renders via slugify and adds the =:LINEAR-STATE-TYPE:= drawer field. Assert the rebuilt header declares every rendered heading keyword. +4. *Merge refresh.* =pearl--update-derived-todo-header= (final-buffer scan + active/done classification by the heading's =:LINEAR-STATE-TYPE:=, with the org-done-keywords fallback) wired into =pearl--merge-query-result=. +5. *Sync-back.* Team-aware resolve in =pearl--process-heading-at-point= with unknown-keyword refusal; scan pattern from =org-todo-keywords-1=. +6. *Remove the mapping.* Delete =pearl-state-to-todo-mapping=, =pearl--map-linear-state-to-org=, =pearl--map-org-state-to-linear=, =pearl-todo-states-pattern=, =pearl--todo-states-pattern-source=. Replace =test-pearl-mapping.el= with =test-pearl-keywords.el= (keep the regression class: a changed header/keyword set affects full-file scan with no stale cache). +7. *Docs.* README state-mapping section + customization table; migration notes. + +* Test plan + +- =pearl--state-name-to-keyword=: ASCII names, punctuation, repeated punctuation, high-ASCII/accented, double-byte, combining characters, emoji/symbol-only → =TODO=, empty string, =Dev Review= vs =Dev-Review= collision, a real =Todo= alongside an empty-derived =TODO=. +- =pearl--derive-todo-line=: active/done partition *including =duplicate= after the bar*, per-team =position= ordering, deterministic multi-team order, duplicate-slug first-wins, empty-states fallback. +- *Full rebuild*: =build-org-content= with a state set emits the derived =#+TODO=; the header declares every rendered heading keyword; an issue in =Dev Review= renders the keyword =DEV-REVIEW= on its level-2 heading. +- *Merge refresh*: a same-source refresh where a newly fetched issue introduces =DEV-REVIEW= updates the buffer's =#+TODO:= line (creates it if missing). +- *Merge refresh — retained dirty subtree (absent from result)*: an old dirty issue in =QA-REVIEW= is gone from the refreshed result, is kept by the merge, and the rewritten =#+TODO:= still declares =QA-REVIEW=. +- *Merge refresh — skipped dirty subtree (still in result)*: a dirty issue still present is skipped (not re-rendered), and the rewritten header still declares its current kept keyword even if it differs from the fetched issue's new state. +- *Merge refresh — done-side classification of a type-less retained heading*: a retained dirty heading whose keyword was on the done side, whose team-state fetch fails and which lacks =:LINEAR-STATE-TYPE:= (legacy), keeps its keyword *after* the =|= via the org-done-keywords fallback. Same setup for an active retained heading keeps it *before* the bar. A missing/unparseable old header defaults the unknown keyword to active and logs the ambiguity. +- *Drawer carries the type*: a freshly rendered issue's drawer includes =:LINEAR-STATE-TYPE:=, and a merge scan classifies it by that field without the fallback. +- *Partial failure*: a multi-team result where one team's state fetch fails still declares every rendered keyword (issue-own states in the header) and renders without error; the two issue-own fallback states from the failed team order deterministically (first-seen within partition). +- *Sync-back*: =DEV-REVIEW= resolves through the heading's team states; a same-team collision resolves to first-by-position. +- *Unknown keyword by path*: interactive current-heading sync of an unknown keyword raises =user-error=; the full-file scan reports and skips it and still syncs the other headings. +- *Collision metadata*: the pure gather/derive layer returns the colliding slug + states (asserted directly, no =message= capture). +- *Migration/regression*: an old mapped keyword no longer in the derived header does not silently push a wrong state (interactive refuses; scan skips). +- *Scan pattern*: the full-file scan matches a derived keyword present in the buffer's =#+TODO= with no stale-cache dependency. + +* Migration / breaking change + +Removing =pearl-state-to-todo-mapping= is a breaking change for anyone who set it. The package is pre-release (MELPA pending), so no deprecation cycle. The commit is =feat!:= with a =BREAKING CHANGE:= footer. + +*Upgrade path:* after upgrading, *refresh a Pearl file before cycling TODO keywords on it.* An old file's header and headings may use custom-mapped keywords that no longer resolve; cycling one of those now *refuses* (unknown-keyword =user-error=) rather than silently pushing a wrong state, so the safe move is to re-fetch the file so its header and keywords become the derived set. The README migration note must state this because the defcustom is going away. + +* Review dispositions + +Only modified or rejected recommendations, and decisions worth recording, are listed; everything else from the reviews (2026-05-24, rounds 1–4) was accepted as written and woven into the body above. + +** Round 4 (2026-05-24) + +Ready verdict — no blocking findings. The round-3 classification blocker is confirmed resolved (=:LINEAR-STATE-TYPE:= drawer + legacy fallback). The sole caveat, verifying =WorkflowState.position=, was already recorded as an implementation prerequisite. Tidied the one org-lint nit (a literal double-star =DEV-REVIEW= example in the test plan) the reviewer flagged as harmless. + +** Round 3 (2026-05-24) + +- *HP1 "active/done classification of type-less scanned headings" — modified.* The review's fallback (preserve the keyword's side from the buffer's parsed =org-done-keywords=) is a recovery run on every merge. Modified to stop losing the type at the source: render a =:LINEAR-STATE-TYPE:= drawer field (free — the issue query already fetches =type=) so a scanned heading classifies by its own recorded type deterministically. The review's org-done-keywords-side preservation is kept as the *fallback* for legacy headings lacking the field, with default-active-and-log as the last resort. Fully addresses the concern and removes the per-merge reparse for go-forward files. +- *Open question 1 (preserve old side vs default-all-active) — resolved:* preserve the old side, primarily via the stored type, with the parsed-header fallback — not default-all-to-active. +- MP1 (two state-fetch API shapes) accepted: extend =pearl--team-states= only; leave =pearl-get-states-async= unchanged for v1. + +** Round 2 (2026-05-24) + +- *HP1 "retained dirty subtrees in the header" — accepted, option (b).* The review offered two implementations: thread retained/skipped state metadata out of =pearl--merge-issues-into-buffer=, or scan the final buffer. Chose the final-buffer scan — it directly validates the invariant ("every keyword visible is declared"), subsumes the fetched issues, and avoids widening the merge helper's return contract. +- *Open question 1 (scan: abort vs skip-and-continue) — resolved:* skip-and-continue with a report on the full-file scan; =user-error= only on interactive current-heading sync. +- *Open question 2 (final-buffer scan vs returned metadata for merge coverage) — resolved:* final-buffer scan (the HP1 option-(b) choice). +- MP1 (position-less issue-own ordering), MP2 (split unknown-keyword behavior), and MP3 (return collision metadata) accepted as written. + +** Round 1 (2026-05-24) + +- *HP3 "partial team-state fetch failure" — modified.* The review offered two rules: global hardcoded fallback on any failure, or fail the render and leave the file unchanged. Both discard information — the first drops real derived keywords for teams that succeeded; the second leaves the user with nothing. Adopted instead the *header coverage guarantee*: derive the header from the union of each displayed issue's own state (always available from the issue query) plus each successfully-fetched team's full states. This keeps every rendered keyword declared regardless of fetch outcome, and a failed team degrades only to "can't cycle to its absent states." The hardcoded line is reserved for the no-states-at-all case. The review's underlying safety requirement — "the render rule is only safe when the header contains that slug" — is met more completely this way. +- *Review open question 1 (leave-unchanged vs conservative fallback) — resolved* by the HP3 modify above: neither; the coverage-guarantee union. +- *Review open questions 2 and 3 — resolved as decisions:* slugify is Unicode-aware and locale-independent (Q2); same-team collisions resolve to first-by-position with a logged warning (Q3). Both now live in Decisions. + +* vNext / out of scope + +- *Cross-team slug collisions.* Two teams whose states slugify to the same keyword collapse to one keyword in a multi-team file; sync still resolves per the heading's own team, so the push is correct, but the header can't distinguish them. Disambiguation (team-prefixed keywords, per-team =#+TODO= sections) is deferred. +- *Automatic workflow-state cache staleness.* States are cached for the session; a mid-session Linear workflow change needs =pearl-clear-cache=. A TTL/auto-invalidation is deferred. +- *Label-color → tag-face mapping* and other presentation polish. diff --git a/package-summary.md b/package-summary.md new file mode 100644 index 0000000..894840d --- /dev/null +++ b/package-summary.md @@ -0,0 +1,28 @@ +### Brief summary of what the package does + +pearl integrates Linear.app issue tracking with Emacs and org-mode. It fetches your issues — open issues, a project, an ad-hoc filter, a Linear Custom View, or a named saved query — into a single self-describing org file: each issue is a heading, its description and comments render in the body, and its structured fields live in a namespaced property drawer. You can edit a description, title, or your own comments and push them back with conflict-aware sync, set priority/state/assignee/labels by command, add comments, and create or delete issues, all without leaving Emacs. A transient menu (`M-x pearl-menu`) gathers every command. + +### Direct link to the package repository + +https://github.com/cjennings/pearl + +### Your association with the package + +I am the author and maintainer. pearl is based on and inspired by Gael Blanchemain's linear-emacs (GPL-3.0). + +### Relevant communications with the upstream package maintainer + +None needed — pearl is a renamed, independently maintained derivative of the GPL-3.0 linear-emacs. + +### Checklist + +<!-- Please confirm by replacing `[]` with `[x]`: --> + +- [x] The package is released under a [GPL-Compatible Free Software License](https://www.gnu.org/licenses/license-list.en.html#GPLCompatibleLicenses) +- [] I've read [CONTRIBUTING.org](https://github.com/melpa/melpa/blob/master/CONTRIBUTING.org) +- [x] I've used the latest version of [package-lint](https://github.com/purcell/package-lint) to check for packaging issues, and addressed its feedback +- [x] My elisp byte-compiles cleanly +- [x] I've used `M-x checkdoc` to check the package's documentation strings +- [] I've built and installed the package using the instructions in [CONTRIBUTING.org](https://github.com/melpa/melpa/blob/master/CONTRIBUTING.org) + +<!-- After submitting, please fix any problems the CI reports. --> diff --git a/pearl.el b/pearl.el new file mode 100644 index 0000000..7e1b2cf --- /dev/null +++ b/pearl.el @@ -0,0 +1,3527 @@ +;;; pearl.el --- Linear.app integration -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 +;; Author: Craig Jennings <c@cjennings.net> +;; Based on and inspired by Gael Blanchemain's linear-emacs. +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1") (request "0.3.0") (dash "2.17.0") (s "1.12.0") (transient "0.3.0")) +;; Keywords: tools +;; URL: https://github.com/cjennings/pearl + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; pearl integrates Linear.app issue tracking with Emacs and org-mode. +;; Fetch your issues -- open issues, a project, an ad-hoc filter, a Linear +;; Custom View, or a named saved query -- into a single self-describing org +;; file: each issue is a heading, its description and comments render in the +;; body, and its structured fields live in a namespaced LINEAR-* drawer. +;; +;; Edit a description or title and push it back with conflict-aware sync; set +;; priority, state, assignee, or labels by command; add comments; and create +;; or delete issues -- all without leaving Emacs. See README.org for the full +;; command surface and configuration. + +;;; Code: + +;; +;; This file is organized into the following sections: +;; +;; - Dependencies and requirements +;; - Customization and variables +;; - Core API functions (async-first) +;; - Team management functions +;; - Issue management functions +;; - Issue state management functions +;; - Org-mode integration functions +;; - Mapping functions (between Linear and org-mode) +;; - User-facing commands +;; - Org-mode sync hooks +;; - Backward compatibility functions +;; + +;; Dependencies +(require 'request) +(require 'json) +(require 'dash) +(require 's) +(require 'org) +(require 'cl-lib) +(require 'transient) + +;;; Customization and Variables +(defgroup pearl nil + "Integration with Linear issue tracking." + :group 'tools + :prefix "pearl-") + +(defcustom pearl-api-key nil + "API key for Linear.app. +Can be set manually or loaded from LINEAR_API_KEY environment variable +using `pearl-load-api-key-from-env'." + :type 'string + :group 'pearl) + +(defcustom pearl-graphql-url "https://api.linear.app/graphql" + "GraphQL endpoint URL for Linear API." + :type 'string + :group 'pearl) + +(defcustom pearl-default-team-id nil + "Default team ID to use for creating issues. +When set, skips team selection prompt when creating new issues." + :type 'string + :group 'pearl) + +(defcustom pearl-debug nil + "Enable debug logging for Linear requests. +When enabled, detailed API request and response information will be +logged to the *Messages* buffer." + :type 'boolean + :group 'pearl) + +(defcustom pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory) + "Path to the org file where Linear issues are stored. +This file is created or updated by `pearl-list-issues'. +Defaults to \\='gtd/linear.org\\=' in your `org-directory'." + :type 'file + :group 'pearl) + +(defcustom pearl-state-to-todo-mapping + '(("Todo" . "TODO") + ("In Progress" . "IN-PROGRESS") + ("In Review" . "IN-REVIEW") + ("Backlog" . "BACKLOG") + ("Blocked" . "BLOCKED") + ("Done" . "DONE")) + "Mapping between Linear state names and Org TODO keywords, for rendering. +Each element is a cons cell (LINEAR-STATE . ORG-STATE). It controls how a +Linear state renders as an Org TODO keyword and how an Org keyword maps back +on sync. It no longer decides which issues appear: inclusion is now a +server-side query concern (see `pearl-list-issues'). A Linear state +not listed here renders with the default TODO keyword." + :type '(alist :key-type string :value-type string) + :group 'pearl) + +(defcustom pearl-async-default t + "Use async API calls by default. +When t, all API calls will be asynchronous unless explicitly overridden. +Set to nil to use synchronous calls by default for backward compatibility." + :type 'boolean + :group 'pearl) + +(defcustom pearl-progress-messages t + "Show progress messages during long operations. +When enabled, displays messages about ongoing API operations." + :type 'boolean + :group 'pearl) + +(defcustom pearl-max-issue-pages 10 + "Maximum number of issue pages to fetch, at 100 issues per page. +`pearl-list-issues' stops after this many pages and warns that the +result may be truncated. Raise it if you are assigned more issues than +this cap can hold." + :type 'integer + :group 'pearl) + +(defcustom pearl-request-timeout 30 + "Seconds a synchronous Linear request waits before giving up. +The synchronous wrappers busy-wait for their async counterpart to call +back. If it never does (dropped connection, server stall), they return +nil after this many seconds rather than hanging Emacs." + :type 'number + :group 'pearl) + +(defcustom pearl-surface-buffer t + "When non-nil, surface the active org buffer after a command updates it. +A command run while the buffer is buried (its async result lands after you have +navigated away) brings the buffer back to a window so the result is visible. +Set to nil to leave window layout untouched." + :type 'boolean + :group 'pearl) + +(defcustom pearl-surface-select-window nil + "When non-nil, surfacing the active buffer also selects its window. +With the default nil, `pearl-surface-buffer' shows the buffer via +`display-buffer' without moving focus. Set non-nil to have focus follow +\(via `pop-to-buffer') so point lands in the surfaced buffer." + :type 'boolean + :group 'pearl) + +(defun pearl--surface-buffer (buffer) + "Bring BUFFER to a window after a command updated it, unless already shown. +No-op when `pearl-surface-buffer' is nil, BUFFER is dead, or BUFFER is already +visible in some window (so the common already-on-screen case causes no window +churn). Uses `pop-to-buffer' when `pearl-surface-select-window' is non-nil +\(focus follows) and `display-buffer' otherwise (shown without stealing focus)." + (when (and pearl-surface-buffer + (buffer-live-p buffer) + (not (get-buffer-window buffer t))) + (if pearl-surface-select-window + (pop-to-buffer buffer) + (display-buffer buffer)))) + +(defcustom pearl-fold-after-update t + "When non-nil, re-fold the Linear page after a fetch or refresh repopulates it. +`#+STARTUP:' visibility only applies on a file's first visit, so a repopulation +that replaces a visited buffer's contents in place would otherwise leave the +page fully expanded. Folding restores the scannable outline -- issue headings +visible, descriptions, comments, and property drawers hidden. Set to nil to +leave the buffer expanded after updates." + :type 'boolean + :group 'pearl) + +(defun pearl--hide-all-drawers () + "Collapse every property drawer in the current buffer, across Org versions." + (cond ((fboundp 'org-fold-hide-drawer-all) (org-fold-hide-drawer-all)) + ((fboundp 'org-cycle-hide-drawers) (org-cycle-hide-drawers 'all)))) + +(defun pearl--restore-page-visibility () + "Re-fold the whole current buffer to its `#+STARTUP' visibility and hide drawers. +Used after a full repopulation (list / view / merge refresh) so the page does +not sprawl open. A no-op when `pearl-fold-after-update' is nil." + (when pearl-fold-after-update + ;; A full in-place rebuild (Branch B / merge) leaves Org's parsed startup + ;; options stale -- the new `#+STARTUP:' text is in the buffer but + ;; `org-startup-folded' still holds the value read on first visit. Re-read + ;; the options so the fold honors the buffer's actual `#+STARTUP'. + (when (fboundp 'org-set-regexps-and-options) (org-set-regexps-and-options)) + ;; `org-set-startup-visibility' was renamed in Org 9.6; funcall picks the + ;; available name without tripping the byte-compiler's obsoletion warning. + (funcall (if (fboundp 'org-cycle-set-startup-visibility) + 'org-cycle-set-startup-visibility + 'org-set-startup-visibility)) + (pearl--hide-all-drawers))) + +(defvar pearl-todo-states-pattern nil + "Cached regex pattern for matching Org TODO states. +This pattern is generated from `pearl-state-to-todo-mapping'. +Use `pearl--get-todo-states-pattern' to get the pattern.") + +(defvar pearl--todo-states-pattern-source nil + "Mapping the cached pattern was built from. +Holds the `pearl-state-to-todo-mapping' value used to build +`pearl-todo-states-pattern', so the cache can be invalidated +when the mapping changes.") + +;; Cache variables +(defvar pearl--cache-issues nil + "Cache for issues.") + +(defvar pearl--cache-teams nil + "Cache for teams.") + +(defvar pearl--cache-states nil + "Cache of workflow states per team, an alist of (TEAM-ID . STATES). +Populated on first state lookup; clear it to force a refresh.") + +(defvar pearl--cache-team-collections nil + "Cache of per-team collections for name->id resolution. +An alist keyed by (KIND . TEAM-ID) where KIND is one of `projects', +`labels', `members', `cycles'; the value is the list of nodes. Clear it (or +pass a force argument) to refresh.") + +(defvar pearl--cache-views nil + "Cache of the workspace's Linear Custom Views (a list of node alists). +Populated on first listing; clear it (or pass a force argument) to refresh.") + +(defvar pearl--cache-viewer nil + "Cached current-viewer plist (:id :name), fetched once per session. +Backs the comment-edit permission check; clear it to force a refresh.") + +;; Progress tracking variables +(defvar pearl--active-requests 0 + "Number of currently active API requests.") + +;;; Core API Functions (Async-First Architecture) + +(defun pearl--headers () + "Return headers for Linear API requests." + (unless pearl-api-key + (error "Linear API key not set. Use M-x customize-variable RET pearl-api-key")) + + ;; For personal API keys, the format is: "Authorization: <API_KEY>" + ;; No "Bearer" prefix for personal API keys + `(("Content-Type" . "application/json") + ("Authorization" . ,pearl-api-key))) + +(defun pearl--log (format-string &rest args) + "Log message with FORMAT-STRING and ARGS if debug is enabled." + (when pearl-debug + (apply #'message (concat "[Linear] " format-string) args))) + +(defun pearl--progress (format-string &rest args) + "Show a progress message built from FORMAT-STRING and ARGS. +Shown only when `pearl-progress-messages' is non-nil." + (when pearl-progress-messages + (apply #'message (concat "[Linear] " format-string) args))) + +(defun pearl--wait-for (predicate) + "Busy-wait until PREDICATE is non-nil or the request timeout elapses. +Return the final value of PREDICATE: non-nil when it succeeded, nil when +the wait timed out after `pearl-request-timeout' seconds. This +keeps the synchronous wrappers from hanging Emacs when a callback never +fires." + (let ((deadline (+ (float-time) pearl-request-timeout))) + (while (and (not (funcall predicate)) + (< (float-time) deadline)) + (sleep-for 0.1)) + (funcall predicate))) + +(defun pearl--graphql-request-async (query &optional variables success-fn error-fn) + "Make an asynchronous GraphQL request to Linear API. +QUERY is the GraphQL query string. +VARIABLES is an optional alist of variables to include in the request. +SUCCESS-FN is called with the response data on success. +ERROR-FN is called with error information on failure. +If SUCCESS-FN or ERROR-FN are not provided, default handlers will be used." + (pearl--log "Making async GraphQL request with query: %s" query) + (when variables + (pearl--log "Variables: %s" (prin1-to-string variables))) + + (setq pearl--active-requests (1+ pearl--active-requests)) + + (unless success-fn + (setq success-fn (lambda (data) + (pearl--log "Request completed: %s" (prin1-to-string data))))) + + (unless error-fn + (setq error-fn (lambda (error-thrown _response data) + (message "Linear API error: %s" error-thrown) + (pearl--log "Error response: %s" (prin1-to-string data))))) + + (let ((request-data (json-encode `(("query" . ,query) + ,@(when variables `(("variables" . ,variables))))))) + (pearl--log "Request payload: %s" request-data) + + (request + pearl-graphql-url + :type "POST" + :headers (pearl--headers) + :data request-data + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Response received: %s" (prin1-to-string data)) + (funcall success-fn data))) + :error (cl-function + (lambda (&key error-thrown response data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Error: %s" error-thrown) + ;; Guard the status-code read: `response' can be nil on some + ;; transport failures, and the accessor errors on a non-struct. + (when (request-response-p response) + (pearl--log "Response status: %s" + (request-response-status-code response))) + (when data + (pearl--log "Error response: %s" (prin1-to-string data))) + (funcall error-fn error-thrown response data)))))) + +(defun pearl--graphql-request (query &optional variables) + "Synchronous wrapper for GraphQL requests (backward compatibility). +QUERY is the GraphQL query string. +VARIABLES is an optional alist of variables. +Returns the response data or nil on error. +This function blocks until the request completes." + (pearl--log "Making synchronous GraphQL request (backward compatibility mode)") + (let ((response nil) + (error-response nil) + (completed nil)) + + (pearl--graphql-request-async + query + variables + (lambda (data) + (setq response data) + (setq completed t)) + (lambda (error-thrown _response _data) + (setq error-response error-thrown) + (setq completed t))) + + ;; Legacy busy-wait: this wrapper predates `pearl--wait-for' and keeps its + ;; own hardcoded 30s bound rather than honoring `pearl-request-timeout'. + (let ((timeout 30) + (start-time (current-time))) + (while (and (not completed) + (< (float-time (time-subtract (current-time) start-time)) timeout)) + (sleep-for 0.1))) + + (if error-response + (progn + (message "Linear API error: %s" error-response) + nil) + response))) + +;;; Team Management (Async) + +(defun pearl-get-teams-async (&optional callback) + "Asynchronously get a list of teams from Linear. +CALLBACK is called with the list of teams on success." + (pearl--log "Fetching teams asynchronously") + (pearl--progress "Fetching teams...") + + (let* ((query "query { teams { nodes { id name } } }") + (success-fn (lambda (response) + (if response + (let ((teams (cdr (assoc 'nodes (assoc 'teams (assoc 'data response)))))) + (pearl--log "Retrieved %d teams" (length teams)) + (setq pearl--cache-teams teams) + (when callback + (funcall callback teams))) + (message "Failed to retrieve teams") + (when callback + (funcall callback nil))))) + (error-fn (lambda (_error _response _data) + (message "Failed to retrieve teams") + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query nil success-fn error-fn))) + +(defun pearl-get-teams () + "Get a list of teams from Linear (synchronous for backward compatibility)." + (let ((teams nil) + (completed nil)) + + (pearl-get-teams-async + (lambda (result) + (setq teams result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + teams)) + +(defun pearl-select-team-async (callback) + "Asynchronously prompt user to select a team. +CALLBACK is called with the selected team." + (if pearl--cache-teams + ;; Use cached teams + (let* ((team-names (mapcar (lambda (team) + (cons (cdr (assoc 'name team)) team)) + pearl--cache-teams)) + (selected (completing-read "Select team: " team-names nil t))) + (funcall callback (cdr (assoc selected team-names)))) + ;; Fetch teams first + (pearl-get-teams-async + (lambda (teams) + (if teams + (let* ((team-names (mapcar (lambda (team) + (cons (cdr (assoc 'name team)) team)) + teams)) + (selected (completing-read "Select team: " team-names nil t))) + (funcall callback (cdr (assoc selected team-names)))) + (funcall callback nil)))))) + +(defun pearl-select-team () + "Prompt user to select a team (synchronous for backward compatibility)." + (let ((result nil) + (completed nil)) + + (pearl-select-team-async + (lambda (team) + (setq result team) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + result)) + +;;; Issue Filter DSL (Layer 1) + +;; A pure compiler from an authoring plist to a Linear `IssueFilter' object (a +;; json-encodable alist passed as the `$filter' variable of an `issues(filter:)' +;; query). Name->id resolution for `:project' / `:cycle' happens upstream; this +;; layer assumes resolved values and never touches the network. + +(defconst pearl--open-state-types '("completed" "canceled" "duplicate") + "Workflow-state types that count as not open. +`:open t' compiles to a `state.type' nin this list. Linear's state types are +triage, backlog, unstarted, started, completed, canceled, and duplicate; the +first four are the open ones.") + +(defconst pearl--priority-symbols + '((none . 0) (urgent . 1) (high . 2) (medium . 3) (low . 4)) + "Alist mapping priority symbols to Linear's numeric priority values.") + +(defconst pearl--filter-keys + '(:assignee :open :state :state-type :project :team :labels :priority :cycle + :sort :order) + "Keys recognized in an issue-filter authoring plist. +`:sort' and `:order' steer result ordering, not the `IssueFilter' itself.") + +(defun pearl--eq (value) + "Return a Linear comparator alist matching VALUE exactly." + (list (cons "eq" value))) + +(defun pearl--in (values) + "Return a Linear comparator alist matching any of VALUES. +VALUES is a list, encoded as a JSON array." + (list (cons "in" (vconcat values)))) + +(defun pearl--nin (values) + "Return a Linear comparator alist matching none of VALUES. +VALUES is a list, encoded as a JSON array." + (list (cons "nin" (vconcat values)))) + +(defun pearl--compile-priority (priority) + "Return Linear's numeric value for PRIORITY. +PRIORITY is an integer 0-4 or a symbol in `pearl--priority-symbols'." + (cond ((integerp priority) priority) + ((assq priority pearl--priority-symbols) + (cdr (assq priority pearl--priority-symbols))) + (t (error "Invalid priority: %S" priority)))) + +(defun pearl--compile-state-filter (plist) + "Return the state sub-filter alist for PLIST, or nil when no state key is set. +An explicit `:state' (name) or `:state-type' (one type or a list) takes +precedence over `:open', the broad not-closed predicate." + (let ((state (plist-get plist :state)) + (state-type (plist-get plist :state-type)) + (open (plist-get plist :open))) + (cond + (state (list (cons "name" (pearl--eq state)))) + (state-type (list (cons "type" + (pearl--in (if (listp state-type) + state-type + (list state-type)))))) + (open (list (cons "type" (pearl--nin pearl--open-state-types)))) + (t nil)))) + +(defun pearl--build-issue-filter (plist) + "Compile filter PLIST into a json-encodable Linear `IssueFilter' alist. +The result is meant for the `$filter' variable of an `issues(filter:)' query; +sibling keys are AND-ed by Linear. This function is pure and assumes +`:project' / `:cycle' values are already resolved ids (see the resolution +helpers for name->id). Recognized keys are `pearl--filter-keys', minus +the ordering keys `:sort' / `:order'." + (let (filter) + (let ((assignee (plist-get plist :assignee))) + (cond ((eq assignee :me) + (push (cons "assignee" (list (cons "isMe" (pearl--eq t)))) filter)) + ((stringp assignee) + (push (cons "assignee" (list (cons "email" (pearl--eq assignee)))) + filter)))) + (let ((state-filter (pearl--compile-state-filter plist))) + (when state-filter (push (cons "state" state-filter) filter))) + (let ((project (plist-get plist :project))) + (when project + (push (cons "project" (list (cons "id" (pearl--eq project)))) filter))) + (let ((team (plist-get plist :team))) + (when team + (push (cons "team" (list (cons "key" (pearl--eq team)))) filter))) + (let ((labels (plist-get plist :labels))) + ;; v1 semantics: "carries any of these labels" -- labels.some.name in set. + (when labels + (push (cons "labels" + (list (cons "some" (list (cons "name" (pearl--in labels)))))) + filter))) + (let ((priority (plist-get plist :priority))) + (when priority + (push (cons "priority" + (pearl--eq (pearl--compile-priority priority))) + filter))) + (let ((cycle (plist-get plist :cycle))) + (when cycle + (push (cons "cycle" (list (cons "id" (pearl--eq cycle)))) filter))) + (nreverse filter))) + +(defun pearl--validate-issue-filter (plist) + "Validate issue-filter PLIST, signaling a `user-error' on any problem. +Return t when PLIST is well-formed. Checks plist shape, unknown keys, the +`:priority' range/symbol, the `:assignee' form, the `:order' value, empty +strings, and the `:labels' type. Name ambiguity (a project or state name that +needs team context) is resolved upstream, not here." + (unless (and (listp plist) (cl-evenp (length plist))) + (user-error "Issue filter must be a plist")) + (cl-loop for (key _val) on plist by #'cddr + unless (memq key pearl--filter-keys) + do (user-error "Unknown issue-filter key: %S" key)) + (let ((priority (plist-get plist :priority))) + (when priority + (cond ((integerp priority) + (unless (<= 0 priority 4) + (user-error "Priority integer must be 0-4, got %d" priority))) + ((not (assq priority pearl--priority-symbols)) + (user-error "Invalid :priority %S (use 0-4 or none/urgent/high/medium/low)" + priority))))) + (let ((assignee (plist-get plist :assignee))) + (when (and assignee (not (eq assignee :me)) (not (stringp assignee))) + (user-error ":assignee must be :me or an email string, got %S" assignee))) + (let ((order (plist-get plist :order))) + (when (and order (not (memq order '(asc desc)))) + (user-error ":order must be `asc' or `desc', got %S" order))) + (dolist (key '(:state :project :team :cycle)) + (let ((val (plist-get plist key))) + (when (and (stringp val) (string-empty-p val)) + (user-error "%s must not be an empty string" key)))) + (let ((labels (plist-get plist :labels))) + (when (and labels + (or (not (listp labels)) + (cl-some (lambda (x) (not (and (stringp x) (not (string-empty-p x))))) + labels))) + (user-error ":labels must be a list of non-empty strings"))) + t) + +;;; Issue Model Normalization + +;; Convert raw Linear response alists (json-read shaped: symbol keys, vectors +;; for arrays, t / `:json-false' booleans, and a missing key for an absent +;; field) into flat internal plists, so rendering, filtering, and command code +;; never has to know the transport shape. + +(defun pearl--node-list (connection) + "Return CONNECTION's nodes as a list. +CONNECTION is an alist with a `nodes' key holding a vector, a list, or nil." + (let ((nodes (cdr (assoc 'nodes connection)))) + (cond ((vectorp nodes) (append nodes nil)) + ((listp nodes) nodes) + (t nil)))) + +(defun pearl--normalize-user (raw) + "Normalize a Linear user alist RAW to a plist, or nil when RAW is nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (or (cdr (assoc 'name raw)) (cdr (assoc 'displayName raw))) + :email (cdr (assoc 'email raw))))) + +(defun pearl--normalize-state (raw) + "Normalize a Linear workflow-state alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw)) + :type (cdr (assoc 'type raw))))) + +(defun pearl--normalize-team (raw) + "Normalize a Linear team alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :key (cdr (assoc 'key raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-project (raw) + "Normalize a Linear project alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-labels (raw) + "Normalize an issue's labels connection RAW to a list of (:id :name) plists." + (mapcar (lambda (label) + (list :id (cdr (assoc 'id label)) :name (cdr (assoc 'name label)))) + (pearl--node-list raw))) + +(defun pearl--normalize-comment (raw) + "Normalize a Linear comment alist RAW to a plist. +The author falls back through user, then botActor, then externalUser, because +`Comment.user' is null for integration and bot comments." + (let ((user (pearl--normalize-user (cdr (assoc 'user raw)))) + (bot (cdr (assoc 'botActor raw))) + (ext (cdr (assoc 'externalUser raw)))) + (list :id (cdr (assoc 'id raw)) + :body (cdr (assoc 'body raw)) + :created-at (cdr (assoc 'createdAt raw)) + :author-id (when user (plist-get user :id)) + :author (cond (user (plist-get user :name)) + (bot (or (cdr (assoc 'name bot)) "automation")) + (ext (or (cdr (assoc 'name ext)) "external")) + (t nil))))) + +(defun pearl--normalize-cycle (raw) + "Normalize a Linear cycle alist RAW to a plist, or nil." + (when raw + (list :id (cdr (assoc 'id raw)) + :number (cdr (assoc 'number raw)) + :name (cdr (assoc 'name raw))))) + +(defun pearl--normalize-issue (raw) + "Normalize a Linear issue node RAW to a flat internal plist, or nil. +Vectors become lists and absent/`:json-false' fields become nil. Nested +objects (state, assignee, team, project, labels, cycle, comments) are +normalized in turn; comments are omitted unless the fetch requested them." + (when raw + (list :id (cdr (assoc 'id raw)) + :identifier (cdr (assoc 'identifier raw)) + :title (cdr (assoc 'title raw)) + :description (cdr (assoc 'description raw)) + :priority (cdr (assoc 'priority raw)) + :url (cdr (assoc 'url raw)) + :updated-at (cdr (assoc 'updatedAt raw)) + :state (pearl--normalize-state (cdr (assoc 'state raw))) + :assignee (pearl--normalize-user (cdr (assoc 'assignee raw))) + :team (pearl--normalize-team (cdr (assoc 'team raw))) + :project (pearl--normalize-project (cdr (assoc 'project raw))) + :labels (pearl--normalize-labels (cdr (assoc 'labels raw))) + :cycle (pearl--normalize-cycle (cdr (assoc 'cycle raw))) + :comments (let ((comments (assoc 'comments raw))) + (when comments + (mapcar #'pearl--normalize-comment + (pearl--node-list (cdr comments)))))))) + +(defun pearl--normalize-custom-view (raw) + "Normalize a Linear custom-view alist RAW to a plist, or nil. +A workspace-wide view has a nil `:team'; `:shared' is a real boolean." + (when raw + (list :id (cdr (assoc 'id raw)) + :name (cdr (assoc 'name raw)) + :description (cdr (assoc 'description raw)) + :shared (eq t (cdr (assoc 'shared raw))) + :icon (cdr (assoc 'icon raw)) + :color (cdr (assoc 'color raw)) + :team (pearl--normalize-team (cdr (assoc 'team raw))) + :owner (pearl--normalize-user (cdr (assoc 'owner raw)))))) + +;;; Query Result Shape + +;; A small tagged result so callers can tell apart success-with-issues, +;; success-with-none, an invalid filter (caught before the request), a +;; transport failure, and a GraphQL-level failure, instead of collapsing them +;; all to nil. A result is a plist: (:status SYM :issues LIST :message STR +;; :truncated BOOL). The fetch layer builds one; commands read it to message +;; the user precisely. + +(defun pearl--make-query-result (status &rest props) + "Build a query-result plist with STATUS and optional PROPS. +STATUS is one of `ok', `empty', `invalid-filter', `request-failed', or +`graphql-failed'. PROPS may set `:issues', `:message', and `:truncated'." + (append (list :status status) props)) + +(defun pearl--query-result-status (result) + "Return the status symbol of query RESULT." + (plist-get result :status)) + +(defun pearl--query-result-issues (result) + "Return the issues list carried by query RESULT." + (plist-get result :issues)) + +(defun pearl--query-result-message (result) + "Return the user-facing message carried by query RESULT, if any." + (plist-get result :message)) + +(defun pearl--query-result-truncated-p (result) + "Return non-nil when query RESULT was cut off at the page cap." + (plist-get result :truncated)) + +(defun pearl--query-result-ok-p (result) + "Return non-nil when RESULT is a successful query (issues or empty)." + (memq (pearl--query-result-status result) '(ok empty))) + +(defun pearl--query-result-error-p (result) + "Return non-nil when RESULT is a failure rather than a result set." + (memq (pearl--query-result-status result) + '(invalid-filter request-failed graphql-failed))) + +(defun pearl--graphql-error-message (response) + "Return the first GraphQL error message in RESPONSE, or nil. +RESPONSE's `errors' may be a vector (live API) or a list (test fixtures)." + (let ((errors (cdr (assoc 'errors response)))) + (when errors + (let ((first (if (vectorp errors) + (and (> (length errors) 0) (aref errors 0)) + (car errors)))) + (cdr (assoc 'message first)))))) + +(defun pearl--classify-response (response &optional issues truncated) + "Classify a raw GraphQL RESPONSE into a query-result plist. +A nil RESPONSE, or one without a `data' key, is a transport failure; a RESPONSE +carrying `errors' is a GraphQL failure. Otherwise the result is `ok', or +`empty' when ISSUES is empty, carrying ISSUES and the TRUNCATED flag. ISSUES +is the already-extracted (normalized) list, so this stays pure." + (cond + ((null response) + (pearl--make-query-result 'request-failed + :message "No response from Linear")) + ((assoc 'errors response) + (pearl--make-query-result + 'graphql-failed + :message (or (pearl--graphql-error-message response) + "Linear returned an error"))) + ((not (assoc 'data response)) + (pearl--make-query-result 'request-failed + :message "Malformed response from Linear")) + (t (pearl--make-query-result (if issues 'ok 'empty) + :issues issues + :truncated (and truncated t))))) + +(defun pearl--invalid-filter-result (message) + "Return an `invalid-filter' query-result carrying MESSAGE." + (pearl--make-query-result 'invalid-filter :message message)) + +;;; General Issue Query (Layer 2a) + +;; The general fetch: a top-level `issues(filter:)' query paged through a +;; reusable accumulator, returning a tagged query-result. Issues come back as +;; raw nodes (the query fetches the full field superset); normalization happens +;; at the render boundary, not here. + +(defconst pearl--issues-query + "query Issues($filter: IssueFilter, $first: Int!, $after: String, $orderBy: PaginationOrderBy) { + issues(filter: $filter, first: $first, after: $after, orderBy: $orderBy) { + nodes { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } + pageInfo { hasNextPage endCursor } + } +}" + "GraphQL query for a filtered, ordered page of issues. +Pulls comments per issue so a populated list renders them, not just the +single-issue refresh.") + +(defconst pearl--single-issue-query + "query Issue($id: String!) { + issue(id: $id) { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } +}" + "GraphQL query for one issue by id. +Same field shape as `pearl--issues-query' (which now also pulls comments); +this is the single-issue refresh path.") + +(defun pearl--fetch-issue-async (issue-id callback) + "Fetch the full issue node for ISSUE-ID, calling CALLBACK with the outcome. +CALLBACK receives one of: the raw issue node (normalized at the render +boundary, as on the list path); `:missing' when the request succeeded but the +issue is null (deleted, or no access); or `:error' on a GraphQL or transport +failure. Separating missing from error lets the caller tell \"the issue is +gone\" apart from \"the API call failed.\"" + (pearl--graphql-request-async + pearl--single-issue-query + `(("id" . ,issue-id)) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall callback :error) + (let ((issue (cdr (assoc 'issue (cdr (assoc 'data response)))))) + (funcall callback (or issue :missing))))) + (lambda (_error _response _data) (funcall callback :error)))) + +(defconst pearl--view-issues-query + "query ViewIssues($id: String!, $first: Int!, $after: String) { + customView(id: $id) { + issues(first: $first, after: $after) { + nodes { + id identifier title description priority url updatedAt + state { id name type } + assignee { id name displayName email } + team { id key name } + project { id name } + labels { nodes { id name } } + cycle { id number name } + comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } + } + pageInfo { hasNextPage endCursor } + } + } +}" + "GraphQL query running a Custom View's own filter server-side, by view id. +Pulls comments per issue so a view-populated list renders them.") + +(defun pearl--query-view-async (view-id callback) + "Run the Custom View VIEW-ID server-side, calling CALLBACK with a query-result. +The view applies its own stored filter on Linear's side; issues come back as +raw nodes (normalized at the render boundary), paged like the general fetch." + (let ((page-fn + (lambda (after page-cb) + (pearl--graphql-request-async + pearl--view-issues-query + `(("id" . ,view-id) + ("first" . 100) + ,@(when after (list (cons "after" after)))) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall page-cb + (list :error (pearl--classify-response response))) + (let* ((conn (cdr (assoc 'issues + (cdr (assoc 'customView + (cdr (assoc 'data response))))))) + (nodes (pearl--node-list conn)) + (info (cdr (assoc 'pageInfo conn)))) + (funcall page-cb + (list :issues nodes + :has-next-page (eq t (cdr (assoc 'hasNextPage info))) + :end-cursor (cdr (assoc 'endCursor info))))))) + (lambda (_error _response _data) + (funcall page-cb + (list :error (pearl--make-query-result + 'request-failed + :message "Failed to fetch view issues")))))))) + (pearl--page-issues page-fn callback))) + +(defun pearl--custom-views (&optional force) + "Return the workspace's Custom Views, fetching once and caching. +Each node carries id/name/description/shared/url. A non-nil FORCE refetches." + (or (and (not force) pearl--cache-views) + (let* ((query "query CustomViews($first: Int!, $after: String) { + customViews(first: $first, after: $after) { + nodes { id name description shared url } + pageInfo { hasNextPage endCursor } + } + }") + (response (pearl--graphql-request query '(("first" . 100)))) + (views (and response + (pearl--node-list + (cdr (assoc 'customViews (cdr (assoc 'data response)))))))) + (when views + (setq pearl--cache-views views)) + views))) + +(defun pearl--page-issues (page-fn callback &optional max-pages) + "Accumulate issues across pages via PAGE-FN, then call CALLBACK with a result. +PAGE-FN is called as (PAGE-FN AFTER PAGE-CB); it fetches one page and invokes +PAGE-CB with a plist (:issues LIST :has-next-page BOOL :end-cursor STR) on +success, or (:error RESULT) carrying a failure query-result. CALLBACK receives +the final query-result. Paging stops at MAX-PAGES (default +`pearl-max-issue-pages'), marking the result truncated." + (let ((max (or max-pages pearl-max-issue-pages)) + (acc '()) + (page 1)) + (cl-labels + ((fetch (after) + (if (> page max) + (funcall callback + (pearl--make-query-result (if acc 'ok 'empty) + :issues acc :truncated t)) + (funcall + page-fn after + (lambda (page-result) + (let ((err (plist-get page-result :error))) + (if err + (funcall callback err) + (setq acc (append acc (plist-get page-result :issues))) + (if (plist-get page-result :has-next-page) + (progn + (setq page (1+ page)) + (fetch (plist-get page-result :end-cursor))) + (funcall callback + (pearl--make-query-result + (if acc 'ok 'empty) :issues acc)))))))))) + (fetch nil)))) + +(defun pearl--query-issues-async (filter callback &optional order-by) + "Fetch issues matching FILTER, calling CALLBACK with a query-result. +FILTER is a compiled `IssueFilter' alist (see +`pearl--build-issue-filter') or nil for no filter. ORDER-BY is a +`PaginationOrderBy' symbol, default `updatedAt'. Issues come back as raw +nodes; normalization happens at the render boundary." + (let ((page-fn + (lambda (after page-cb) + (pearl--graphql-request-async + pearl--issues-query + `(,@(when filter (list (cons "filter" filter))) + ("first" . 100) + ,@(when after (list (cons "after" after))) + ("orderBy" . ,(symbol-name (or order-by 'updatedAt)))) + (lambda (response) + (if (or (null response) + (assoc 'errors response) + (not (assoc 'data response))) + (funcall page-cb + (list :error (pearl--classify-response response))) + (let* ((conn (cdr (assoc 'issues (cdr (assoc 'data response))))) + (nodes (pearl--node-list conn)) + (info (cdr (assoc 'pageInfo conn)))) + (funcall page-cb + (list :issues nodes + :has-next-page (eq t (cdr (assoc 'hasNextPage info))) + :end-cursor (cdr (assoc 'endCursor info))))))) + (lambda (_error _response _data) + (funcall page-cb + (list :error (pearl--make-query-result + 'request-failed + :message "Failed to fetch issues from Linear")))))))) + (pearl--page-issues page-fn callback))) + +;;; Issue Creation + +(defun pearl--created-issue (response) + "Return the created issue node from a create RESPONSE, or nil on failure. +Linear answers GraphQL-level failures with HTTP 200 and either an `errors' +body or `issueCreate.success' = false / `issue' = null. Checking `success' +and the issue node here reports those as failures instead of a phantom +\"created\" issue." + (let* ((issue-create (cdr (assoc 'issueCreate (cdr (assoc 'data response))))) + (success (cdr (assoc 'success issue-create))) + (issue (cdr (assoc 'issue issue-create)))) + (and success (not (eq success :json-false)) issue))) + +(defun pearl-create-issue-async (title description team-id callback) + "Asynchronously create a new issue. +TITLE is the issue title. +DESCRIPTION is the issue description. +TEAM-ID is the team to create the issue in. +CALLBACK is called with the created issue data." + (pearl--log "Creating issue: %s" title) + (pearl--progress "Creating issue...") + + (let* ((query "mutation CreateIssue($title: String!, $description: String, $teamId: String!) { + issueCreate(input: {title: $title, description: $description, teamId: $teamId}) { + success + issue { + id + identifier + title + } + } + }") + (variables `(("title" . ,title) + ("description" . ,description) + ("teamId" . ,team-id))) + + (success-fn (lambda (response) + (let ((issue (pearl--created-issue response))) + (if issue + (progn + (message "Created issue %s: %s" + (cdr (assoc 'identifier issue)) + (cdr (assoc 'title issue))) + (when callback + (funcall callback issue))) + (message "Failed to create issue") + (when callback + (funcall callback nil)))))) + + (error-fn (lambda (_error _response _data) + (message "Failed to create issue") + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query variables success-fn error-fn))) + +(defun pearl-create-issue (title description team-id) + "Create a new issue (synchronous wrapper for backward compatibility). +TITLE is the issue title. +DESCRIPTION is the issue description. +TEAM-ID is the team to create the issue in." + (let ((issue nil) + (completed nil)) + + (pearl-create-issue-async + title description team-id + (lambda (result) + (setq issue result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + issue)) + +;;; Issue State Management (Async) + +(defun pearl-get-states-async (team-id callback) + "Asynchronously get workflow states for TEAM-ID. +CALLBACK is called with the list of states." + (pearl--log "Fetching workflow states for team %s" team-id) + + (let* ((query "query GetWorkflowStates($teamId: String!) { + team(id: $teamId) { + states { + nodes { + id + name + color + } + } + } + }") + (variables `(("teamId" . ,team-id))) + + (success-fn (lambda (response) + (when response + (let ((states (cdr (assoc 'nodes (assoc 'states (assoc 'team (assoc 'data response))))))) + (when callback + (funcall callback states)))))) + + (error-fn (lambda (_error _response _data) + (when callback + (funcall callback nil))))) + + (pearl--graphql-request-async query variables success-fn error-fn))) + +(defun pearl-get-states (team-id) + "Get workflow states for TEAM-ID (synchronous wrapper)." + (let ((states nil) + (completed nil)) + + (pearl-get-states-async + team-id + (lambda (result) + (setq states result) + (setq completed t))) + + (pearl--wait-for (lambda () completed)) + + states)) + +(defun pearl--team-states (team-id) + "Return the workflow states for TEAM-ID, fetching once and caching. +Cached in `pearl--cache-states' keyed by TEAM-ID; org-state syncs +resolve a state per heading change, so the cache avoids a network round +trip on every one. Clear the cache to force a refresh." + (or (cdr (assoc team-id pearl--cache-states)) + (let* ((query "query GetTeamWorkflowStates($teamId: String!) { + team(id: $teamId) { + states { + nodes { + id + name + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables)) + (states (and response + (cdr (assoc 'nodes + (cdr (assoc 'states + (cdr (assoc 'team + (cdr (assoc 'data response))))))))))) + (when states + (push (cons team-id states) pearl--cache-states)) + states))) + +(defun pearl--get-state-id-by-name (state-name team-id) + "Get the Linear state ID for the given STATE-NAME in TEAM-ID." + (pearl--log "Looking up state ID for %s in team %s" state-name team-id) + (let* ((states (pearl--team-states team-id)) + (state (and states + (seq-find (lambda (s) + (string= (downcase (cdr (assoc 'name s))) + (downcase state-name))) + states)))) + (if state + (cdr (assoc 'id state)) + (message "Could not find state with name: %s in team %s" state-name team-id) + nil))) + +(defun pearl--all-teams () + "Return all teams, fetching once and caching in `pearl--cache-teams'. +The whole-file org sync resolves a team per heading, so caching here turns +N blocking lookups into one. Shares the cache with the team selector." + (or pearl--cache-teams + (let* ((query "query { + teams { + nodes { + id + name + } + } + }") + (response (pearl--graphql-request query)) + (teams (and response + (cdr (assoc 'nodes + (cdr (assoc 'teams + (cdr (assoc 'data response))))))))) + (when teams + (setq pearl--cache-teams teams)) + teams))) + +(defun pearl--get-team-id-by-name (team-name) + "Get the Linear team ID for the given TEAM-NAME." + (pearl--log "Looking up team ID for team %s" team-name) + (let* ((teams (pearl--all-teams)) + (team (and teams + (seq-find (lambda (tm) + (string= (cdr (assoc 'name tm)) team-name)) + teams)))) + (if team + (cdr (assoc 'id team)) + ;; Log the available teams to help diagnose a name mismatch. + (when teams + (pearl--log "Available teams: %s" + (mapconcat (lambda (tm) + (format "%s (%s)" + (cdr (assoc 'name tm)) + (cdr (assoc 'id tm)))) + teams + ", "))) + (message "Could not find team with name: %s" team-name) + nil))) + +;;; Per-team Name -> ID Resolution + +(defun pearl--team-collection (kind team-id &optional force) + "Return the KIND collection for TEAM-ID, fetching once and caching. +KIND is one of `projects', `labels', `members', `cycles'. Cached in +`pearl--cache-team-collections' keyed by (KIND . TEAM-ID); a non-nil +FORCE bypasses the cache and refetches. Returns a list of node alists." + (let ((cache-key (cons kind team-id))) + (if (and (not force) (assoc cache-key pearl--cache-team-collections)) + (cdr (assoc cache-key pearl--cache-team-collections)) + (let* ((fields (pcase kind + ('members "id name displayName email") + ('cycles "id number name") + (_ "id name"))) + (query (format "query TeamCollection($teamId: String!) { + team(id: $teamId) { %s { nodes { %s } } } +}" (symbol-name kind) fields)) + (response (pearl--graphql-request query `(("teamId" . ,team-id)))) + (coll (cdr (assoc kind (cdr (assoc 'team (cdr (assoc 'data response))))))) + (nodes (pearl--node-list coll))) + (when nodes + (push (cons cache-key nodes) pearl--cache-team-collections)) + nodes)))) + +(defun pearl--node-label (kind node) + "Return a human label for NODE of KIND, shown when disambiguating a match." + (pcase kind + ('members (or (cdr (assoc 'displayName node)) + (cdr (assoc 'name node)) + (cdr (assoc 'email node)))) + ('cycles (or (cdr (assoc 'name node)) + (let ((n (cdr (assoc 'number node))) ) (and n (number-to-string n))))) + (_ (cdr (assoc 'name node))))) + +(defun pearl--node-matches-name-p (kind node name) + "Return non-nil when NODE of KIND matches NAME. +Members match name, displayName, or email; cycles match name or number; +everything else matches name. Comparison is case-insensitive." + (let ((needle (downcase name))) + (cl-flet ((eqp (field) + (let ((v (cdr (assoc field node)))) + (and (stringp v) (string= (downcase v) needle))))) + (pcase kind + ('members (or (eqp 'name) (eqp 'displayName) (eqp 'email))) + ('cycles (or (eqp 'name) + (let ((n (cdr (assoc 'number node)))) + (and n (string= (number-to-string n) name))))) + (_ (eqp 'name)))))) + +(defun pearl--resolve-team-id (kind name team-id &optional force) + "Resolve NAME to an id within the KIND collection of TEAM-ID, or nil. +Fetches (and caches) the collection via `pearl--team-collection'. With +a single match, returns its id; with several, prompts the user to pick; with +none, returns nil. FORCE refreshes the collection cache first." + (let* ((nodes (pearl--team-collection kind team-id force)) + (matches (seq-filter (lambda (n) (pearl--node-matches-name-p kind n name)) + nodes))) + (pcase (length matches) + (0 nil) + (1 (cdr (assoc 'id (car matches)))) + (_ (let* ((choices (mapcar (lambda (n) + (cons (format "%s (%s)" + (pearl--node-label kind n) + (cdr (assoc 'id n))) + (cdr (assoc 'id n)))) + matches)) + (pick (completing-read (format "Multiple matches for %s: " name) + choices nil t))) + (cdr (assoc pick choices))))))) + +;;;###autoload +(defun pearl-clear-cache () + "Clear the Linear lookup caches (teams, states, per-team collections, issues). +Use after renaming things in Linear, or to force the next lookup to refetch." + (interactive) + (setq pearl--cache-issues nil + pearl--cache-teams nil + pearl--cache-states nil + pearl--cache-team-collections nil + pearl--cache-views nil + pearl--cache-viewer nil) + (message "Linear caches cleared")) + +(defun pearl-update-issue-state (issue-id state-name team-id) + "Update the state of Linear issue with ISSUE-ID to STATE-NAME for TEAM-ID." + (pearl--log "Updating issue %s state to %s for team %s" issue-id state-name team-id) + ;; Resolve the state name to an ID first; bail out clearly if the team has + ;; no such state rather than firing a mutation with a null stateId. + (let ((state-id (pearl--get-state-id-by-name state-name team-id))) + (if (null state-id) + (message "Cannot update issue %s: no Linear state named %s in team %s" + issue-id state-name team-id) + (let* ((query "mutation UpdateIssueState($issueId: String!, $stateId: String!) { + issueUpdate(id: $issueId, input: {stateId: $stateId}) { + success + issue { + id + identifier + state { + id + name + } + } + } + }") + (variables `(("issueId" . ,issue-id) + ("stateId" . ,state-id))) + (response (pearl--graphql-request query variables))) + (if response + (let ((success (and (assoc 'data response) + (assoc 'issueUpdate (assoc 'data response)) + (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data response))))))) + (if success + (message "Updated issue %s state to %s" issue-id state-name) + (pearl--log "Failed to update issue state: %s" (prin1-to-string response)) + (message "Failed to update issue %s state" issue-id))) + (message "Failed to update issue %s state: API error" issue-id)))))) + +(defun pearl--update-issue-state-async (issue-id state-name team-id) + "Asynchronously update a Linear issue's state. +ISSUE-ID is the Linear issue ID. +STATE-NAME is the target state name to set. +TEAM-ID is the team ID of the issue. +Gives immediate feedback and performs the API update in the background." + (pearl--log "Asynchronously updating issue %s state to %s for team %s" issue-id state-name team-id) + + ;; Resolve the state name to an ID first; bail out clearly if the team has + ;; no such state rather than firing a mutation with a null stateId. + (let ((state-id (pearl--get-state-id-by-name state-name team-id))) + (if (null state-id) + (message "Cannot update issue %s: no Linear state named %s in team %s" + issue-id state-name team-id) + (message "Updating issue state to %s... (in background)" state-name) + (let* ((query "mutation UpdateIssueState($issueId: String!, $stateId: String!) { + issueUpdate(id: $issueId, input: {stateId: $stateId}) { + success + issue { + id + identifier + state { + id + name + } + } + } + }") + (variables `(("issueId" . ,issue-id) + ("stateId" . ,state-id))) + (success-handler (lambda (data) + (let ((success (and (assoc 'data data) + (assoc 'issueUpdate (assoc 'data data)) + (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data data))))))) + (if success + (message "Successfully updated issue %s state to %s" issue-id state-name) + (pearl--log "Failed to update issue state asynchronously: %s" (prin1-to-string data)) + (message "Failed to update issue %s state in Linear" issue-id))))) + (error-handler (lambda (error-thrown _response _data) + (message "Error updating issue %s state in Linear: %s" issue-id error-thrown)))) + + (pearl--graphql-request-async query variables success-handler error-handler))))) + +;;; Team Member and Project Management + +(defun pearl-get-team-members (team-id) + "Get members for the given TEAM-ID." + (pearl--log "Fetching team members for team %s" team-id) + (let* ((query "query GetTeamMembers($teamId: String!) { + team(id: $teamId) { + members { + nodes { + id + name + displayName + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((members (cdr (assoc 'nodes (assoc 'members (assoc 'team (assoc 'data response))))))) + (pearl--log "Retrieved %d team members" (length members)) + (let ((formatted-members + (mapcar (lambda (member) + (cons (or (cdr (assoc 'displayName member)) + (cdr (assoc 'name member))) + (cdr (assoc 'id member)))) + members))) + (pearl--log "Formatted team members: %s" (prin1-to-string formatted-members)) + formatted-members))))) + +(defun pearl-get-projects (team-id) + "Get a list of projects for the given TEAM-ID." + (pearl--log "Fetching projects for team %s" team-id) + (let* ((query "query GetProjects($teamId: String!) { + team(id: $teamId) { + projects { + nodes { + id + name + description + state + } + } + } +}") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((projects (cdr (assoc 'nodes (assoc 'projects (assoc 'team (assoc 'data response))))))) + ;; Convert vector to list if needed + (when (vectorp projects) + (setq projects (append projects nil))) + (pearl--log "Retrieved %d projects" (length projects)) + projects)))) + +(defun pearl-select-project (team-id) + "Prompt user to select a project from TEAM-ID." + (let* ((projects (pearl-get-projects team-id)) + (project-names (when projects + (mapcar (lambda (project) + (cons (cdr (assoc 'name project)) project)) + projects))) + (selected (when project-names + (completing-read "Select project (optional): " + (cons "None" project-names) nil t nil nil "None")))) + (unless (string= selected "None") + (cdr (assoc selected project-names))))) + +;;; Other Issue Attributes + +(defun pearl-get-priorities () + "Get priority options for Linear issues." + ;; Linear uses integers for priorities: 0 (No priority), 1 (Urgent), 2 (High), 3 (Medium), 4 (Low) + '(("No priority" . 0) + ("Urgent" . 1) + ("High" . 2) + ("Medium" . 3) + ("Low" . 4))) + +(defun pearl-get-issue-types (team-id) + "Get issue types for the given TEAM-ID." + (pearl--log "Fetching issue types for team %s" team-id) + (let* ((query "query GetIssueTypes($teamId: String!) { + team(id: $teamId) { + labels { + nodes { + id + name + color + } + } + } + }") + (variables `(("teamId" . ,team-id))) + (response (pearl--graphql-request query variables))) + (when response + (let ((labels (cdr (assoc 'nodes (assoc 'labels (assoc 'team (assoc 'data response))))))) + (mapcar (lambda (label) + (cons (cdr (assoc 'name label)) + (cdr (assoc 'id label)))) + labels))))) + +;;; Org Mode Integration + +(defun pearl-org-hook-function () + "Sync to Linear when the configured Linear org file is saved. +Fires only for the buffer visiting `pearl-org-file-path', so a +custom output path is honored instead of a hardcoded \"linear.org\" name." + (when (and buffer-file-name + pearl-org-file-path + (string-equal (file-truename buffer-file-name) + (file-truename pearl-org-file-path))) + (pearl--log "Linear org file saved, syncing changes to Linear API") + (pearl-sync-org-to-linear))) + +(defun pearl--extract-org-heading-properties () + "Extract Linear issue properties from the org entry at point. +Returns a plist with :todo-state, :issue-id, :issue-identifier, and :team-id, +read from the entry's LINEAR-* property drawer via org APIs. Works from +anywhere inside the entry and at any heading depth, and reads by property name +rather than scanning lines, so body text or nested sub-entries don't confuse +it. Returns nil when point is not within a heading; the id fields are nil for +a non-issue heading. The team id is read directly from `LINEAR-TEAM-ID', so +there is no network lookup here." + (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (list :todo-state (org-get-todo-state) + :issue-id (org-entry-get nil "LINEAR-ID") + :issue-identifier (org-entry-get nil "LINEAR-IDENTIFIER") + :team-id (org-entry-get nil "LINEAR-TEAM-ID"))))) + + +(defun pearl--process-heading-at-point () + "Process the Linear issue at the current org heading." + (let* ((props (pearl--extract-org-heading-properties)) + (todo-state (plist-get props :todo-state)) + (issue-id (plist-get props :issue-id)) + (issue-identifier (plist-get props :issue-identifier)) + (team-id (plist-get props :team-id))) + + ;; Only sync when this heading is a Linear issue (has id, identifier, team). + (when (and issue-id issue-identifier team-id) + (let ((linear-state (pearl--map-org-state-to-linear todo-state))) + (when linear-state + (pearl--update-issue-state-async issue-id linear-state team-id)))))) + +(defun pearl-sync-org-to-linear () + "Syncs change from linear.org to Linear API." + (interactive) + ;; If called from org-after-todo-state-change-hook, just process the current heading + (if (eq this-command 'org-todo) + (pearl-sync-current-heading-to-linear) + ;; Otherwise, scan the entire file + (save-excursion + (goto-char (point-min)) + (let ((todo-states-pattern (pearl--get-todo-states-pattern))) + (while (re-search-forward (format "^\\*+ \\(%s\\)" todo-states-pattern) nil t) + ;; Process at the heading start, but keep the outer point at the end + ;; of this match so the next search advances past it. Without the + ;; save-excursion, `beginning-of-line' rewinds point and the search + ;; re-matches the same heading forever. + (save-excursion + (beginning-of-line) + (pearl--process-heading-at-point))))))) + +(defun pearl-sync-current-heading-to-linear () + "Sync the current org heading's TODO state to the Linear API. +Used when directly changing a TODO state in the org buffer." + (save-excursion + ;; Move up to the enclosing heading. `org-back-to-heading' signals + ;; "before first heading" in the preamble; guard so the sync entry point + ;; degrades to a no-op there instead of erroring. + (when (ignore-errors (org-back-to-heading t) t) + (pearl--process-heading-at-point)))) + +;;; Mapping Functions + +(defun pearl--map-linear-state-to-org (state) + "Map Linear STATE name to an Org TODO keyword string. +STATE is the Linear state string." + (or (cdr (assoc state pearl-state-to-todo-mapping)) + "TODO")) ; Default fallback + +(defun pearl--map-org-state-to-linear (todo-state) + "Map an Org TODO-STATE keyword to a Linear state name. +TODO-STATE is the Org keyword string." + (or (car (rassoc todo-state pearl-state-to-todo-mapping)) + nil)) + + +(defun pearl--get-todo-states-pattern () + "Return the regex pattern matching the Org TODO states. +Built from the org keywords in `pearl-state-to-todo-mapping' and +cached in `pearl-todo-states-pattern'. The cache is rebuilt when +the mapping changes, so a mid-session `setq' or customization takes effect." + (unless (and pearl-todo-states-pattern + (eq pearl--todo-states-pattern-source + pearl-state-to-todo-mapping)) + ;; Pattern like "TODO\\|IN-PROGRESS\\|IN-REVIEW\\|BACKLOG\\|BLOCKED\\|DONE". + (setq pearl--todo-states-pattern-source pearl-state-to-todo-mapping + pearl-todo-states-pattern + (mapconcat #'regexp-quote + (mapcar #'cdr pearl-state-to-todo-mapping) + "\\|"))) + pearl-todo-states-pattern) + +(defun pearl--map-linear-priority-to-org (priority-num) + "Convert Linear PRIORITY-NUM to an Org priority cookie. +PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." + (cond + ((eq priority-num 1) "[#A]") ; Urgent -> A + ((eq priority-num 2) "[#B]") ; High -> B + ((eq priority-num 3) "[#C]") ; Medium -> C + ((eq priority-num 4) "[#D]") ; Low -> D + (t "[#C]"))) ; Default -> C + +(defun pearl--get-linear-priority-name (priority-num) + "Convert Linear PRIORITY-NUM to a readable name. +PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." + (cond + ((eq priority-num 1) "Urgent") + ((eq priority-num 2) "High") + ((eq priority-num 3) "Medium") + ((eq priority-num 4) "Low") + (t "Medium"))) + +(defun pearl--md-line-to-org (line) + "Convert inline markdown in LINE to Org markup. +Handles links, inline code, bold, and underscore italics; other inline markup +passes through unchanged." + (let ((s line)) + ;; [text](url) -> [[url][text]] (before code/emphasis touch the brackets) + (setq s (replace-regexp-in-string + "\\[\\([^]]+\\)\\](\\([^) ]+\\))" "[[\\2][\\1]]" s)) + ;; `code` -> ~code~ + (setq s (replace-regexp-in-string "`\\([^`\n]+\\)`" "~\\1~" s)) + ;; **bold** -> *bold* + (setq s (replace-regexp-in-string "\\*\\*\\([^*\n]+?\\)\\*\\*" "*\\1*" s)) + ;; _italic_ -> /italic/, word-bounded so identifiers like foo_bar are left alone + (setq s (replace-regexp-in-string + "\\(^\\|[^[:alnum:]_]\\)_\\([^_\n]+?\\)_\\([^[:alnum:]_]\\|$\\)" + "\\1/\\2/\\3" s)) + s)) + +(defun pearl--md-to-org (md) + "Convert markdown MD to Org markup (the pure-elisp conversion tier). +Converts fenced code blocks to `#+begin_src'/`#+end_src', markdown headings to +bold lines (never Org headings), markdown bullets (`*' / `+') to `-', and the +inline markup in `pearl--md-line-to-org'. Any other line that would +read as an Org heading is space-guarded. Tables, HTML, and unrecognized +constructs pass through as literal text. Returns the empty string for an empty +MD." + (if (or (null md) (string-empty-p md)) + "" + (let ((in-code nil) (out '())) + (dolist (line (split-string md "\n")) + (cond + ;; fenced code fence: ``` or ```lang + ((string-match "\\`[ \t]*```\\(.*\\)\\'" line) + (if in-code + (progn (push "#+end_src" out) (setq in-code nil)) + (push (format "#+begin_src %s" (string-trim (match-string 1 line))) out) + (setq in-code t))) + (in-code (push line out)) + ;; markdown heading -> bold line, not an Org heading + ((string-match "\\`#+[ \t]+\\(.*\\)\\'" line) + (push (format "*%s*" (string-trim (match-string 1 line))) out)) + ;; markdown bullet -> Org dash bullet + ((string-match "\\`\\([ \t]*\\)[*+][ \t]+\\(.*\\)\\'" line) + (push (concat (match-string 1 line) "- " + (pearl--md-line-to-org (match-string 2 line))) + out)) + ;; guard any remaining line that Org would read as a heading + ((string-match "\\`\\*+ " line) + (push (concat " " (pearl--md-line-to-org line)) out)) + (t (push (pearl--md-line-to-org line) out)))) + (string-join (nreverse out) "\n")))) + +(defun pearl--org-line-to-md (line) + "Convert inline Org markup in LINE back to markdown. +The inverse of `pearl--md-line-to-org': org links, verbatim, bold, and +italics become their markdown forms. Other text passes through unchanged. +Italics are word-bounded so filesystem paths and URLs are left alone." + (let ((s line)) + ;; [[url][text]] -> [text](url) (before verbatim/emphasis touch brackets) + (setq s (replace-regexp-in-string + "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" "[\\2](\\1)" s)) + ;; [[url]] -> url + (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\]" "\\1" s)) + ;; ~code~ -> `code` + (setq s (replace-regexp-in-string "~\\([^~\n]+\\)~" "`\\1`" s)) + ;; *bold* -> **bold** + (setq s (replace-regexp-in-string "\\*\\([^*\n]+?\\)\\*" "**\\1**" s)) + ;; /italic/ -> _italic_, word-bounded so /usr/local paths are left alone + (setq s (replace-regexp-in-string + "\\(^\\|[^[:alnum:]/]\\)/\\([^/\n]+?\\)/\\([^[:alnum:]/]\\|$\\)" + "\\1_\\2_\\3" s)) + s)) + +(defun pearl--org-to-md (org) + "Convert Org markup ORG back to markdown (the push direction). +The symmetric inverse of `pearl--md-to-org': `#+begin_src'/`#+end_src' +become fenced code (language preserved, contents verbatim), `#+begin_quote' +blocks become `>'-prefixed lines, Org checkbox marks normalize to markdown +lowercase, and the inline markup in `pearl--org-line-to-md' is undone. +Tables, HTML, and unrecognized lines pass through literally. Returns the +empty string for an empty ORG. + +Two constructs are intentionally lossy and do not round-trip back to their +markdown source: a markdown `# heading' (rendered to a bold line on fetch) +stays a bold line, and single-asterisk markdown italics are unsupported on +fetch. Both are documented in the conversion matrix." + (if (or (null org) (string-empty-p org)) + "" + (let ((in-code nil) (in-quote nil) (out '())) + (dolist (line (split-string org "\n")) + (cond + ;; src block open: #+begin_src or #+begin_src lang + ((string-match "\\`[ \t]*#\\+begin_src\\(.*\\)\\'" line) + (push (format "```%s" (string-trim (match-string 1 line))) out) + (setq in-code t)) + ((and in-code (string-match "\\`[ \t]*#\\+end_src[ \t]*\\'" line)) + (push "```" out) (setq in-code nil)) + (in-code (push line out)) + ;; quote block: drop the markers, prefix the contents with "> " + ((string-match "\\`[ \t]*#\\+begin_quote[ \t]*\\'" line) + (setq in-quote t)) + ((and in-quote (string-match "\\`[ \t]*#\\+end_quote[ \t]*\\'" line)) + (setq in-quote nil)) + (in-quote (push (concat "> " (pearl--org-line-to-md line)) out)) + ;; checkbox: normalize the uppercase Org mark to markdown lowercase + ((string-match "\\`\\([ \t]*\\)- \\[\\([ xX]\\)\\] \\(.*\\)\\'" line) + (push (concat (match-string 1 line) + "- [" (downcase (match-string 2 line)) "] " + (pearl--org-line-to-md (match-string 3 line))) + out)) + (t (push (pearl--org-line-to-md line) out)))) + (string-join (nreverse out) "\n")))) + +(defun pearl--format-comment (comment) + "Format a normalized COMMENT plist as a level-4 Org entry. +The heading carries the author and timestamp; a property drawer carries the +comment id, the author's user id (empty for bot/external comments, which are +not editable), and a sha256 of the last-fetched body for the sync conflict +gate. The body runs through the same markdown->org tier as the description. +A null author renders as `(unknown)'." + (let ((author (or (plist-get comment :author) "(unknown)")) + (created (or (plist-get comment :created-at) "")) + (raw-body (or (plist-get comment :body) "")) + (body (pearl--md-to-org (or (plist-get comment :body) "")))) + (concat (format "**** %s — %s\n" author created) + ":PROPERTIES:\n" + (format ":LINEAR-COMMENT-ID: %s\n" (or (plist-get comment :id) "")) + (format ":LINEAR-COMMENT-AUTHOR-ID: %s\n" (or (plist-get comment :author-id) "")) + (format ":LINEAR-COMMENT-SHA256: %s\n" (secure-hash 'sha256 raw-body)) + ":END:\n" + (if (string-empty-p body) "" (concat body "\n"))))) + +(defun pearl--format-comments (comments) + "Format COMMENTS (a list of normalized comment plists) as a Comments subtree. +Comments render oldest-first under a level-3 `Comments' heading. Returns the +empty string when COMMENTS is nil, so an issue with no comments renders no +subtree." + (if (null comments) + "" + (let ((sorted (sort (copy-sequence comments) + (lambda (a b) + (string< (or (plist-get a :created-at) "") + (or (plist-get b :created-at) "")))))) + (concat "*** Comments\n" + (mapconcat #'pearl--format-comment sorted ""))))) + +(defun pearl--format-issue-as-org-entry (issue) + "Format a normalized ISSUE plist as an Org entry. +The heading carries the title; structured fields live in a namespaced +`LINEAR-*' property drawer (changed via commands, not by hand); the issue +description renders as the entry body. `LINEAR-DESC-SHA256' (the markdown) and +`LINEAR-DESC-UPDATED-AT' record the description's provenance for the sync-back +conflict gates; `LINEAR-DESC-ORG-SHA256' hashes the rendered Org body so a +later refresh can tell a real local edit from a lossy md->org round-trip +without re-deriving the markdown. `LINEAR-TITLE-SHA256' is the title's hash +(over the rendered, bracket-stripped title)." + (let* ((title (or (plist-get issue :title) "")) + (description (or (plist-get issue :description) "")) + (state (plist-get issue :state)) + (team (plist-get issue :team)) + (project (plist-get issue :project)) + (assignee (plist-get issue :assignee)) + (todo (pearl--map-linear-state-to-org (plist-get state :name))) + (priority (pearl--map-linear-priority-to-org (plist-get issue :priority))) + (sanitized-title (replace-regexp-in-string "\\[\\|\\]" "" title)) + (label-names (mapconcat (lambda (l) (or (plist-get l :name) "")) + (plist-get issue :labels) ", ")) + (body-org (pearl--md-to-org description))) + (concat + (format "** %s %s %s\n" todo priority sanitized-title) + ":PROPERTIES:\n" + (format ":LINEAR-ID: %s\n" (or (plist-get issue :id) "")) + (format ":LINEAR-IDENTIFIER: %s\n" (or (plist-get issue :identifier) "")) + (format ":LINEAR-URL: %s\n" + (or (plist-get issue :url) + (format "https://linear.app/issue/%s" (or (plist-get issue :identifier) "")))) + (format ":LINEAR-TEAM-ID: %s\n" (or (plist-get team :id) "")) + (format ":LINEAR-TEAM-NAME: %s\n" (or (plist-get team :name) "")) + (format ":LINEAR-PROJECT-ID: %s\n" (or (plist-get project :id) "")) + (format ":LINEAR-PROJECT-NAME: %s\n" (or (plist-get project :name) "")) + (format ":LINEAR-STATE-ID: %s\n" (or (plist-get state :id) "")) + (format ":LINEAR-STATE-NAME: %s\n" (or (plist-get state :name) "")) + (format ":LINEAR-ASSIGNEE-ID: %s\n" (or (plist-get assignee :id) "")) + (format ":LINEAR-ASSIGNEE-NAME: %s\n" (or (plist-get assignee :name) "")) + (format ":LINEAR-LABELS: [%s]\n" label-names) + (format ":LINEAR-DESC-SHA256: %s\n" (secure-hash 'sha256 description)) + (format ":LINEAR-DESC-ORG-SHA256: %s\n" (secure-hash 'sha256 (string-trim body-org))) + (format ":LINEAR-DESC-UPDATED-AT: %s\n" (or (plist-get issue :updated-at) "")) + (format ":LINEAR-TITLE-SHA256: %s\n" (secure-hash 'sha256 sanitized-title)) + ":END:\n" + (if (string-empty-p body-org) "" (concat body-org "\n")) + (pearl--format-comments (plist-get issue :comments))))) + +;;; Description Sync-Back + +(defun pearl--sync-decision (local-md stored-hash remote-md) + "Decide how to sync a description edit. +LOCAL-MD is the current Org body rendered back to markdown. STORED-HASH is +the sha256 of the markdown recorded when the issue was last fetched. REMOTE-MD +is the description as it stands on Linear right now. Returns: + +- `:noop' -- nothing to push (no local edit, or local already matches + remote), +- `:push' -- a local edit against an unchanged remote: safe to push, +- `:conflict' -- both sides changed since the last fetch." + (let ((local-hash (secure-hash 'sha256 (or local-md ""))) + (remote-hash (secure-hash 'sha256 (or remote-md "")))) + (cond + ((string= local-hash stored-hash) :noop) + ((string= local-hash remote-hash) :noop) + ((string= remote-hash stored-hash) :push) + (t :conflict)))) + +;;; Conflict Resolution + +;; When a description, title, or comment changed both locally and on Linear +;; since the last fetch, `pearl--sync-decision' returns `:conflict'. Instead of +;; only refusing, the sync commands offer use-local / use-remote / rewrite (and +;; cancel). The hard rule: no resolution silently discards the local edit, so +;; any destructive choice stashes it first (see `pearl--stash-conflict-text'). + +(defconst pearl--conflict-backup-buffer "*pearl-conflict-backup*" + "Buffer holding stashed local text from destructive conflict resolutions.") + +(defun pearl--stash-conflict-text (label text) + "Stash TEXT so a destructive conflict resolution can't lose it. +Pushes TEXT onto the `kill-ring' (recover with `yank') and appends it to the +`pearl--conflict-backup-buffer' under a heading naming LABEL and the time. +Called before \"use remote\" or a rewrite replaces the local edit. Empty TEXT +is a no-op -- there is nothing to lose." + (when (and text (not (string-empty-p text))) + (kill-new text) + (with-current-buffer (get-buffer-create pearl--conflict-backup-buffer) + (goto-char (point-max)) + (unless (bobp) (insert "\n")) + (insert (format "## %s -- %s\n" label + (format-time-string "%Y-%m-%d %H:%M:%S"))) + (insert text) + (unless (string-suffix-p "\n" text) (insert "\n"))))) + +(defun pearl--conflict-smerge-string (local remote) + "Return a git-style merge-conflict string with LOCAL and REMOTE sections. +LOCAL is the user's current text, REMOTE is Linear's. Each section is newline +terminated so the markers always start their own line; the result is meant to +drop into `smerge-mode' for resolution." + (concat "<<<<<<< LOCAL (your edit)\n" + local (unless (string-suffix-p "\n" local) "\n") + "=======\n" + remote (unless (string-suffix-p "\n" remote) "\n") + ">>>>>>> REMOTE (Linear)\n")) + +(defun pearl--read-conflict-resolution (label) + "Prompt for how to resolve the conflict on LABEL, returning a symbol. +One of `use-local' (push mine, overwrite Linear), `use-remote' (take Linear's, +stash mine), `rewrite' (merge both in a buffer), or `cancel'. A bare RET +defaults to `cancel', leaving everything untouched." + (let* ((choices '(("cancel -- leave both untouched" . cancel) + ("use local -- push my version, overwrite Linear" . use-local) + ("use remote -- take Linear's, stash mine" . use-remote) + ("rewrite -- merge both in a buffer" . rewrite))) + (default (caar choices)) + (pick (completing-read + (format "Conflict on %s (RET cancels): " label) + (mapcar #'car choices) nil t nil nil default))) + (cdr (assoc pick choices)))) + +(defun pearl--set-entry-body-at-point (org-text) + "Replace the body of the org entry at point with ORG-TEXT. +The body is the region after the entry's drawers and before its first child +heading, so a Comments subtree is left intact. ORG-TEXT is org markup (already +converted from markdown); an empty string clears the body. Used to write a +resolved description or comment back into the buffer." + (save-excursion + (org-back-to-heading t) + (org-end-of-meta-data t) + (let ((beg (point)) + (end (save-excursion (outline-next-heading) (point)))) + (delete-region beg end) + (goto-char beg) + (unless (string-empty-p org-text) + (insert org-text "\n"))))) + +(defun pearl--resolve-conflict (label local-md remote-md marker stored-prop apply-fn push-fn) + "Interactively resolve a sync conflict on LABEL. +LOCAL-MD and REMOTE-MD are the two diverged versions. MARKER anchors the org +entry; STORED-PROP is the provenance property advanced on resolution (such as +\"LINEAR-DESC-SHA256\"). APPLY-FN takes a text string and writes it into the +buffer (re-rendering the body, title, or comment); PUSH-FN takes a text string +and a callback invoked with non-nil on a successful push. + +Resolutions (see `pearl--read-conflict-resolution'): `cancel' leaves both +untouched; `use-local' pushes the local text and advances the hash on success; +`use-remote' stashes the local text, writes Linear's version in, and advances +the hash with no push (the remote is already current). `rewrite' is the +deferred smerge flow -- for now it stashes the local text and redirects, so +nothing is lost." + (pcase (pearl--read-conflict-resolution label) + ('cancel + (message "Left %s untouched (refresh to see Linear's version)" label)) + ('use-local + (funcall push-fn local-md + (lambda (ok) + (if ok + (progn + (org-entry-put marker stored-prop + (secure-hash 'sha256 local-md)) + (message "Pushed your %s to Linear" label)) + (message "Failed to push %s" label))))) + ('use-remote + (pearl--stash-conflict-text label local-md) + (funcall apply-fn remote-md) + (org-entry-put marker stored-prop (secure-hash 'sha256 remote-md)) + (message "Took Linear's %s; your version is on the kill ring and in %s" + label pearl--conflict-backup-buffer)) + ('rewrite + (pearl--stash-conflict-text label local-md) + (pearl--resolve-conflict-in-smerge + label local-md remote-md + (lambda (reconciled) + (funcall apply-fn reconciled) + (funcall push-fn reconciled + (lambda (ok) + (if ok + (progn + (org-entry-put marker stored-prop + (secure-hash 'sha256 reconciled)) + (message "Synced merged %s to Linear" label)) + (message "Failed to push merged %s" label))))))))) + +(defvar-local pearl--conflict-on-finish nil + "Callback invoked with the reconciled text when a conflict buffer commits.") + +(defun pearl--conflict-has-markers-p (text) + "Return non-nil if any git-style conflict markers remain in TEXT. +Used to refuse a commit while the user has left a section unresolved." + (and (string-match-p "^\\(<<<<<<<\\|=======\\|>>>>>>>\\)" text) t)) + +(defun pearl--resolve-conflict-in-smerge (label local remote on-finish) + "Open an smerge buffer to reconcile LOCAL vs REMOTE for LABEL. +The user resolves the conflict markers with the usual `smerge-mode' commands, +then \\[pearl--conflict-commit] hands the reconciled text to ON-FINISH and kills +the buffer, while \\[pearl--conflict-abort] cancels (the local text is already +stashed). ON-FINISH runs only when no conflict markers remain." + (require 'smerge-mode) + (let ((buf (get-buffer-create (format "*pearl-merge: %s*" label)))) + (with-current-buffer buf + (erase-buffer) + (insert (pearl--conflict-smerge-string local remote)) + (goto-char (point-min)) + (smerge-mode 1) + (setq-local pearl--conflict-on-finish on-finish) + (local-set-key (kbd "C-c C-c") #'pearl--conflict-commit) + (local-set-key (kbd "C-c C-k") #'pearl--conflict-abort) + (setq-local header-line-format + (substitute-command-keys + "Resolve the conflict, then \\[pearl--conflict-commit] to push, \\[pearl--conflict-abort] to abort"))) + (pop-to-buffer buf))) + +(defun pearl--conflict-commit () + "Finish the current pearl conflict buffer, pushing the reconciled text. +Refuses while conflict markers remain; otherwise hands the buffer text to the +armed ON-FINISH callback and kills the buffer." + (interactive) + (let ((text (buffer-string))) + (when (pearl--conflict-has-markers-p text) + (user-error "Unresolved conflict markers remain; resolve them or abort with C-c C-k")) + (let ((cb pearl--conflict-on-finish)) + (kill-buffer (current-buffer)) + (when cb (funcall cb text))))) + +(defun pearl--conflict-abort () + "Abort the current pearl conflict buffer without pushing. +The local text was stashed before the buffer opened, so nothing is lost." + (interactive) + (kill-buffer (current-buffer)) + (message "Conflict resolution aborted; your text is on the kill ring and in %s" + pearl--conflict-backup-buffer)) + +(defun pearl--issue-body-at-point () + "Return the description body of the Linear issue subtree at point. +The body is the text after the property drawer and before the first child +heading (so a Comments subtree is excluded), trimmed of surrounding +whitespace. Returns the empty string when the entry has no body." + (save-excursion + (org-back-to-heading t) + ;; Fix the body's end (the next heading: a Comments child or the next + ;; issue) from the heading itself, before `org-end-of-meta-data' moves + ;; point. For an empty body that call skips blank lines and lands on the + ;; next heading, so without this clamp the body would overshoot into the + ;; next issue's whole subtree. + (let ((end (save-excursion (outline-next-heading) (point)))) + (org-end-of-meta-data t) + (if (>= (point) end) + "" + (string-trim (buffer-substring-no-properties (point) end)))))) + +(defun pearl--fetch-issue-description-async (issue-id callback) + "Fetch ISSUE-ID's current description and timestamp from Linear. +CALLBACK is called with a plist (:description STR :updated-at STR) on success, +or nil on error." + (let ((query "query IssueDescription($id: String!) { + issue(id: $id) { + description + updatedAt + } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((issue (cdr (assoc 'issue (assoc 'data data))))) + (funcall callback + (when issue + (list :description (or (cdr (assoc 'description issue)) "") + :updated-at (cdr (assoc 'updatedAt issue))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-issue-description-async (issue-id markdown callback) + "Push MARKDOWN as ISSUE-ID's description via issueUpdate. +CALLBACK is called with a plist (:success BOOL :updated-at STR)." + (let ((query "mutation UpdateIssueDescription($id: String!, $description: String!) { + issueUpdate(id: $id, input: {description: $description}) { + success + issue { + id + updatedAt + } + } + }") + (variables `(("id" . ,issue-id) ("description" . ,markdown)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--fetch-issue-title-async (issue-id callback) + "Fetch ISSUE-ID's current title and timestamp from Linear. +CALLBACK is called with a plist (:title STR :updated-at STR) on success, or nil +on error." + (let ((query "query IssueTitle($id: String!) { + issue(id: $id) { + title + updatedAt + } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((issue (cdr (assoc 'issue (assoc 'data data))))) + (funcall callback + (when issue + (list :title (or (cdr (assoc 'title issue)) "") + :updated-at (cdr (assoc 'updatedAt issue))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-issue-title-async (issue-id title callback) + "Push TITLE as ISSUE-ID's title via issueUpdate. +CALLBACK is called with a plist (:success BOOL :updated-at STR)." + (let ((query "mutation UpdateIssueTitle($id: String!, $title: String!) { + issueUpdate(id: $id, input: {title: $title}) { + success + issue { + id + updatedAt + } + } + }") + (variables `(("id" . ,issue-id) ("title" . ,title)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--issue-title-at-point () + "Return the title of the Linear issue heading at point. +Strips the TODO keyword, priority cookie, and tags, leaving the bare title +text (which is the bracket-stripped form the renderer wrote)." + (save-excursion + (org-back-to-heading t) + (org-get-heading t t t t))) + +;;;###autoload +(defun pearl-sync-current-issue () + "Push the description edited in the Org body of the issue at point to Linear. +Works from anywhere inside an issue subtree. The push is gated: if the body +is unchanged since the last fetch nothing is sent; if it was edited and the +remote is unchanged the edit is pushed and the provenance properties advance; +if both the body and the remote changed since the last fetch the push is +refused and the conflict reported (refresh to reconcile)." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let* ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (if (string= (secure-hash 'sha256 local-md) (or stored "")) + (message "No description changes to sync for %s" issue-id) + (pearl--progress "Checking Linear for remote changes...") + (pearl--fetch-issue-description-async + issue-id + (lambda (remote) + (if (null remote) + (message "Could not fetch %s from Linear; not syncing" issue-id) + (pcase (pearl--sync-decision + local-md stored (plist-get remote :description)) + (:noop (message "%s already matches Linear" issue-id)) + (:conflict + (pearl--resolve-conflict + (format "%s description" issue-id) + local-md (plist-get remote :description) + marker "LINEAR-DESC-SHA256" + (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md)))) + (lambda (md cb) + (pearl--update-issue-description-async + issue-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-issue-description-async + issue-id local-md + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-DESC-SHA256" + (secure-hash 'sha256 local-md)) + (when (plist-get result :updated-at) + (org-entry-put marker "LINEAR-DESC-UPDATED-AT" + (plist-get result :updated-at))) + (message "Synced description for %s to Linear" issue-id) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync description for %s" issue-id)))))))))))))) + +;;;###autoload +(defun pearl-sync-current-issue-title () + "Push the title edited in the heading of the issue at point to Linear. +A separate path from the description sync, sharing the same conflict gate and +working from anywhere inside an issue subtree. Note the title is lossy: the +renderer strips square brackets, so the heading holds the stripped form and a +push sends that stripped title. Gated like the description sync: unchanged +title sends nothing; a local edit against an unchanged remote pushes and +advances the title provenance; both-changed refuses and reports the conflict." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-TITLE-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let ((local-title (pearl--issue-title-at-point))) + (if (string= (secure-hash 'sha256 local-title) (or stored "")) + (message "No title changes to sync for %s" issue-id) + (pearl--progress "Checking Linear for remote title changes...") + (pearl--fetch-issue-title-async + issue-id + (lambda (remote) + (if (null remote) + (message "Could not fetch %s from Linear; not syncing" issue-id) + (pcase (pearl--sync-decision + local-title stored (plist-get remote :title)) + (:noop (message "%s title already matches Linear" issue-id)) + (:conflict + (pearl--resolve-conflict + (format "%s title" issue-id) + local-title (plist-get remote :title) + marker "LINEAR-TITLE-SHA256" + (lambda (md) + (org-with-point-at marker + (org-back-to-heading t) + (org-edit-headline md))) + (lambda (md cb) + (pearl--update-issue-title-async + issue-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-issue-title-async + issue-id local-title + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-TITLE-SHA256" + (secure-hash 'sha256 local-title)) + (message "Synced title for %s to Linear" issue-id) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync title for %s" issue-id)))))))))))))) + +(defun pearl--replace-issue-subtree-at-point (issue) + "Replace the issue subtree at point with a freshly formatted ISSUE entry. +ISSUE is a normalized issue plist. The whole subtree (heading, drawer, body, +and any comment children) is rewritten from the entry, so the rendered result +matches a first fetch." + (save-excursion + (org-back-to-heading t) + (let ((beg (point)) + (end (save-excursion (org-end-of-subtree t t) (point)))) + (delete-region beg end) + (goto-char beg) + (insert (pearl--format-issue-as-org-entry issue)) + ;; Close the rewritten subtree's drawer(s) but leave the issue itself + ;; expanded -- a single-issue refresh keeps the user on the issue they + ;; were looking at, unlike a full repopulation which re-folds the page. + (when pearl-fold-after-update + (save-excursion + (goto-char beg) + (save-restriction + (org-narrow-to-subtree) + (pearl--hide-all-drawers))))))) + +;;;###autoload +(defun pearl-refresh-current-issue () + "Re-fetch the issue at point from Linear and rewrite its subtree in place. +Works from anywhere inside an issue subtree. If the description body has +unpushed local edits, they are stashed first (kill ring + the conflict-backup +buffer) so the refresh can't silently lose them (decision 4), then the refresh +proceeds and the subtree is replaced with Linear's version." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + ;; Stash an unpushed edit before the overwrite rather than refusing, + ;; so an explicit single-issue refresh always proceeds without data loss. + (unless (string= (secure-hash 'sha256 local-md) (or stored "")) + (pearl--stash-conflict-text + (format "%s description (pre-refresh)" issue-id) local-md)) + (pearl--progress "Refreshing %s from Linear..." issue-id) + (pearl--fetch-issue-async + issue-id + (lambda (result) + (pcase result + ((or :error (pred null)) + (message "Linear returned an error fetching %s; not refreshing" issue-id)) + (:missing + (message "Issue %s is no longer on Linear (deleted or no access); not refreshing" + issue-id)) + (raw + (save-excursion + (goto-char marker) + (pearl--replace-issue-subtree-at-point + (pearl--normalize-issue raw))) + (pearl-highlight-comments) + (pearl--surface-buffer (marker-buffer marker)) + (message "Refreshed %s from Linear" issue-id))))))))) + +(defun pearl--create-comment-async (issue-id body callback) + "Create a comment with BODY on ISSUE-ID via commentCreate. +CALLBACK is called with the normalized comment plist on success, or nil on a +GraphQL/transport failure or a non-success payload." + (let ((query "mutation CommentCreate($issueId: String!, $body: String!) { + commentCreate(input: {issueId: $issueId, body: $body}) { + success + comment { + id body createdAt + user { id name displayName } + botActor { name } + externalUser { name } + } + } + }") + (variables `(("issueId" . ,issue-id) ("body" . ,body)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'commentCreate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (comment (cdr (assoc 'comment payload)))) + (funcall callback + (and success comment (pearl--normalize-comment comment))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--append-comment-to-issue (comment) + "Insert COMMENT (a normalized plist) under the issue subtree at point. +Appends after any existing comments in the issue's `Comments' subtree, creating +that subtree at the end of the issue when it does not exist yet." + (save-excursion + (org-back-to-heading t) + (let* ((issue-end (save-excursion (org-end-of-subtree t t) (point))) + (comments-pos + (save-excursion + (when (re-search-forward "^\\*+ Comments[ \t]*$" issue-end t) + (match-beginning 0))))) + (if comments-pos + (progn + (goto-char comments-pos) + (org-end-of-subtree t t) + (insert (pearl--format-comment comment))) + (goto-char issue-end) + (insert "*** Comments\n" (pearl--format-comment comment)))))) + +;;;###autoload +(defun pearl-add-comment (body) + "Add a comment with BODY to the Linear issue at point and insert it. +Works from anywhere inside an issue subtree. The new comment is the viewer's +own, so it renders editable; edit it later with +`pearl-edit-current-comment'." + (interactive "sComment: ") + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (pearl--progress "Adding comment to %s..." issue-id) + (pearl--create-comment-async + issue-id body + (lambda (comment) + (if (null comment) + (message "Failed to add comment to %s" issue-id) + (save-excursion + (goto-char marker) + (pearl--append-comment-to-issue comment)) + (pearl-highlight-comments) + (pearl--surface-buffer (marker-buffer marker)) + (message "Added comment to %s" issue-id))))))) + +;;;###autoload +(defun pearl-open-current-issue () + "Open the Linear issue at point in the browser. +Reads the `LINEAR-URL' property of the enclosing issue heading and hands it to +`browse-url'. Works from anywhere inside the issue subtree." + (interactive) + (let ((url (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (org-entry-get nil "LINEAR-URL")))) + (unless (and url (not (string-empty-p url))) + (user-error "No LINEAR-URL on the issue at point")) + (browse-url url))) + +(defun pearl--delete-issue-async (issue-id callback) + "Delete ISSUE-ID on Linear via issueDelete, calling CALLBACK with the outcome. +CALLBACK receives a plist (:success BOOL). Linear's `issueDelete' is a soft +delete: it moves the issue to Trash (recoverable for about 30 days), not a +permanent purge." + (let ((query "mutation IssueDelete($id: String!) { + issueDelete(id: $id) { success } + }") + (variables `(("id" . ,issue-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((payload (cdr (assoc 'issueDelete (assoc 'data data))))) + (funcall callback + (list :success (eq t (cdr (assoc 'success payload))))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +;;;###autoload +(defun pearl-delete-current-issue () + "Delete the Linear issue at point after confirmation, removing its subtree. +Works from anywhere inside an issue subtree. Confirms first, then issues a +soft delete (Linear moves the issue to Trash, recoverable for about 30 days); +on success the issue's Org subtree is removed from the buffer." + (interactive) + (unless (save-excursion (ignore-errors (org-back-to-heading t) t)) + (user-error "Not on a Linear issue heading")) + (let* ((marker (save-excursion (org-back-to-heading t) (point-marker))) + (issue-id (org-entry-get marker "LINEAR-ID")) + (ident (or (org-entry-get marker "LINEAR-IDENTIFIER") "this issue"))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (when (yes-or-no-p (format "Delete %s from Linear (moves it to Trash)? " ident)) + (pearl--delete-issue-async + issue-id + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-back-to-heading t) + (delete-region (point) + (progn (org-end-of-subtree t t) (point)))) + (message "Deleted %s (moved to Trash on Linear)" ident) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to delete %s" ident))))))) + +;;; Command-managed Drawer Fields + +(defun pearl--update-issue-async (issue-id input callback) + "Push INPUT (an `IssueUpdateInput' alist) to ISSUE-ID via issueUpdate. +INPUT is an alist of field names to values, such as a single +\"priority\"/2 or \"stateId\"/id pair, json-encoded into the input object. +CALLBACK is called with a plist of :success BOOL and :updated-at STR. This is +the generic mutation the field commands share." + (let ((query "mutation UpdateIssue($id: String!, $input: IssueUpdateInput!) { + issueUpdate(id: $id, input: $input) { + success + issue { id updatedAt } + } + }") + (variables `(("id" . ,issue-id) ("input" . ,input)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload)))) + (issue (cdr (assoc 'issue payload)))) + (funcall callback + (list :success success + :updated-at (cdr (assoc 'updatedAt issue)))))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defconst pearl--priority-choices + '(("None" . 0) ("Urgent" . 1) ("High" . 2) ("Medium" . 3) ("Low" . 4)) + "Linear priority names mapped to their numeric API values.") + +(defun pearl--set-priority-cookie (priority-num) + "Set the Org priority cookie on the heading at point from PRIORITY-NUM. +1-4 map to #A-#D; 0 (None) removes the cookie. The priority range is bound +locally so #D is accepted regardless of the user's `org-priority' settings." + (save-excursion + (org-back-to-heading t) + (let ((org-priority-highest ?A) + (org-priority-lowest ?D)) + (pcase priority-num + (1 (org-priority ?A)) + (2 (org-priority ?B)) + (3 (org-priority ?C)) + (4 (org-priority ?D)) + (_ (org-priority 'remove)))))) + +;;;###autoload +(defun pearl-set-priority (priority-name) + "Set the priority of the Linear issue at point to PRIORITY-NAME. +Interactively, completes over None/Urgent/High/Medium/Low. Pushes the numeric +priority to Linear and rewrites the heading cookie on success. Works from +anywhere inside an issue subtree." + (interactive + (list (completing-read "Priority: " pearl--priority-choices nil t))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (priority-num (cdr (assoc priority-name pearl--priority-choices))) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless priority-num + (user-error "Unknown priority: %s" priority-name)) + (pearl--update-issue-async + issue-id `(("priority" . ,priority-num)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (pearl--set-priority-cookie priority-num)) + (message "Set %s priority to %s" issue-id priority-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set priority for %s" issue-id))))))) + +(defun pearl--set-heading-state (state-name state-id) + "Update the heading at point to STATE-NAME / STATE-ID. +Rewrites the TODO keyword (mapped from STATE-NAME) and the LINEAR-STATE-NAME / +LINEAR-STATE-ID drawer properties. The Linear org-todo sync hook is inhibited +during the keyword change so updating the keyword here does not trigger a +second push back to Linear." + (save-excursion + (org-back-to-heading t) + (org-entry-put nil "LINEAR-STATE-NAME" state-name) + (org-entry-put nil "LINEAR-STATE-ID" state-id) + (let ((org-after-todo-state-change-hook nil)) + (org-todo (pearl--map-linear-state-to-org state-name))))) + +;;;###autoload +(defun pearl-set-state (state-name) + "Set the workflow state of the Linear issue at point to STATE-NAME. +Interactively, completes over the issue team's workflow states. Pushes the +resolved state id to Linear and updates the heading keyword and drawer on +success. Works from anywhere inside an issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read + "State: " + (mapcar (lambda (s) (cdr (assoc 'name s))) + (and team-id (pearl--team-states team-id))) + nil t)))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (states (and team-id (pearl--team-states team-id))) + (state (seq-find (lambda (s) (string= (cdr (assoc 'name s)) state-name)) + states)) + (state-id (and state (cdr (assoc 'id state))))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless state-id + (user-error "No workflow state named %s in this team" state-name)) + (pearl--update-issue-async + issue-id `(("stateId" . ,state-id)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (pearl--set-heading-state state-name state-id)) + (message "Set %s state to %s" issue-id state-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set state for %s" issue-id))))))) + +(defun pearl--team-collection-names (kind team-id) + "Return the display labels of the KIND collection for TEAM-ID, for completion." + (mapcar (lambda (n) (pearl--node-label kind n)) + (and team-id (pearl--team-collection kind team-id)))) + +;;;###autoload +(defun pearl-set-assignee (assignee-name) + "Set the assignee of the Linear issue at point to ASSIGNEE-NAME. +Interactively, completes over the issue team's members. Resolves the name to +a user id, pushes it, and updates the assignee drawer on success. Works from +anywhere inside an issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read "Assignee: " + (pearl--team-collection-names 'members team-id) + nil t)))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (assignee-id (and team-id + (pearl--resolve-team-id 'members assignee-name team-id)))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (unless assignee-id + (user-error "No team member matching %s" assignee-name)) + (pearl--update-issue-async + issue-id `(("assigneeId" . ,assignee-id)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) + (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id)) + (message "Set %s assignee to %s" issue-id assignee-name) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set assignee for %s" issue-id))))))) + +;;;###autoload +(defun pearl-set-labels (label-names) + "Set the labels of the Linear issue at point to LABEL-NAMES. +Interactively, completes (multiple) over the issue team's labels; an empty +selection clears the labels. Resolves each name to a label id, pushes the id +list, and updates the labels drawer on success. Works from anywhere inside an +issue subtree." + (interactive + (let ((team-id (save-excursion + (when (ignore-errors (org-back-to-heading t) t) + (org-entry-get nil "LINEAR-TEAM-ID"))))) + (list (completing-read-multiple + "Labels (comma-separated, empty to clear): " + (pearl--team-collection-names 'labels team-id))))) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear issue heading")) + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (team-id (org-entry-get nil "LINEAR-TEAM-ID")) + (marker (point-marker)) + (label-ids (mapcar + (lambda (name) + (or (and team-id + (pearl--resolve-team-id 'labels name team-id)) + (user-error "No label matching %s" name))) + label-names))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (pearl--update-issue-async + issue-id `(("labelIds" . ,label-ids)) + (lambda (result) + (if (plist-get result :success) + (progn + (save-excursion + (goto-char marker) + (org-entry-put nil "LINEAR-LABELS" + (format "[%s]" (mapconcat #'identity label-names ", ")))) + (message "Set %s labels to %s" issue-id + (if label-names (mapconcat #'identity label-names ", ") "none")) + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to set labels for %s" issue-id))))))) + +;;; User-facing Commands (Async) + +(defun pearl--source-name (source) + "Return the display name of a SOURCE descriptor, or a default." + (or (plist-get source :name) "Linear issues")) + +(defun pearl--summarize-filter (filter) + "Return a short human-readable summary of a FILTER authoring plist. +An empty FILTER summarizes as \"all issues\"." + (if (null filter) + "all issues" + (let (parts) + (cl-loop for (key val) on filter by #'cddr do + (push (pcase key + (:assignee (format "assignee: %s" + (if (eq val :me) "me" val))) + (:open (if val "open" "any state")) + (:labels (format "labels: %s" + (mapconcat #'identity + (if (listp val) val (list val)) + ", "))) + (_ (format "%s: %s" (substring (symbol-name key) 1) val))) + parts)) + (mapconcat #'identity (nreverse parts) ", ")))) + +(defun pearl--read-active-source () + "Read the active source descriptor from the current buffer's header, or nil. +Parses the `#+LINEAR-SOURCE:' keyword that `pearl--build-org-content' +writes." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-SOURCE: \\(.*\\)$" nil t) + (ignore-errors (car (read-from-string (match-string 1))))))) + +(defun pearl--build-org-content (issues &optional source truncated) + "Build the Org content string for the linear org file from ISSUES. +SOURCE is the active-source descriptor recorded in the header so a later +`pearl-refresh-current-view' can re-run it; TRUNCATED marks that the +page cap was hit. Pure function, no side effects." + (let* ((src (or source '(:type filter :name "Linear issues" :filter nil))) + (name (pearl--source-name src)) + (filter (plist-get src :filter))) + (with-temp-buffer + (insert (format "#+title: Linear — %s\n" name)) + (insert "#+STARTUP: show3levels\n") + (insert (format "#+TODO: %s\n" + (if (bound-and-true-p org-todo-keywords) + (let ((seq (car org-todo-keywords))) + (mapconcat #'identity (cdr seq) " ")) + "TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE"))) + ;; Source-tracking metadata: the serialized source drives refresh; the + ;; rest is human-readable provenance. + (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string src))) + (insert (format "#+LINEAR-RUN-AT: %s\n" (format-time-string "%Y-%m-%d %H:%M"))) + (insert (format "#+LINEAR-FILTER: %s\n" (pearl--summarize-filter filter))) + (insert (format "#+LINEAR-COUNT: %d\n" (length issues))) + (insert (format "#+LINEAR-TRUNCATED: %s\n" (if truncated "yes" "no"))) + ;; Affordance preamble (org comments -- not rendered content). + (insert "#\n") + (insert "# Body = the issue description; edit it, then M-x pearl-sync-current-issue to push.\n") + (insert "# Comments subtree = the thread; add with M-x pearl-add-comment.\n") + (insert "# Drawer fields change via M-x pearl-set-priority / -state / -assignee / -labels.\n") + (insert "# Refresh with M-x pearl-refresh-current-view (whole file) or -current-issue (one).\n") + (insert "\n") + + ;; Single top-level parent so the issues are sortable as a group + ;; (org-sort on this heading) instead of orphan headings, and so a + ;; show3levels fold has a level-1 root. Named after the view. + (insert (format "* %s\n" name)) + + (dolist (issue issues) + (insert (pearl--format-issue-as-org-entry issue))) + + (buffer-string)))) + +(defun pearl--update-org-from-issues (issues &optional source truncated) + "Update `pearl-org-file-path' with rendered ISSUES, buffer-aware. +SOURCE and TRUNCATED are threaded into the header (see +`pearl--build-org-content'). + +Behavior depends on whether the file is currently visited in a buffer: + +- No buffer visiting the file: write atomically to disk via `with-temp-file', + then visit it so there is a buffer to show. +- Buffer exists and is unmodified: replace its contents in place and save, + preserving point and avoiding a modtime mismatch warning. +- Buffer exists and has unsaved edits: do not overwrite. Log and emit a + message asking the user to save or revert before re-running. + +In every case the resulting buffer is surfaced (see `pearl--surface-buffer'), +so a fetch run from a menu or dashboard actually shows the issues instead of +just writing the file and leaving it off-screen." + (let* ((org-file-path pearl-org-file-path) + (new-content (pearl--build-org-content issues source truncated)) + (existing-buf (find-buffer-visiting org-file-path))) + (cond + ;; Branch A: no buffer visits the file -- atomic file write, then visit. + ((not existing-buf) + (pearl--log "Writing %d issues to %s (no buffer)" + (length issues) org-file-path) + (make-directory (file-name-directory org-file-path) t) + (with-temp-file org-file-path + (insert new-content)) + (message "Updated Linear issues in %s with %d active issues" + org-file-path (length issues)) + (let ((buf (find-file-noselect org-file-path))) + (with-current-buffer buf (pearl--restore-page-visibility)) + (pearl--surface-buffer buf))) + + ;; Branch B: buffer exists and is clean -- replace contents in place. + ((not (buffer-modified-p existing-buf)) + (pearl--log "Writing %d issues to %s (clean buffer)" + (length issues) org-file-path) + (with-current-buffer existing-buf + (let ((recorded-point (point)) + (inhibit-read-only t)) + (erase-buffer) + (insert new-content) + (save-buffer) + (goto-char (min recorded-point (point-max))) + (pearl--restore-page-visibility))) + (message "Updated Linear issues in %s with %d active issues" + org-file-path (length issues)) + (pearl--surface-buffer existing-buf)) + + ;; Branch C: buffer is dirty -- defer, do not overwrite, but show it. + (t + (pearl--log + "Linear refresh deferred: %s has unsaved changes (%d issues not written)" + org-file-path (length issues)) + (message + "Linear refresh deferred: %s has unsaved changes. Save or revert, then re-run M-x pearl-list-issues." + (file-name-nondirectory org-file-path)) + (pearl--surface-buffer existing-buf))))) + +(defcustom pearl-saved-queries nil + "Named local issue queries, run with `pearl-run-saved-query'. +Each entry is (NAME . SPEC) where SPEC is a plist with `:filter' (an authoring +filter plist), and optional `:sort' (`updated', `created', `priority', or +`title') and `:order' (`asc' or `desc', default `desc'). AND-only in v1; use a +Linear Custom View for OR logic." + :type '(alist :key-type string :value-type plist) + :group 'pearl) + +(defun pearl--sort-issues (issues sort order) + "Return ISSUES sorted by SORT (a symbol) in ORDER (`asc' or `desc'). +SORT is one of `updated', `priority', `title', or nil (no client-side sort). +ORDER defaults to descending. Sorting happens after fetch so a refresh always +produces the same heading order rather than reshuffling into noise." + (let ((key (pcase sort + ('updated (lambda (i) (or (plist-get i :updated-at) ""))) + ('priority (lambda (i) (or (plist-get i :priority) 99))) + ('title (lambda (i) (downcase (or (plist-get i :title) "")))) + (_ nil)))) + (if (null key) + issues + (let* ((lessp (if (eq sort 'priority) + (lambda (a b) (< (funcall key a) (funcall key b))) + (lambda (a b) (string< (funcall key a) (funcall key b))))) + (ascending (sort (copy-sequence issues) lessp))) + (if (eq order 'asc) ascending (nreverse ascending)))))) + +(defun pearl--sort->order-by (sort) + "Map a SORT symbol to the server `orderBy' value. +`created' uses `createdAt'; everything else (including `updated') uses +`updatedAt', the only other field Linear's public ordering supports." + (if (eq sort 'created) 'createdAt 'updatedAt)) + +;;;###autoload +(defun pearl-run-saved-query (name) + "Run the saved query NAME from `pearl-saved-queries'. +Interactively, completes over the configured query names. Compiles the stored +filter, fetches, sorts per the query's `:sort'/`:order', and renders into the +active file with the query recorded as the source." + (interactive + (list (completing-read "Saved query: " + (mapcar #'car pearl-saved-queries) nil t))) + (let ((entry (assoc name pearl-saved-queries))) + (unless entry + (user-error "No saved query named %s" name)) + (let* ((spec (cdr entry)) + (filter-plist (plist-get spec :filter)) + (sort (plist-get spec :sort)) + (order (plist-get spec :order)) + (source (list :type 'filter :name name :filter filter-plist + :sort sort :order order))) + (pearl--progress "Running saved query %s..." name) + (pearl--query-issues-async + (pearl--build-issue-filter filter-plist) + (lambda (result) (pearl--render-query-result result source)) + (pearl--sort->order-by sort))))) + +(defun pearl--assemble-filter (team open state project labels assignee) + "Assemble a filter authoring plist from the chosen dimensions. +The non-nil of TEAM, OPEN, STATE, PROJECT, LABELS, and ASSIGNEE appear (an +empty LABELS list is dropped), feeding `pearl--build-issue-filter' +with just what the user set." + (append + (when team (list :team team)) + (when assignee (list :assignee assignee)) + (when open (list :open t)) + (when state (list :state state)) + (when project (list :project project)) + (when labels (list :labels labels)))) + +(defun pearl--read-filter-interactively () + "Build a filter plist by completing over the chosen team's fetched dimensions. +Picks a team first (scoping the rest), then offers open-only, state, project, +labels, and assignee. Empty answers drop the dimension." + (let* ((teams (pearl--all-teams)) + (team-name (completing-read "Team (empty for any): " + (mapcar (lambda (tm) (cdr (assoc 'name tm))) teams) + nil nil)) + (team-id (and (not (string-empty-p team-name)) + (pearl--get-team-id-by-name team-name))) + (open (y-or-n-p "Open issues only? ")) + (state (and team-id + (let ((s (completing-read + "State (empty for any): " + (mapcar (lambda (st) (cdr (assoc 'name st))) + (pearl--team-states team-id)) + nil nil))) + (unless (string-empty-p s) s)))) + (project (and team-id + (let ((p (completing-read + "Project (empty for any): " + (pearl--team-collection-names 'projects team-id) + nil nil))) + (unless (string-empty-p p) p)))) + (labels (and team-id + (completing-read-multiple + "Labels (comma-separated, empty for none): " + (pearl--team-collection-names 'labels team-id)))) + (assignee (pcase (completing-read "Assignee (me / any): " '("me" "any") nil t "any") + ("me" :me) + (_ nil)))) + (pearl--assemble-filter + (and (not (string-empty-p team-name)) team-name) + open state project labels assignee))) + +(defun pearl--save-query (name filter-plist &optional sort order) + "Save FILTER-PLIST as the saved query NAME, replacing any entry of that NAME. +Persists `pearl-saved-queries' via Customize. SORT and ORDER are +stored when given." + (let ((entry (cons name (append (list :filter filter-plist) + (when sort (list :sort sort)) + (when order (list :order order)))))) + (setq pearl-saved-queries + (cons entry (assoc-delete-all name (copy-sequence pearl-saved-queries)))) + (ignore-errors + (customize-save-variable 'pearl-saved-queries pearl-saved-queries)))) + +;;;###autoload +(defun pearl-list-issues-filtered (filter-plist &optional save-name) + "Build an ad-hoc issue filter interactively, run it, and render it. +Interactively, completes each dimension from the chosen team's fetched +projects/states/labels (so a typo can't produce a confusing empty result), and +offers to save the filter as a local query. FILTER-PLIST is the authoring +filter; SAVE-NAME, when given, persists it via `pearl--save-query'." + (interactive + (list (pearl--read-filter-interactively) + (when (y-or-n-p "Save as a local query? ") + (read-string "Query name: ")))) + (when (and save-name (not (string-empty-p save-name))) + (pearl--save-query save-name filter-plist)) + (let ((source (list :type 'filter + :name (if (and save-name (not (string-empty-p save-name))) + save-name + "Ad-hoc filter") + :filter filter-plist))) + (pearl--progress "Running ad-hoc filter...") + (pearl--query-issues-async + (pearl--build-issue-filter filter-plist) + (lambda (result) (pearl--render-query-result result source))))) + +(defun pearl--render-query-result (result source) + "Render a query RESULT into the active file, tagged with SOURCE. +Normalizes the raw nodes, writes them via `pearl--update-org-from-issues' +with SOURCE and the truncation flag, and reports the outcome. The one render +boundary shared by list-issues, the ad-hoc filter, saved queries, views, and +refresh." + (pcase (pearl--query-result-status result) + ('ok + (let ((issues (pearl--sort-issues + (mapcar #'pearl--normalize-issue + (pearl--query-result-issues result)) + (plist-get source :sort) + (plist-get source :order))) + (truncated (pearl--query-result-truncated-p result))) + (condition-case err + (progn + (pearl--update-org-from-issues issues source truncated) + (message "Linear: wrote %d issue%s%s" + (length issues) + (if (= 1 (length issues)) "" "s") + (if truncated + (format " (stopped at the %d-page limit; raise `pearl-max-issue-pages')" + pearl-max-issue-pages) + ""))) + (error + (pearl--log "Error updating org file: %s" (error-message-string err)) + (message "Error updating the Linear org file: %s" + (error-message-string err)))))) + ('empty + (message "Linear: no issues match %s (file left unchanged)" + (pearl--source-name source))) + (_ + (message "Linear: %s" + (or (pearl--query-result-message result) + "could not fetch issues"))))) + +(defun pearl--subtree-dirty-p () + "Return non-nil when the issue subtree at point has unpushed body edits. +Compares the current Org body against `LINEAR-DESC-ORG-SHA256', the hash of the +body as it was rendered at the last fetch. This is an Org-to-Org comparison: it +does not round-trip through markdown, so a description whose markdown does not +survive md->org->md (headings, single-asterisk emphasis) is not mistaken for a +local edit. This is what lets a refresh protect a locally edited description +from being clobbered while still re-rendering the untouched ones. + +For subtrees rendered before this hash existed (no `LINEAR-DESC-ORG-SHA256'), +fall back to the older markdown-round-trip comparison; those migrate to the +Org-baseline hash the next time the subtree is re-rendered." + (let ((org-hash (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) + (if org-hash + (not (string= (secure-hash 'sha256 (pearl--issue-body-at-point)) org-hash)) + (let ((stored (org-entry-get nil "LINEAR-DESC-SHA256")) + (local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (not (string= (secure-hash 'sha256 local-md) (or stored ""))))))) + +(defun pearl--issue-subtree-markers () + "Return an alist of (LINEAR-ID . marker) for every issue heading in the buffer. +Each marker sits at the start of an issue heading -- one carrying its own +`LINEAR-ID' property. Comment headings carry `LINEAR-COMMENT-ID' instead and +have no `LINEAR-ID', so they are skipped. Markers (not raw positions) so they +track correctly across the in-place inserts and deletes the merge performs." + (let (markers) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*+ " nil t) + (save-excursion + (beginning-of-line) + (let ((id (org-entry-get nil "LINEAR-ID"))) + (when (and id (not (string-empty-p id))) + ;; Insertion type t matters here: replacing an earlier subtree + ;; deletes then reinserts at its start, collapsing a later + ;; marker onto that point. A type-nil marker would stay before + ;; the reinserted text and get stranded on the wrong heading; a + ;; type-t marker advances past it to its own heading. + (push (cons id (copy-marker (point) t)) markers)))))) + (nreverse markers))) + +(defun pearl--merge-issues-into-buffer (issues) + "Merge normalized ISSUES into the current buffer by `LINEAR-ID'. +Same-source refresh semantics: an existing issue still in ISSUES is re-rendered +in place; an issue new to ISSUES is appended after the last one; an issue no +longer in ISSUES is dropped. A subtree whose body has unpushed edits (see +`pearl--subtree-dirty-p') is never overwritten and never dropped -- it is kept +and counted, so a refresh can't lose un-synced work. Returns a plist of counts +\(:updated :added :dropped :skipped)." + (let ((existing (pearl--issue-subtree-markers)) + (fetched-ids (mapcar (lambda (i) (plist-get i :id)) issues)) + (updated 0) (added 0) (dropped 0) (skipped 0)) + ;; Existing issues still in the result: re-render in place, unless dirty. + (dolist (issue issues) + (let ((marker (cdr (assoc (plist-get issue :id) existing)))) + (when marker + (save-excursion + (goto-char marker) + (if (pearl--subtree-dirty-p) + (setq skipped (1+ skipped)) + (pearl--replace-issue-subtree-at-point issue) + (setq updated (1+ updated))))))) + ;; Existing issues absent from the result: drop them, but keep dirty ones. + (dolist (cell existing) + (unless (member (car cell) fetched-ids) + (save-excursion + (goto-char (cdr cell)) + (if (pearl--subtree-dirty-p) + (setq skipped (1+ skipped)) + (org-back-to-heading t) + (delete-region (point) (progn (org-end-of-subtree t t) (point))) + (setq dropped (1+ dropped)))))) + ;; Issues new to the result: append after the last one, in fetched order. + (dolist (issue issues) + (unless (assoc (plist-get issue :id) existing) + (save-excursion + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (pearl--format-issue-as-org-entry issue))) + (setq added (1+ added)))) + (list :updated updated :added added :dropped dropped :skipped skipped))) + +(defun pearl--update-source-header (issue-count truncated) + "Refresh the active file's run-at, count, and truncation header lines. +ISSUE-COUNT is the new issue total; TRUNCATED marks a page-cap hit. The +`#+LINEAR-SOURCE:' descriptor is left untouched -- only the human-readable +provenance advances on a refresh." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-RUN-AT: .*$" nil t) + (replace-match (format "#+LINEAR-RUN-AT: %s" + (format-time-string "%Y-%m-%d %H:%M")) + t t)) + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-COUNT: .*$" nil t) + (replace-match (format "#+LINEAR-COUNT: %d" issue-count) t t)) + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-TRUNCATED: .*$" nil t) + (replace-match (format "#+LINEAR-TRUNCATED: %s" (if truncated "yes" "no")) t t)))) + +(defun pearl--merge-query-result (result source) + "Merge a query RESULT into the current buffer by `LINEAR-ID', tagged with SOURCE. +The same-source refresh counterpart to `pearl--render-query-result': rather than +replacing the file, it updates issue subtrees in place, appends new matches, and +drops issues no longer present (protecting unpushed edits per subtree), then +refreshes the provenance header. An empty result leaves the buffer untouched +rather than dropping every issue, mirroring the non-destructive empty handling +of the replace path." + (pcase (pearl--query-result-status result) + ('ok + (let* ((issues (pearl--sort-issues + (mapcar #'pearl--normalize-issue + (pearl--query-result-issues result)) + (plist-get source :sort) + (plist-get source :order))) + (truncated (pearl--query-result-truncated-p result)) + (counts (pearl--merge-issues-into-buffer issues))) + (pearl--update-source-header (length issues) truncated) + (pearl-highlight-comments) + (pearl--restore-page-visibility) + (pearl--surface-buffer (current-buffer)) + (message "Refreshed %s: %d updated, %d added, %d dropped%s" + (pearl--source-name source) + (plist-get counts :updated) + (plist-get counts :added) + (plist-get counts :dropped) + (let ((s (plist-get counts :skipped))) + (if (> s 0) (format ", %d kept (unpushed edits)" s) ""))))) + ('empty + (message "Linear: %s now matches no issues (file left unchanged)" + (pearl--source-name source))) + (_ + (message "Linear: %s" + (or (pearl--query-result-message result) + "could not refresh issues"))))) + +;;;###autoload +(defun pearl-refresh-current-view () + "Re-run the active source recorded in the current file's header and merge it in. +Reads the `#+LINEAR-SOURCE:' descriptor, re-fetches it, and merges the result +into this buffer by `LINEAR-ID' (see `pearl--merge-query-result'): existing +issues update in place, new matches are appended, and issues no longer present +are dropped, while any subtree with unpushed edits is kept. This is the +same-source counterpart to the replace-on-switch behavior of the query and view +commands. Errors if no source is recorded." + (interactive) + (let ((source (pearl--read-active-source)) + (buffer (current-buffer))) + (unless source + (user-error "No Linear source recorded in this file; run a query or view first")) + (let ((merge (lambda (result) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (pearl--merge-query-result result source)))))) + (pcase (plist-get source :type) + ('filter + (pearl--progress "Refreshing %s..." (pearl--source-name source)) + (pearl--query-issues-async + (pearl--build-issue-filter (plist-get source :filter)) + merge)) + ('view + (pearl--progress "Refreshing %s..." (pearl--source-name source)) + (pearl--query-view-async (plist-get source :id) merge)) + (_ (user-error "Unknown Linear source type: %s" (plist-get source :type))))))) + +;;;###autoload +(defun pearl-run-view (view-name) + "Run a Linear Custom View by VIEW-NAME and render it into the active file. +Interactively, completes over the workspace's Custom Views. The view's own +filter runs server-side; the result replaces the active file (behind the +dirty-buffer guard) and records the view as the active source." + (interactive + (list (completing-read "Custom view: " + (mapcar (lambda (v) (cdr (assoc 'name v))) + (pearl--custom-views)) + nil t))) + (let* ((view (seq-find (lambda (v) (string= (cdr (assoc 'name v)) view-name)) + (pearl--custom-views))) + (view-id (and view (cdr (assoc 'id view))))) + (unless view-id + (user-error "No Custom View named %s" view-name)) + (let ((source (list :type 'view :name view-name :id view-id + :url (cdr (assoc 'url view))))) + (pearl--progress "Running view %s..." view-name) + (pearl--query-view-async + view-id + (lambda (result) (pearl--render-query-result result source)))))) + +;;;###autoload +(defun pearl-open-current-view-in-linear () + "Open the active view's source URL in the browser. +Reads the recorded source from the file header; errors when the source is not +a view or has no URL." + (interactive) + (let* ((source (pearl--read-active-source)) + (url (plist-get source :url))) + (unless (and url (not (string-empty-p url))) + (user-error "The active source has no view URL to open")) + (browse-url url))) + +;;;###autoload +(defun pearl-list-issues (&optional project-id) + "Fetch my open Linear issues into `pearl-org-file-path' and show them. +With PROJECT-ID, narrow to that project. \"Open\" means any workflow state +that is not completed, canceled, or duplicate. Runs asynchronously. + +Inclusion is server-side via the issue filter; the state mapping only drives +how each issue's state renders as a TODO keyword." + (interactive) + (pearl--log "Executing pearl-list-issues") + (pearl--progress "Fetching issues from Linear...") + (let* ((authoring `(:assignee :me :open t + ,@(when project-id (list :project project-id)))) + (source (list :type 'filter + :name (if project-id "My open issues in project" "My open issues") + :filter authoring)) + (filter (pearl--build-issue-filter authoring))) + (pearl--query-issues-async + filter + (lambda (result) (pearl--render-query-result result source))))) + +;;;###autoload +(defun pearl-list-issues-by-project () + "List Linear issues filtered by a selected project. +Uses async API for better performance." + (interactive) + (let* ((team (if pearl-default-team-id + (list (cons 'id pearl-default-team-id)) + (pearl-select-team))) + (team-id (cdr (assoc 'id team)))) + (if team-id + (let* ((project (pearl-select-project team-id)) + (project-id (and project (cdr (assoc 'id project))))) + (if project-id + (progn + (message "Fetching issues for project: %s" (cdr (assoc 'name project))) + (pearl-list-issues project-id)) + (message "No project selected"))) + (message "No team selected")))) + +;;;###autoload +(defun pearl-new-issue () + "Create a new Linear issue with additional attributes." + (interactive) + ;; Select team first (needed for states, members, etc.) + (let* ((team (if pearl-default-team-id + (list (cons 'id pearl-default-team-id)) + (pearl-select-team))) + (team-id (cdr (assoc 'id team)))) + + (if team-id + (let* ((title (read-string "Issue title: ")) + (description (read-string "Description: ")) + + ;; Get workflow states + (states (pearl-get-states team-id)) + (state-options (when states + (mapcar (lambda (state) + (cons (cdr (assoc 'name state)) + (cdr (assoc 'id state)))) + states))) + (selected-state (when state-options + (cdr (assoc (completing-read "State: " state-options nil t) + state-options)))) + + ;; Get priorities + (priority-options (pearl-get-priorities)) + (selected-priority (cdr (assoc (completing-read "Priority: " priority-options nil t) + priority-options))) + + ;; Get team members for assignee + (members (pearl-get-team-members team-id)) + (assignee-prompt (completing-read + "Assignee: " + (mapcar #'car members) + nil nil nil nil "")) + (selected-assignee (unless (string-empty-p assignee-prompt) + (cdr (assoc assignee-prompt members)))) + + ;; Estimate (points) + (estimate (read-string "Estimate (points, leave empty for none): ")) + (estimate-num (when (and estimate (not (string-empty-p estimate))) + (string-to-number estimate))) + + ;; Issue type (label) + (issue-types (pearl-get-issue-types team-id)) + (label-names (mapcar #'car issue-types)) + ;; Group labels by category (e.g., "Docs", "Feature", etc.) + (label-categories (let ((categories (make-hash-table :test 'equal))) + (dolist (label label-names) + (when-let* ((parts (split-string label " - " t)) + (category (car parts))) + (puthash category + (cons label (gethash category categories nil)) + categories))) + categories)) + (category-names (hash-table-keys label-categories)) + ;; First select a category, then a specific label + (selected-category (completing-read + "Label category: " + (append '("All") category-names) + nil nil nil nil "All")) + (filtered-labels (if (string= selected-category "All") + label-names + (gethash selected-category label-categories nil))) + (label-prompt (completing-read + (if (string= selected-category "All") + "Label (type for fuzzy search): " + (format "Label in %s category: " selected-category)) + filtered-labels + nil nil nil nil "")) + (matching-labels (when (not (string-empty-p label-prompt)) + (cl-remove-if-not + (lambda (label-name) + (string-match-p (regexp-quote label-prompt) label-name)) + filtered-labels))) + (selected-label-name (if (= (length matching-labels) 1) + (car matching-labels) + (when matching-labels + (completing-read "Select specific label: " matching-labels nil t)))) + (selected-type (when (and selected-label-name (not (string-empty-p selected-label-name))) + (cdr (assoc selected-label-name issue-types)))) + + ;; Get project + (selected-project (pearl-select-project team-id)) + (selected-project-id (and selected-project (cdr (assoc 'id selected-project)))) + + ;; Prepare mutation + (query "mutation CreateIssue($input: IssueCreateInput!) { + issueCreate(input: $input) { + success + issue { + id + identifier + title + } + } + }") + + ;; Build input variables + (input `(("title" . ,title) + ("description" . ,description) + ("teamId" . ,team-id) + ,@(when selected-state + `(("stateId" . ,selected-state))) + ,@(when selected-priority + `(("priority" . ,selected-priority))) + ,@(when selected-assignee + `(("assigneeId" . ,selected-assignee))) + ,@(when estimate-num + `(("estimate" . ,estimate-num))) + ,@(when selected-type + `(("labelIds" . [,selected-type]))) + ,@(when selected-project-id + `(("projectId" . ,selected-project-id))))) + + (response (pearl--graphql-request query `(("input" . ,input))))) + + (let ((issue (pearl--created-issue response))) + (if issue + (progn + (message "Created issue %s: %s" + (cdr (assoc 'identifier issue)) + (cdr (assoc 'title issue))) + issue) + (message "Failed to create issue")))) + + (message "No team selected")))) + +;;;###autoload +(defun pearl-test-connection () + "Test the connection to Linear API." + (interactive) + (pearl--log "Testing connection to Linear API") + (pearl--progress "Testing Linear API connection...") + + (let* ((query "query { viewer { id name } }")) + (pearl--graphql-request-async + query + nil + (lambda (response) + (if response + (let ((viewer (assoc 'viewer (assoc 'data response)))) + (message "Connected to Linear as: %s" (cdr (assoc 'name viewer)))) + (message "Failed to connect to Linear API"))) + (lambda (_error _response _data) + (message "Failed to connect to Linear API"))))) + +;;;###autoload +(defun pearl-toggle-debug () + "Toggle debug logging for Linear API requests." + (interactive) + (setq pearl-debug (not pearl-debug)) + (message "Linear debug mode %s" (if pearl-debug "enabled" "disabled"))) + +;;;###autoload +(defun pearl-check-setup () + "Check if Linear.el is properly set up." + (interactive) + (if pearl-api-key + (progn + (message "API key is set (length: %d). Testing connection..." (length pearl-api-key)) + (pearl-test-connection)) + (message "Linear API key is not set. Use M-x customize-variable RET pearl-api-key"))) + +;;;###autoload +(defun pearl-load-api-key-from-env () + "Try to load Linear API key from environment variable." + (interactive) + (let ((env-key (getenv "LINEAR_API_KEY"))) + (if env-key + (progn + (setq pearl-api-key env-key) + (message "Loaded Linear API key from LINEAR_API_KEY environment variable")) + (message "LINEAR_API_KEY environment variable not found or empty")))) + +;;; Org Mode Sync Hooks + +;;;###autoload +(defun pearl-enable-org-sync () + "Enable synchronization between org mode and Linear." + (interactive) + (add-hook 'after-save-hook #'pearl-org-hook-function nil t) + (add-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear nil t) + (pearl-highlight-comments) + (message "Linear-org synchronization enabled")) + +;;;###autoload +(defun pearl-disable-org-sync () + "Disable synchronization between org mode and Linear." + (interactive) + (remove-hook 'after-save-hook #'pearl-org-hook-function t) + (remove-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear t) + (message "Linear-org synchronization disabled")) + +;;; Comment Editing + +(defface pearl-editable-comment + '((t :inherit success)) + "Face for comment headings the current user can edit." + :group 'pearl) + +(defface pearl-readonly-comment + '((t :inherit shadow)) + "Face for comment headings the current user cannot edit." + :group 'pearl) + +(defun pearl--comment-editable-p (author-id viewer-id) + "Return non-nil when a comment by AUTHOR-ID is editable by VIEWER-ID. +Editable only when both ids are present and equal; a nil or empty AUTHOR-ID +\(bot or external comment) is never editable." + (and author-id viewer-id + (not (string-empty-p author-id)) + (string= author-id viewer-id))) + +(defun pearl--viewer-async (callback) + "Resolve the current Linear viewer and call CALLBACK with a plist (:id :name). +Caches the result in `pearl--cache-viewer'; calls CALLBACK with nil on a +transport or GraphQL failure." + (if pearl--cache-viewer + (funcall callback pearl--cache-viewer) + (pearl--graphql-request-async + "query { viewer { id name } }" nil + (lambda (data) + (let ((v (cdr (assoc 'viewer (assoc 'data data))))) + (funcall callback + (when v + (setq pearl--cache-viewer + (list :id (cdr (assoc 'id v)) + :name (cdr (assoc 'name v)))))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--fetch-comment-body-async (comment-id callback) + "Fetch COMMENT-ID's current body from Linear. +CALLBACK is called with the markdown body string on success, or nil on error." + (let ((query "query CommentBody($id: String!) { + comment(id: $id) { body } + }") + (variables `(("id" . ,comment-id)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let ((comment (cdr (assoc 'comment (assoc 'data data))))) + (funcall callback (when comment (or (cdr (assoc 'body comment)) ""))))) + (lambda (_error _response _data) (funcall callback nil))))) + +(defun pearl--update-comment-async (comment-id body callback) + "Push BODY as COMMENT-ID's text via commentUpdate. +CALLBACK is called with a plist (:success BOOL)." + (let ((query "mutation UpdateComment($id: String!, $body: String!) { + commentUpdate(id: $id, input: {body: $body}) { + success + comment { id body } + } + }") + (variables `(("id" . ,comment-id) ("body" . ,body)))) + (pearl--graphql-request-async + query variables + (lambda (data) + (let* ((payload (cdr (assoc 'commentUpdate (assoc 'data data)))) + (success (eq t (cdr (assoc 'success payload))))) + (funcall callback (list :success success)))) + (lambda (_error _response _data) (funcall callback '(:success nil)))))) + +(defun pearl--apply-comment-highlights (viewer-id) + "Color every comment heading in the buffer by editability for VIEWER-ID. +The viewer's own comments get `pearl-editable-comment'; all others get +`pearl-readonly-comment'. Idempotent: clears prior highlights first." + (save-excursion + (remove-overlays (point-min) (point-max) 'pearl-comment t) + (goto-char (point-min)) + (while (re-search-forward "^\\*+ " nil t) + (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID"))) + (when comment-id + (let* ((author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) + (face (if (pearl--comment-editable-p author-id viewer-id) + 'pearl-editable-comment + 'pearl-readonly-comment)) + (ov (make-overlay (line-beginning-position) (line-end-position)))) + (overlay-put ov 'pearl-comment t) + (overlay-put ov 'face face))))))) + +;;;###autoload +(defun pearl-highlight-comments () + "Color comment headings in the current buffer by who can edit them. +The viewer's own comments render green (editable); others render greyed. Runs +after a fetch/refresh and from `pearl-enable-org-sync', and is safe to +invoke by hand." + (interactive) + (let ((buffer (current-buffer))) + ;; Best-effort: highlighting is a display nicety and must never abort the + ;; operation that triggered it (e.g. a missing API key errors in the + ;; request layer), so a failure to resolve the viewer just skips coloring. + (ignore-errors + (pearl--viewer-async + (lambda (viewer) + (when (and viewer (buffer-live-p buffer)) + (with-current-buffer buffer + (pearl--apply-comment-highlights (plist-get viewer :id))))))))) + +;;;###autoload +(defun pearl-edit-current-comment () + "Push an edit to the comment at point on Linear. +Works from anywhere inside a comment's subtree. Only the current user's own +comments are editable: a comment authored by anyone else (or by a bot or +integration) is refused without a network call. The push is gated like the +description sync -- unchanged since fetch sends nothing, a local edit against +an unchanged remote pushes, and a both-sides-changed case is refused and +reported (refresh to reconcile)." + (interactive) + (save-excursion + (unless (ignore-errors (org-back-to-heading t) t) + (user-error "Not on a Linear comment")) + (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) + (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) + (stored (org-entry-get nil "LINEAR-COMMENT-SHA256")) + (marker (point-marker))) + (unless comment-id + (user-error "Not on a Linear comment")) + ;; `pearl--issue-body-at-point' reads the text after the drawer and before + ;; the first child heading -- a comment subtree has that same shape, so the + ;; description path's body reader serves the comment body unchanged. + (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) + (if (string= (secure-hash 'sha256 local-md) (or stored "")) + (message "No comment changes to sync") + (pearl--viewer-async + (lambda (viewer) + (cond + ((null viewer) + (message "Could not determine your Linear identity; not editing")) + ((not (pearl--comment-editable-p author-id (plist-get viewer :id))) + (message "You can only edit your own comments")) + (t + (pearl--progress "Checking Linear for remote changes...") + (pearl--fetch-comment-body-async + comment-id + (lambda (remote-md) + (if (null remote-md) + (message "Could not fetch the comment from Linear; not syncing") + (pcase (pearl--sync-decision local-md stored remote-md) + (:noop (message "Comment already matches Linear")) + (:conflict + (pearl--resolve-conflict + "comment" + local-md remote-md marker "LINEAR-COMMENT-SHA256" + (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md)))) + (lambda (md cb) + (pearl--update-comment-async + comment-id md + (lambda (r) (funcall cb (plist-get r :success))))))) + (:push + (pearl--update-comment-async + comment-id local-md + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker "LINEAR-COMMENT-SHA256" + (secure-hash 'sha256 local-md)) + (message "Synced comment to Linear") + (pearl--surface-buffer (marker-buffer marker))) + (message "Failed to sync comment")))))))))))))))))) + +;;; Transient Menu + +;;;###autoload (autoload 'pearl-menu "pearl" nil t) +(transient-define-prefix pearl-menu () + "Dispatch menu for pearl commands." + ["Linear" + ["Fetch" + ("l" "My open issues" pearl-list-issues) + ("p" "By project" pearl-list-issues-by-project) + ("f" "Build a filter" pearl-list-issues-filtered) + ("v" "Custom view" pearl-run-view) + ("Q" "Saved query" pearl-run-saved-query)] + ["View" + ("g" "Refresh view" pearl-refresh-current-view) + ("r" "Refresh issue" pearl-refresh-current-issue) + ("b" "Open view in Linear" pearl-open-current-view-in-linear)] + ["Issue at point" + ("e" "Edit desc -> push" pearl-sync-current-issue) + ("t" "Edit title -> push" pearl-sync-current-issue-title) + ("s" "Set state" pearl-set-state) + ("a" "Set assignee" pearl-set-assignee) + ("P" "Set priority" pearl-set-priority) + ("L" "Set labels" pearl-set-labels) + ("c" "Add comment" pearl-add-comment) + ("M" "Edit comment" pearl-edit-current-comment) + ("k" "Delete issue" pearl-delete-current-issue) + ("o" "Open in browser" pearl-open-current-issue)] + ["Create & org-sync" + ("n" "New issue" pearl-new-issue) + ("E" "Enable org-sync" pearl-enable-org-sync) + ("X" "Disable org-sync" pearl-disable-org-sync) + ("u" "Push file -> Linear" pearl-sync-org-to-linear)] + ["Setup" + ("T" "Test connection" pearl-test-connection) + ("C" "Check setup" pearl-check-setup) + ("!" "Toggle debug" pearl-toggle-debug) + ("x" "Clear cache" pearl-clear-cache)]]) + +(provide 'pearl) +;;; pearl.el ends here
\ No newline at end of file diff --git a/tests/Makefile b/tests/Makefile new file mode 100644 index 0000000..a6b6812 --- /dev/null +++ b/tests/Makefile @@ -0,0 +1,295 @@ +# Makefile for pearl.el test suite +# Usage: +# make test - Run all tests (excluding :slow tagged) +# make test-all - Run every test, including :slow tagged +# make test-file FILE=mapping - Run tests in one file +# make test-one TEST=name - Run one specific test +# make test-unit - Run unit tests only +# make test-integration - Run integration tests only +# make clean - Remove byte-compiled files + +# Configuration +EASK ?= eask + +# eask treats the CWD as its workspace and reads .eask/ from there. All +# eask invocations must run from project root so the project's .eask/ +# is picked up. The (cd "tests/") --eval restores Emacs default-directory +# so test files' relative paths (../pearl.el, test-bootstrap.el) +# resolve correctly. +PROJECT_ROOT := $(abspath ..) +EMACS_BATCH = cd $(PROJECT_ROOT) && $(EASK) emacs --batch --eval '(cd "tests/")' + +# Include local overrides if present (per-machine knobs, not committed) +-include makefile-local + +# Test files +ALL_TESTS = $(filter-out test-bootstrap.el,$(wildcard test-*.el)) +UNIT_TESTS = $(filter-out test-integration-%.el,$(ALL_TESTS)) +INTEGRATION_TESTS = $(wildcard test-integration-*.el) + +# ERT selector that excludes tests tagged :slow. Applied to default +# test runs so a slow integration suite doesn't dominate the fast +# feedback path. test-all runs everything; test-one and test-name +# honor the user-supplied pattern verbatim. +ERT_FAST_SELECTOR = (ert-run-tests-batch-and-exit '(not (tag :slow))) + +# Colors for output (if terminal supports it) +RED = \033[0;31m +GREEN = \033[0;32m +YELLOW = \033[1;33m +NC = \033[0m + +.PHONY: all test test-all test-file test-one test-name test-unit test-integration validate lint clean help check-deps count list + +all: test + +# Verify eask + installed deps are available +check-deps: + @if ! command -v $(EASK) >/dev/null 2>&1; then \ + printf "$(RED)Error: eask not found on PATH$(NC)\n"; \ + echo "Install: npm install -g @emacs-eask/cli"; \ + echo " or: https://emacs-eask.github.io/Getting-Started/Install-Eask/"; \ + exit 1; \ + fi + @if [ ! -d $(PROJECT_ROOT)/.eask ]; then \ + printf "$(YELLOW)Warning: .eask not found — run 'make setup' from project root$(NC)\n"; \ + exit 1; \ + fi + @$(EMACS_BATCH) -l check-deps.el >$(PROJECT_ROOT)/tests/check-deps-output.log 2>&1 || { \ + printf "$(RED)Error: required Emacs Lisp test dependencies are missing$(NC)\n"; \ + cat $(PROJECT_ROOT)/tests/check-deps-output.log; \ + exit 1; \ + } + @printf "$(GREEN)✓ eask available, required Emacs Lisp deps loadable$(NC)\n" + +# Run all tests (excluding :slow) +test: check-deps + @printf "$(YELLOW)Running all tests ($(words $(ALL_TESTS)) files, excluding :slow)...$(NC)\n" + @$(MAKE) --no-print-directory test-unit + @$(MAKE) --no-print-directory test-integration + @printf "$(GREEN)[✓] All tests complete$(NC)\n" + +# Run every test, including :slow tagged +test-all: check-deps + @printf "$(YELLOW)Running all tests including :slow ($(words $(ALL_TESTS)) files)...$(NC)\n" + @failed=0; \ + for testfile in $(ALL_TESTS); do \ + echo " Testing $$testfile..."; \ + $(EMACS_BATCH) -l ert -l "$$testfile" \ + --eval '(ert-run-tests-batch-and-exit t)' || failed=$$((failed + 1)); \ + done; \ + if [ $$failed -eq 0 ]; then \ + printf "$(GREEN)[✓] All tests passed$(NC)\n"; \ + else \ + printf "$(RED)[✗] $$failed test file(s) failed$(NC)\n"; \ + exit 1; \ + fi + +# Run tests in one file +test-file: check-deps +ifndef FILE + @printf "$(RED)Error: FILE not specified$(NC)\n" + @echo "Usage: make test-file FILE=mapping" + @echo " make test-file FILE=test-pearl-mapping.el" + @exit 1 +endif + @TESTFILE=$$(find . -maxdepth 1 -name "*$(FILE)*.el" -type f | head -1 | sed 's|^\./||'); \ + if [ -z "$$TESTFILE" ]; then \ + printf "$(RED)Error: No test file matching '$(FILE)' found$(NC)\n"; \ + exit 1; \ + fi; \ + printf "$(YELLOW)Running tests in $$TESTFILE...$(NC)\n"; \ + $(EMACS_BATCH) -l ert -l "$$TESTFILE" \ + --eval "$(ERT_FAST_SELECTOR)" 2>&1 | tee $(PROJECT_ROOT)/tests/test-file-output.log; \ + if [ $$? -eq 0 ]; then \ + printf "$(GREEN)✓ All tests in $$TESTFILE passed!$(NC)\n"; \ + else \ + printf "$(RED)✗ Some tests failed.$(NC)\n"; \ + exit 1; \ + fi + +# Run one specific test (fuzzy match by name) +test-one: check-deps +ifndef TEST + @printf "$(RED)Error: TEST not specified$(NC)\n" + @echo "Usage: make test-one TEST=priority" + @echo " make test-one TEST=test-pearl-map-priority-urgent" + @exit 1 +endif + @printf "$(YELLOW)Searching for test matching '$(TEST)'...$(NC)\n" + @TESTFILE=$$(grep -l "ert-deftest.*$(TEST)" test-*.el 2>/dev/null | head -1); \ + if [ -z "$$TESTFILE" ]; then \ + printf "$(RED)Error: No test matching '$(TEST)' found$(NC)\n"; \ + exit 1; \ + fi; \ + TESTNAME=$$(grep "ert-deftest.*$(TEST)" "$$TESTFILE" | sed 's/^(ert-deftest \([^ ]*\).*/\1/' | head -1); \ + printf "$(YELLOW)Running test '$$TESTNAME' in $$TESTFILE...$(NC)\n"; \ + $(EMACS_BATCH) -l ert -l "$$TESTFILE" \ + --eval "(ert-run-tests-batch-and-exit \"$$TESTNAME\")" 2>&1; \ + if [ $$? -eq 0 ]; then \ + printf "$(GREEN)✓ Test $$TESTNAME passed!$(NC)\n"; \ + else \ + printf "$(RED)✗ Test $$TESTNAME failed.$(NC)\n"; \ + exit 1; \ + fi + +# Run only unit tests (excluding :slow) +test-unit: check-deps + @printf "$(YELLOW)Running unit tests ($(words $(UNIT_TESTS)) files, excluding :slow)...$(NC)\n" + @failed=0; \ + for testfile in $(UNIT_TESTS); do \ + echo " Testing $$testfile..."; \ + $(EMACS_BATCH) -l ert -l "$$testfile" \ + --eval "$(ERT_FAST_SELECTOR)" || failed=$$((failed + 1)); \ + done; \ + if [ $$failed -eq 0 ]; then \ + printf "$(GREEN)[✓] All unit tests passed$(NC)\n"; \ + else \ + printf "$(RED)[✗] $$failed unit test file(s) failed$(NC)\n"; \ + exit 1; \ + fi + +# Run only integration tests (excluding :slow) +test-integration: check-deps + @printf "$(YELLOW)Running integration tests ($(words $(INTEGRATION_TESTS)) files, excluding :slow)...$(NC)\n" + @if [ -z "$(INTEGRATION_TESTS)" ]; then \ + printf "$(YELLOW) (no integration test files yet)$(NC)\n"; \ + fi + @failed=0; \ + for testfile in $(INTEGRATION_TESTS); do \ + echo " Testing $$testfile..."; \ + $(EMACS_BATCH) -l ert -l "$$testfile" \ + --eval "$(ERT_FAST_SELECTOR)" || failed=$$((failed + 1)); \ + done; \ + if [ $$failed -eq 0 ]; then \ + printf "$(GREEN)[✓] All integration tests passed$(NC)\n"; \ + else \ + printf "$(RED)[✗] $$failed integration test file(s) failed$(NC)\n"; \ + exit 1; \ + fi + +# Run tests matching a name pattern (ERT selector) +test-name: check-deps +ifndef TEST + @printf "$(RED)Error: TEST not specified$(NC)\n" + @echo "Usage: make test-name TEST=test-pearl-map" + @echo " make test-name TEST='test-pearl-map-*'" + @exit 1 +endif + @printf "$(YELLOW)Running tests matching pattern: $(TEST)...$(NC)\n" + @$(EMACS_BATCH) -l ert \ + --eval "(dolist (f (directory-files \".\" t \"^test-.*\\\\.el$$\")) (load f))" \ + --eval '(ert-run-tests-batch-and-exit "$(TEST)")' + +# Count tests +count: + @echo "Test file inventory:" + @for f in $(ALL_TESTS); do \ + count=$$(grep -c "^(ert-deftest" "$$f" 2>/dev/null || echo 0); \ + printf "%3d tests - %s\n" "$$count" "$$f"; \ + done | sort -rn + @total=$$(find . -name "test-*.el" -exec grep -c "^(ert-deftest" {} \; | awk '{sum+=$$1} END {print sum}'); \ + printf "$(GREEN)Total: $$total tests across $(words $(ALL_TESTS)) files$(NC)\n" + +# List all available tests +list: + @echo "Available tests:" + @grep -h "^(ert-deftest" test-*.el | sed 's/^(ert-deftest \([^ ]*\).*/ \1/' | sort + +# Validate Emacs Lisp syntax (parens balance — no deps needed) +validate: + @printf "$(YELLOW)Validating Emacs Lisp syntax...$(NC)\n" + @failed=0; \ + total=0; \ + for file in ../pearl.el test-*.el; do \ + if [ -f "$$file" ] && [ ! -d "$$file" ]; then \ + total=$$((total + 1)); \ + output=$$(emacs --batch -Q --eval "(progn \ + (setq byte-compile-error-on-warn nil) \ + (find-file \"$$file\") \ + (condition-case err \ + (progn \ + (check-parens) \ + (message \"✓ $$file - parentheses balanced\")) \ + (error \ + (message \"✗ $$file: %s\" (error-message-string err)) \ + (kill-emacs 1))))" 2>&1 | grep -E '(✓|✗)'); \ + if [ $$? -eq 0 ]; then \ + printf "$(GREEN)$$output$(NC)\n"; \ + else \ + printf "$(RED)$$output$(NC)\n"; \ + failed=$$((failed + 1)); \ + fi; \ + fi; \ + done; \ + if [ $$failed -eq 0 ]; then \ + printf "$(GREEN)✓ All $$total files validated successfully$(NC)\n"; \ + else \ + printf "$(RED)✗ $$failed of $$total files failed validation$(NC)\n"; \ + exit 1; \ + fi + +# Comprehensive linting with elisp-lint (via eask-installed dev dep). +# Validators disabled and why: +# - checkdoc: covered by `eask lint checkdoc' as its own MELPA-prep step. +# - package-lint: covered by `eask lint package' as its own step. +# - indent-character: project uses spaces; validator defaults to requiring tabs. +# - fill-column: validator default (70) is stricter than this project wants. +# - indent: false positives on dash threading macros (`->', `->>'). +lint: check-deps + @printf "$(YELLOW)Running elisp-lint...$(NC)\n" + @$(EMACS_BATCH) \ + -l $(PROJECT_ROOT)/pearl.el \ + --eval "(require 'elisp-lint)" \ + -f elisp-lint-files-batch \ + --no-checkdoc \ + --no-package-lint \ + --no-indent-character \ + --no-fill-column \ + --no-indent \ + $(PROJECT_ROOT)/pearl.el 2>&1; \ + if [ $$? -eq 0 ]; then \ + printf "$(GREEN)✓ Linting completed successfully$(NC)\n"; \ + else \ + printf "$(RED)✗ Linting found issues (see above)$(NC)\n"; \ + exit 1; \ + fi + +# Clean byte-compiled files +clean: + @printf "$(YELLOW)Cleaning byte-compiled files...$(NC)\n" + @rm -f *.elc ../*.elc + @rm -f check-deps-output.log test-output.log test-file-output.log test-unit-output.log test-integration-output.log + @printf "$(GREEN)✓ Cleaned$(NC)\n" + +# Show help +help: + @echo "pearl Test Suite Makefile" + @echo "" + @echo "Usage:" + @echo " make test - Run all tests, excluding :slow" + @echo " make test-all - Run all tests including :slow" + @echo " make test-unit - Run unit tests only (excluding :slow)" + @echo " make test-integration - Run integration tests only (excluding :slow)" + @echo " make test-file FILE=mapping - Run tests in one file (fuzzy match)" + @echo " make test-one TEST=priority - Run one specific test (fuzzy match)" + @echo " make test-name TEST=pattern - Run tests matching ERT name pattern" + @echo " make validate - Validate Emacs Lisp syntax (parens balance)" + @echo " make lint - Comprehensive linting with elisp-lint" + @echo " make count - Count tests per file" + @echo " make list - List all test names" + @echo " make clean - Remove byte-compiled files and logs" + @echo " make check-deps - Verify eask + loadable Emacs Lisp deps" + @echo " make help - Show this help message" + @echo "" + @echo "Project-root targets (run from project root):" + @echo " make setup - Install all deps via eask" + @echo " make compile - Byte-compile pearl.el" + @echo " make coverage - Generate simplecov JSON via undercover" + @echo "" + @echo "Tagging tests as :slow:" + @echo " (ert-deftest test-foo () :tags '(:slow) ...) — excluded by default" + @echo " Run with 'make test-all' to include them." + @echo "" + @echo "Environment variables:" + @echo " EASK - eask executable (default: eask)" diff --git a/tests/check-deps.el b/tests/check-deps.el new file mode 100644 index 0000000..12b5f60 --- /dev/null +++ b/tests/check-deps.el @@ -0,0 +1,38 @@ +;;; check-deps.el --- Verify test dependencies are loadable -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Loaded by tests/Makefile's check-deps target after eask has prepared the +;; test environment. Keep dependency discovery inside Emacs so package.el, +;; package-vc, Eask, Nix, and pre-populated load-path setups all work the same +;; way: a dependency is available if Emacs can require it. + +;;; Code: + +(when noninteractive + (package-initialize)) + +(defconst pearl-check-deps-required-features + '(request json dash s org) + "Features required by the pearl test suite.") + +(defun pearl-check-deps--missing-features () + "Return required test features that cannot be loaded." + (let (missing) + (dolist (feature pearl-check-deps-required-features (nreverse missing)) + (unless (require feature nil t) + (push feature missing))))) + +(let ((missing (pearl-check-deps--missing-features))) + (if missing + (progn + (message "Missing Emacs Lisp test dependencies: %s" + (mapconcat #'symbol-name missing ", ")) + (message "Run `make setup' from the project root, or make these features available on load-path.") + (kill-emacs 1)) + (message "Required Emacs Lisp dependencies are loadable: %s" + (mapconcat #'symbol-name pearl-check-deps-required-features ", ")))) + +;;; check-deps.el ends here diff --git a/tests/run-coverage-file.el b/tests/run-coverage-file.el new file mode 100644 index 0000000..9d5c3b3 --- /dev/null +++ b/tests/run-coverage-file.el @@ -0,0 +1,50 @@ +;;; run-coverage-file.el --- Undercover setup for per-file coverage runs -*- lexical-binding: t; -*- + +;;; Commentary: +;; Loaded by `make coverage' before each test file runs, BEFORE +;; pearl.el is loaded. Instrumenting must happen first so the +;; subsequent load picks up the instrumented source. +;; +;; Coverage data is merged across per-file invocations into a single +;; simplecov JSON at .coverage/simplecov.json (under the project root). + +;;; Code: + +(unless (require 'undercover nil t) + (message "") + (message "ERROR: undercover not installed.") + (message "Run 'make setup' to install development dependencies.") + (message "") + (kill-emacs 1)) + +;; Resolve project root from this file's location so undercover patterns +;; and the report-file path don't depend on default-directory at load time. +(defvar run-coverage--project-root + (file-name-directory + (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "Absolute path to the pearl project root.") + +;; Force coverage collection in non-CI environments. Must be set after +;; loading undercover because the library's top-level form +;; `(setq undercover-force-coverage (getenv "UNDERCOVER_FORCE"))' would +;; otherwise overwrite the value. +(setq undercover-force-coverage t) + +;; Local runs emit simplecov for whatever local tooling wants it. CI sets +;; CI=true (GitHub Actions does this automatically), so we emit a coveralls +;; JSON instead and leave it on disk for the upload action to pick up. +;; The `undercover' macro splices each configuration list into `(list ,@it)', +;; which evaluates the elements. Wildcard strings have to stay atoms — using +;; `(:files ...)' form lets us evaluate `expand-file-name' to an absolute path. +(undercover (:files (expand-file-name "pearl.el" run-coverage--project-root)) + (:report-format (if (getenv "CI") 'coveralls 'simplecov)) + (:report-file (expand-file-name + (if (getenv "CI") + ".coverage/coveralls.json" + ".coverage/simplecov.json") + run-coverage--project-root)) + (:merge-report t) + (:send-report nil)) + +;;; run-coverage-file.el ends here diff --git a/tests/test-bootstrap.el b/tests/test-bootstrap.el new file mode 100644 index 0000000..85b26dd --- /dev/null +++ b/tests/test-bootstrap.el @@ -0,0 +1,47 @@ +;;; test-bootstrap.el --- Common test initialization for pearl -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Shared initialization for all pearl test files. +;; Handles package setup, dependency loading, and loading the package source. +;; +;; Usage: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;;; Code: + +;; Initialize package system for batch mode +(when noninteractive + (package-initialize)) + +(require 'ert) + +;; Load dependencies required by pearl +(require 'request) +(require 'json) +(require 'dash) +(require 's) +(require 'org) +(require 'cl-lib) + +;; Load pearl from parent directory +(load (expand-file-name "../pearl.el") nil t) + +(provide 'test-bootstrap) +;;; test-bootstrap.el ends here diff --git a/tests/test-pearl-adhoc.el b/tests/test-pearl-adhoc.el new file mode 100644 index 0000000..97ac22e --- /dev/null +++ b/tests/test-pearl-adhoc.el @@ -0,0 +1,106 @@ +;;; test-pearl-adhoc.el --- Tests for the ad-hoc filtered command -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the ad-hoc filter command: the pure `--assemble-filter' that +;; turns chosen dimension values into a filter plist, `--save-query', and +;; `pearl-list-issues-filtered' running and optionally saving. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +;;; --assemble-filter + +(ert-deftest test-pearl-assemble-filter-only-set-keys () + "Only the dimensions that were chosen appear in the filter plist." + (let ((f (pearl--assemble-filter nil t nil nil nil nil))) + (should (eq t (plist-get f :open))) + (should-not (plist-member f :team)) + (should-not (plist-member f :labels)))) + +(ert-deftest test-pearl-assemble-filter-full () + "All chosen dimensions land in the plist." + (let ((f (pearl--assemble-filter "ENG" t "In Progress" "Foo" '("bug" "p1") :me))) + (should (string= "ENG" (plist-get f :team))) + (should (eq t (plist-get f :open))) + (should (string= "In Progress" (plist-get f :state))) + (should (string= "Foo" (plist-get f :project))) + (should (equal '("bug" "p1") (plist-get f :labels))) + (should (eq :me (plist-get f :assignee))))) + +(ert-deftest test-pearl-assemble-filter-empty-labels-omitted () + "An empty label list does not add a :labels key." + (let ((f (pearl--assemble-filter nil nil nil nil '() nil))) + (should-not (plist-member f :labels)))) + +;;; --save-query + +(ert-deftest test-pearl-save-query-adds-entry () + "Saving a query adds it to the saved-queries variable." + (let ((pearl-saved-queries nil)) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + (pearl--save-query "My filter" '(:open t :labels ("bug"))) + (let ((entry (assoc "My filter" pearl-saved-queries))) + (should entry) + (should (equal '(:open t :labels ("bug")) (plist-get (cdr entry) :filter))))))) + +(ert-deftest test-pearl-save-query-replaces-same-name () + "Saving under an existing name replaces that entry rather than duplicating." + (let ((pearl-saved-queries '(("Dup" :filter (:open t))))) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + (pearl--save-query "Dup" '(:priority 1)) + (should (= 1 (cl-count "Dup" pearl-saved-queries + :key #'car :test #'string=))) + (should (equal '(:priority 1) + (plist-get (cdr (assoc "Dup" pearl-saved-queries)) :filter)))))) + +;;; pearl-list-issues-filtered + +(ert-deftest test-pearl-list-issues-filtered-runs-with-source () + "Running an ad-hoc filter compiles it and renders with a filter source." + (let ((built nil) (rendered-source nil)) + (cl-letf (((symbol-function 'pearl--build-issue-filter) + (lambda (plist) (setq built plist) '((compiled . t)))) + ((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _ord) + (funcall cb (pearl--make-query-result 'ok :issues nil)))) + ((symbol-function 'pearl--render-query-result) + (lambda (_result source) (setq rendered-source source)))) + (pearl-list-issues-filtered '(:assignee :me :open t) nil) + (should (equal '(:assignee :me :open t) built)) + (should (eq 'filter (plist-get rendered-source :type))) + (should (equal '(:assignee :me :open t) (plist-get rendered-source :filter)))))) + +(ert-deftest test-pearl-list-issues-filtered-saves-when-named () + "Passing a save name persists the ad-hoc filter as a saved query." + (let ((pearl-saved-queries nil)) + (cl-letf (((symbol-function 'pearl--build-issue-filter) (lambda (_p) nil)) + ((symbol-function 'pearl--query-issues-async) + (lambda (_f cb &optional _o) + (funcall cb (pearl--make-query-result 'empty :issues nil)))) + ((symbol-function 'pearl--render-query-result) (lambda (&rest _) nil)) + ((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + (pearl-list-issues-filtered '(:open t) "Saved adhoc") + (should (assoc "Saved adhoc" pearl-saved-queries))))) + +(provide 'test-pearl-adhoc) +;;; test-pearl-adhoc.el ends here diff --git a/tests/test-pearl-api.el b/tests/test-pearl-api.el new file mode 100644 index 0000000..bf4f45e --- /dev/null +++ b/tests/test-pearl-api.el @@ -0,0 +1,90 @@ +;;; test-pearl-api.el --- Tests for pearl core API layer -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the GraphQL request layer with `request' stubbed at the HTTP +;; boundary: the async entry point routes to success/error correctly and +;; balances the active-request counter; the sync wrapper returns data or nil. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) + +(ert-deftest test-pearl-graphql-request-async-success-routes-to-success-fn () + "A successful response is passed to the success function." + (let ((got nil)) + (testutil-linear-with-response '((data (viewer (name . "Me")))) + (pearl--graphql-request-async + "query" nil + (lambda (data) (setq got data)) + (lambda (&rest _) (setq got 'error)))) + (should (equal '((data (viewer (name . "Me")))) got)))) + +(ert-deftest test-pearl-graphql-request-async-error-routes-to-error-fn () + "A transport error is passed to the error function." + (let ((got nil)) + (testutil-linear-with-error "boom" + (pearl--graphql-request-async + "query" nil + (lambda (_d) (setq got 'success)) + (lambda (err _r _d) (setq got err)))) + (should (equal "boom" got)))) + +(ert-deftest test-pearl-graphql-request-async-balances-active-counter-on-success () + "The active-request counter returns to its starting value after success." + (let ((pearl--active-requests 0)) + (testutil-linear-with-response '((data)) + (pearl--graphql-request-async "q" nil #'ignore #'ignore)) + (should (= 0 pearl--active-requests)))) + +(ert-deftest test-pearl-graphql-request-async-nil-response-does-not-error () + "A transport error with a nil response routes to error-fn without throwing. + +The error handler logs the response status code; that read must be guarded +so a nil response (some transport failures) doesn't crash inside the handler." + (let ((pearl-api-key "test-key") (got nil)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (funcall (plist-get args :error) + :error-thrown "boom" :response nil :data nil)))) + (pearl--graphql-request-async + "q" nil #'ignore (lambda (err _r _d) (setq got err)))) + (should (equal "boom" got)))) + +(ert-deftest test-pearl-graphql-request-async-balances-active-counter-on-error () + "The active-request counter returns to its starting value after an error." + (let ((pearl--active-requests 0)) + (testutil-linear-with-error "boom" + (pearl--graphql-request-async "q" nil #'ignore #'ignore)) + (should (= 0 pearl--active-requests)))) + +(ert-deftest test-pearl-graphql-request-sync-returns-data () + "The synchronous wrapper returns the parsed response." + (testutil-linear-with-response '((data (x . 1))) + (should (equal '((data (x . 1))) (pearl--graphql-request "q"))))) + +(ert-deftest test-pearl-graphql-request-sync-error-returns-nil () + "The synchronous wrapper returns nil on a transport error." + (testutil-linear-with-error "boom" + (should (null (pearl--graphql-request "q"))))) + +(provide 'test-pearl-api) +;;; test-pearl-api.el ends here diff --git a/tests/test-pearl-assignee-labels.el b/tests/test-pearl-assignee-labels.el new file mode 100644 index 0000000..c70f0ca --- /dev/null +++ b/tests/test-pearl-assignee-labels.el @@ -0,0 +1,114 @@ +;;; test-pearl-assignee-labels.el --- Tests for set-assignee / set-labels -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the two drawer-field commands that resolve names to ids: +;; `pearl-set-assignee' and `pearl-set-labels'. They push via +;; the generic `--update-issue-async' and update the LINEAR-ASSIGNEE / LABELS +;; drawer. The resolver and the mutation are stubbed. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT at point-min." + (declare (indent 1)) + `(with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body)) + +;;; set-assignee + +(ert-deftest test-pearl-set-assignee-pushes-id-and-updates-drawer () + "Setting an assignee resolves the name, pushes the id, and updates the drawer." + (let ((pushed nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-ASSIGNEE-ID: old\n:LINEAR-ASSIGNEE-NAME: Someone\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) + (lambda (_kind _name _team &optional _force) "u9")) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) + (pearl-set-assignee "Craig") + (should (string= "u9" (cdr (assoc "assigneeId" pushed)))) + (should (string= "Craig" (org-entry-get nil "LINEAR-ASSIGNEE-NAME"))) + (should (string= "u9" (org-entry-get nil "LINEAR-ASSIGNEE-ID"))))))) + +(ert-deftest test-pearl-set-assignee-unresolvable-errors () + "An unresolvable assignee name signals a user error and pushes nothing." + (let ((pushed nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) + (lambda (&rest _) nil)) + ((symbol-function 'pearl--update-issue-async) + (lambda (&rest _) (setq pushed t)))) + (should-error (pearl-set-assignee "Nobody") :type 'user-error) + (should-not pushed))))) + +(ert-deftest test-pearl-set-assignee-not-on-issue-errors () + "Setting an assignee outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-set-assignee "Craig") :type 'user-error))) + +;;; set-labels + +(ert-deftest test-pearl-set-labels-pushes-ids-and-updates-drawer () + "Setting labels resolves each name, pushes the id list, and updates the drawer." + (let ((pushed nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: []\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) + (lambda (_kind name _team &optional _force) + (pcase name ("bug" "l1") ("p1" "l2") (_ nil)))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) + (pearl-set-labels '("bug" "p1")) + (should (equal '("l1" "l2") (cdr (assoc "labelIds" pushed)))) + (should (string= "[bug, p1]" (org-entry-get nil "LINEAR-LABELS"))))))) + +(ert-deftest test-pearl-set-labels-clear-pushes-empty () + "Clearing labels (empty list) pushes an empty id list and empties the drawer." + (let ((pushed 'unset)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:END:\n" + (cl-letf (((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) + (pearl-set-labels '()) + (should (equal '() (cdr (assoc "labelIds" pushed)))) + (should (string= "[]" (org-entry-get nil "LINEAR-LABELS"))))))) + +(ert-deftest test-pearl-set-labels-unresolvable-errors () + "An unresolvable label name signals a user error and pushes nothing." + (let ((pushed nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) + (lambda (&rest _) nil)) + ((symbol-function 'pearl--update-issue-async) + (lambda (&rest _) (setq pushed t)))) + (should-error (pearl-set-labels '("ghost")) :type 'user-error) + (should-not pushed))))) + +(provide 'test-pearl-assignee-labels) +;;; test-pearl-assignee-labels.el ends here diff --git a/tests/test-pearl-commands.el b/tests/test-pearl-commands.el new file mode 100644 index 0000000..77f2d46 --- /dev/null +++ b/tests/test-pearl-commands.el @@ -0,0 +1,153 @@ +;;; test-pearl-commands.el --- Tests for pearl user commands -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the interactive commands. Their input sources (completing-read, +;; read-string) and the network/file boundaries are stubbed so the dispatch +;; and orchestration logic runs: the list-issues result handling, project +;; dispatch, the new-issue input-building, and the connection/setup checks. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +;;; pearl-list-issues + +(ert-deftest test-pearl-list-issues-ok-writes-all-issues () + "On an ok result, every server-returned issue is written (no client filter)." + (let ((written nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result + 'ok :issues '(((identifier . "A")) ((identifier . "B"))))))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (issues &optional _source _truncated) (setq written issues)))) + (pearl-list-issues) + (should (= 2 (length written)))))) + +(ert-deftest test-pearl-list-issues-empty-skips-write () + "An empty result messages the user and does not overwrite the file." + (let ((wrote nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result 'empty :issues nil)))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (&rest _) (setq wrote t)))) + (pearl-list-issues) + (should-not wrote)))) + +(ert-deftest test-pearl-list-issues-error-skips-write () + "A failed query messages and does not write." + (let ((wrote nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result + 'request-failed :message "boom")))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (&rest _) (setq wrote t)))) + (pearl-list-issues) + (should-not wrote)))) + +(ert-deftest test-pearl-list-issues-project-id-adds-project-filter () + "A project id is compiled into the issue filter passed to the fetch." + (let (captured-filter) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (filter _cb &optional _order) (setq captured-filter filter))) + ((symbol-function 'pearl--update-org-from-issues) #'ignore)) + (pearl-list-issues "proj-1") + (should (equal '(("id" ("eq" . "proj-1"))) (cdr (assoc "project" captured-filter))))))) + +;;; pearl-list-issues-by-project + +(ert-deftest test-pearl-list-issues-by-project-dispatches-with-project-id () + "Selecting a team and project forwards the project id to list-issues." + (let ((pid 'unset) + (pearl-default-team-id nil)) + (cl-letf (((symbol-function 'pearl-select-team) (lambda () '((id . "t1")))) + ((symbol-function 'pearl-select-project) + (lambda (_t) '((id . "p1") (name . "Platform")))) + ((symbol-function 'pearl-list-issues) (lambda (project-id) (setq pid project-id)))) + (pearl-list-issues-by-project) + (should (string-equal "p1" pid))))) + +(ert-deftest test-pearl-list-issues-by-project-no-team-stops () + "With no team selected, list-issues is not called." + (let ((called nil) + (pearl-default-team-id nil)) + (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil)) + ((symbol-function 'pearl-list-issues) (lambda (&rest _) (setq called t)))) + (pearl-list-issues-by-project) + (should-not called)))) + +;;; pearl-new-issue + +(ert-deftest test-pearl-new-issue-success-returns-issue () + "new-issue builds the input, sends it, and returns the created issue." + (let ((pearl-default-team-id "team-1")) + (cl-letf (((symbol-function 'read-string) + (lambda (prompt &rest _) (if (string-prefix-p "Issue title" prompt) "My Issue" ""))) + ((symbol-function 'completing-read) + (lambda (prompt &rest _) + (cond ((string-prefix-p "State" prompt) "Todo") + ((string-prefix-p "Priority" prompt) "Medium") + ((string-prefix-p "Label category" prompt) "All") + (t "")))) + ((symbol-function 'pearl-get-states) + (lambda (_t) '(((id . "s1") (name . "Todo"))))) + ((symbol-function 'pearl-get-team-members) (lambda (_t) '())) + ((symbol-function 'pearl-get-issue-types) (lambda (_t) '())) + ((symbol-function 'pearl-select-project) (lambda (_t) nil)) + ((symbol-function 'pearl--graphql-request) + (lambda (_q &optional _v) + '((data (issueCreate (success . t) + (issue (id . "i1") (identifier . "ENG-1") (title . "My Issue")))))))) + (should (string-equal "ENG-1" (cdr (assoc 'identifier (pearl-new-issue)))))))) + +(ert-deftest test-pearl-new-issue-no-team-stops () + "new-issue stops cleanly when no team is selected." + (let ((pearl-default-team-id nil)) + (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil))) + (should (progn (pearl-new-issue) t))))) + +;;; pearl-test-connection / check-setup + +(ert-deftest test-pearl-test-connection-success-runs () + "test-connection completes on a successful viewer response." + (testutil-linear-with-response '((data (viewer (id . "u") (name . "Me")))) + (should (progn (pearl-test-connection) t)))) + +(ert-deftest test-pearl-check-setup-with-key-tests-connection () + "check-setup runs the connection test when an API key is set." + (let ((pearl-api-key "k") (called nil)) + (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t)))) + (pearl-check-setup) + (should called)))) + +(ert-deftest test-pearl-check-setup-without-key-skips-test () + "check-setup does not run the connection test without an API key." + (let ((pearl-api-key nil) (called nil)) + (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t)))) + (pearl-check-setup) + (should-not called)))) + +(provide 'test-pearl-commands) +;;; test-pearl-commands.el ends here diff --git a/tests/test-pearl-comment-editing.el b/tests/test-pearl-comment-editing.el new file mode 100644 index 0000000..05a3a76 --- /dev/null +++ b/tests/test-pearl-comment-editing.el @@ -0,0 +1,240 @@ +;;; test-pearl-comment-editing.el --- Tests for editing comments -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for editing an existing comment (spec: docs/issue-comment-editing-spec.org). +;; Covers: the author-id retained at normalize time, the per-comment provenance +;; drawer, the editability predicate and highlight pass, the viewer/commentUpdate +;; network helpers (stubbed at the HTTP boundary), and the permission + conflict +;; gates of `pearl-edit-current-comment'. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT." + (declare (indent 1)) + `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; normalize-comment keeps the author id + +(ert-deftest test-pearl-normalize-comment-keeps-author-id () + "A user-authored comment retains the user id for the permission check." + (let ((c (pearl--normalize-comment + '((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z") + (user (id . "u-123") (name . "Craig")))))) + (should (string= "u-123" (plist-get c :author-id))) + (should (string= "Craig" (plist-get c :author))))) + +(ert-deftest test-pearl-normalize-comment-bot-has-no-author-id () + "A bot comment has no user, so author-id is nil (not editable)." + (let ((c (pearl--normalize-comment + '((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z") + (botActor (name . "Linear")))))) + (should (null (plist-get c :author-id))))) + +;;; format-comment writes the provenance drawer + +(ert-deftest test-pearl-format-comment-writes-drawer () + "A rendered comment carries id, author-id, and a body hash in a drawer." + (let ((out (pearl--format-comment + '(:id "c9" :author-id "u-123" :author "Craig" + :created-at "2026-05-24T10:00:00.000Z" :body "Looks good")))) + (should (string-match-p ":LINEAR-COMMENT-ID:[ \t]+c9" out)) + (should (string-match-p ":LINEAR-COMMENT-AUTHOR-ID:[ \t]+u-123" out)) + (should (string-match-p (format ":LINEAR-COMMENT-SHA256:[ \t]+%s" + (secure-hash 'sha256 "Looks good")) + out)))) + +(ert-deftest test-pearl-format-comment-bot-empty-author-id () + "A comment with no author id renders an empty author-id, not an error." + (let ((out (pearl--format-comment + '(:id "c1" :author "Linear" :created-at "2026-05-24T10:00:00.000Z" + :body "auto")))) + (should (string-match-p "^:LINEAR-COMMENT-AUTHOR-ID:[ \t]*$" out)))) + +;;; editability predicate + +(ert-deftest test-pearl-comment-editable-own () + "A comment whose author is the viewer is editable." + (should (pearl--comment-editable-p "u-1" "u-1"))) + +(ert-deftest test-pearl-comment-editable-other () + "A comment by another user is not editable." + (should-not (pearl--comment-editable-p "u-2" "u-1"))) + +(ert-deftest test-pearl-comment-editable-nil-author () + "A comment with no author id (bot/external) is not editable." + (should-not (pearl--comment-editable-p nil "u-1")) + (should-not (pearl--comment-editable-p "" "u-1"))) + +;;; viewer identity (cached) + +(ert-deftest test-pearl-viewer-async-parses-and-caches () + "The viewer query returns the id/name and caches it for the next call." + (let ((pearl--cache-viewer nil)) + (testutil-linear-with-response + '((data (viewer (id . "u-me") (name . "Craig")))) + (let (v) + (pearl--viewer-async (lambda (r) (setq v r))) + (should (string= "u-me" (plist-get v :id))) + (should (string= "u-me" (plist-get pearl--cache-viewer :id))))) + ;; second call uses the cache, no HTTP needed + (let ((v2 'untouched)) + (pearl--viewer-async (lambda (r) (setq v2 r))) + (should (string= "u-me" (plist-get v2 :id)))))) + +;;; commentUpdate write path + +(ert-deftest test-pearl-update-comment-success () + "A successful commentUpdate reports success." + (testutil-linear-with-response + '((data (commentUpdate (success . t) (comment (id . "c1") (body . "edited"))))) + (let (result) + (pearl--update-comment-async "c1" "edited" (lambda (r) (setq result r))) + (should (eq t (plist-get result :success)))))) + +(ert-deftest test-pearl-update-comment-soft-fail () + "A non-success commentUpdate reports failure rather than erroring." + (testutil-linear-with-response + '((data (commentUpdate (success . :json-false) (comment . nil)))) + (let (result) + (pearl--update-comment-async "c1" "x" (lambda (r) (setq result r))) + (should-not (plist-get result :success))))) + +;;; edit command — permission + conflict gates + +(defconst test-pearl--comment-buffer + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + "**** Comments\n" + "***** Craig — 2026-05-24T09:00:00.000Z\n" + ":PROPERTIES:\n" + ":LINEAR-COMMENT-ID: c1\n" + ":LINEAR-COMMENT-AUTHOR-ID: %s\n" + ":LINEAR-COMMENT-SHA256: %s\n" + ":END:\n" + "%s\n") + "Template: author-id, stored-sha, body.") + +(defun test-pearl--comment-doc (author-id stored-body current-body) + "Build a comment buffer: AUTHOR-ID, drawer hash of STORED-BODY, CURRENT-BODY shown." + (format test-pearl--comment-buffer + author-id (secure-hash 'sha256 stored-body) current-body)) + +(ert-deftest test-pearl-edit-comment-not-on-comment-errors () + "Running the edit command outside a comment subtree signals a user error." + (test-pearl--in-org "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + (should-error (pearl-edit-current-comment) :type 'user-error))) + +(ert-deftest test-pearl-edit-comment-refuses-others () + "Editing another user's comment refuses and never calls commentUpdate." + (test-pearl--in-org (test-pearl--comment-doc "u-other" "old" "new text") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil) (fetched nil)) + (cl-letf (((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t))) + ((symbol-function 'pearl--fetch-comment-body-async) + (lambda (&rest _) (setq fetched t)))) + (re-search-forward "new text") + (pearl-edit-current-comment) + (should-not updated) + (should-not fetched))))) + +(ert-deftest test-pearl-edit-comment-noop-when-unchanged () + "An unedited comment pushes nothing." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "same" "same") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil)) + (cl-letf (((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t)))) + (re-search-forward "same") + (pearl-edit-current-comment) + (should-not updated))))) + +(ert-deftest test-pearl-edit-comment-pushes-own-edit () + "Editing your own comment against an unchanged remote pushes and advances the hash." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (pushed-body nil)) + (cl-letf (((symbol-function 'pearl--fetch-comment-body-async) + ;; remote is unchanged since fetch (matches the stored hash) + (lambda (_id cb) (funcall cb "old body"))) + ((symbol-function 'pearl--update-comment-async) + (lambda (_id body cb) (setq pushed-body body) + (funcall cb '(:success t))))) + (re-search-forward "new body") + (pearl-edit-current-comment) + (should (string= "new body" pushed-body)) + ;; the stored hash advanced to the pushed body + (goto-char (point-min)) + (re-search-forward "^\\*\\*\\*\\*\\* Craig") + (should (string= (secure-hash 'sha256 "new body") + (org-entry-get nil "LINEAR-COMMENT-SHA256"))))))) + +(ert-deftest test-pearl-edit-comment-refuses-conflict () + "When the remote changed since the fetch, the edit is refused." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil)) + (cl-letf (((symbol-function 'pearl--fetch-comment-body-async) + ;; remote drifted from the stored hash -> conflict + (lambda (_id cb) (funcall cb "remote changed body"))) + ((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t))) + ;; On conflict the command now prompts; cancel keeps the old + ;; refuse behavior (no commentUpdate call). + ((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (re-search-forward "new body") + (pearl-edit-current-comment) + (should-not updated))))) + +;;; editability highlighting + +(ert-deftest test-pearl-highlight-comments-colors-by-editability () + "Own comments get the editable face; others get the read-only face." + (test-pearl--in-org + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + "**** Comments\n" + "***** Me — 2026-05-24T09:00:00.000Z\n" + ":PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:LINEAR-COMMENT-AUTHOR-ID: u-me\n:END:\nmine\n" + "***** Them — 2026-05-24T10:00:00.000Z\n" + ":PROPERTIES:\n:LINEAR-COMMENT-ID: c2\n:LINEAR-COMMENT-AUTHOR-ID: u-other\n:END:\ntheirs\n") + (pearl--apply-comment-highlights "u-me") + (cl-flet ((face-on (pat) + (goto-char (point-min)) + (re-search-forward pat) + (goto-char (line-beginning-position)) + (let ((ov (cl-find-if (lambda (o) (overlay-get o 'pearl-comment)) + (overlays-at (point))))) + (and ov (overlay-get ov 'face))))) + (should (eq 'pearl-editable-comment (face-on "^\\*\\*\\*\\*\\* Me"))) + (should (eq 'pearl-readonly-comment (face-on "^\\*\\*\\*\\*\\* Them")))))) + +(provide 'test-pearl-comment-editing) +;;; test-pearl-comment-editing.el ends here diff --git a/tests/test-pearl-comments.el b/tests/test-pearl-comments.el new file mode 100644 index 0000000..7fa4482 --- /dev/null +++ b/tests/test-pearl-comments.el @@ -0,0 +1,170 @@ +;;; test-pearl-comments.el --- Tests for issue comments -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the comment thread: rendering a normalized comment and the +;; oldest-first Comments subtree, including comments in the issue render, the +;; commentCreate helper (stubbed at the HTTP boundary), the in-place append +;; under the Comments subtree (creating it when absent), and the +;; `pearl-add-comment' command. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; --format-comment / --format-comments + +(ert-deftest test-pearl-format-comment-renders-author-time-body () + "A comment renders as a level-4 heading with author and timestamp, body below." + (let ((out (pearl--format-comment + '(:id "c1" :author "Craig" :created-at "2026-05-23T10:00:00.000Z" + :body "Looks **good** to me")))) + (should (string-match-p "^\\*\\*\\*\\* Craig — 2026-05-23T10:00:00.000Z$" out)) + ;; body runs through the md->org tier + (should (string-match-p "Looks \\*good\\* to me" out)))) + +(ert-deftest test-pearl-format-comment-null-author () + "A comment with no resolved author renders a placeholder, not an error." + (let ((out (pearl--format-comment + '(:id "c1" :author nil :created-at "2026-05-23T10:00:00.000Z" :body "hi")))) + (should (string-match-p "^\\*\\*\\*\\* (unknown) — 2026-05-23T10:00:00.000Z$" out)))) + +(ert-deftest test-pearl-format-comments-empty-is-blank () + "No comments renders nothing (no empty Comments subtree)." + (should (string= "" (pearl--format-comments nil)))) + +(ert-deftest test-pearl-format-comments-oldest-first () + "Comments render under a Comments heading, oldest first regardless of input order." + (let ((out (pearl--format-comments + '((:id "c2" :author "B" :created-at "2026-05-23T12:00:00.000Z" :body "second") + (:id "c1" :author "A" :created-at "2026-05-23T09:00:00.000Z" :body "first"))))) + (should (string-match-p "^\\*\\*\\* Comments$" out)) + (should (< (string-match "first" out) (string-match "second" out))))) + +;;; comments in the issue render + +(ert-deftest test-pearl-format-issue-includes-comments () + "A normalized issue carrying comments renders the Comments subtree after the body." + (test-pearl--in-org "" + (let ((out (pearl--format-issue-as-org-entry + '(:id "u" :identifier "ENG-1" :title "Title" :priority 2 + :state (:name "Todo") :description "Body text." + :comments ((:id "c1" :author "A" :created-at "2026-05-23T09:00:00.000Z" + :body "a comment")))))) + (should (string-match-p "^\\*\\*\\* Comments$" out)) + (should (< (string-match "Body text." out) (string-match "a comment" out)))))) + +;;; --create-comment-async + +(ert-deftest test-pearl-create-comment-parses-payload () + "A successful commentCreate yields the normalized comment." + (testutil-linear-with-response + '((data (commentCreate + (success . t) + (comment (id . "c9") (body . "new one") + (createdAt . "2026-05-23T13:00:00.000Z") + (user (name . "Craig")))))) + (let (result) + (pearl--create-comment-async "issue-a" "new one" (lambda (r) (setq result r))) + (should (string= "c9" (plist-get result :id))) + (should (string= "Craig" (plist-get result :author)))))) + +(ert-deftest test-pearl-create-comment-soft-fail () + "A non-success commentCreate yields nil rather than erroring." + (testutil-linear-with-response + '((data (commentCreate (success . :json-false) (comment . nil)))) + (let ((called nil) (result 'untouched)) + (pearl--create-comment-async "issue-a" "x" (lambda (r) (setq called t result r))) + (should called) + (should (null result))))) + +;;; --append-comment-to-issue + +(ert-deftest test-pearl-append-comment-creates-subtree () + "Appending to an issue with no Comments subtree creates one." + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + (pearl--append-comment-to-issue + '(:id "c1" :author "A" :created-at "2026-05-23T09:00:00.000Z" :body "first comment")) + (goto-char (point-min)) + (should (re-search-forward "^\\*\\*\\* Comments$" nil t)) + (should (re-search-forward "first comment" nil t)))) + +(ert-deftest test-pearl-append-comment-after-existing () + "A new comment appends after an existing one under the Comments subtree." + (test-pearl--in-org + "** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n*** Comments\n**** A — 2026-05-23T09:00:00.000Z\nfirst\n" + (pearl--append-comment-to-issue + '(:id "c2" :author "B" :created-at "2026-05-23T12:00:00.000Z" :body "second")) + (goto-char (point-min)) + ;; only one Comments heading, and the new comment follows the first + (should (re-search-forward "^\\*\\*\\* Comments$" nil t)) + (should-not (re-search-forward "^\\*\\*\\* Comments$" nil t)) + (goto-char (point-min)) + (should (< (progn (re-search-forward "first") (point)) + (progn (re-search-forward "second") (point)))))) + +;;; pearl-add-comment + +(ert-deftest test-pearl-add-comment-appends-returned-comment () + "The command creates a comment and inserts the returned one in the buffer." + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + (cl-letf (((symbol-function 'pearl--create-comment-async) + (lambda (_id body cb) + (funcall cb (list :id "c1" :author "Craig" + :created-at "2026-05-23T14:00:00.000Z" :body body))))) + (re-search-forward "Body.") + (pearl-add-comment "my new comment") + (goto-char (point-min)) + (should (re-search-forward "^\\*\\*\\* Comments$" nil t)) + (should (re-search-forward "my new comment" nil t))))) + +(ert-deftest test-pearl-add-comment-reports-failure () + "A failed create does not insert a Comments subtree." + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + (cl-letf (((symbol-function 'pearl--create-comment-async) + (lambda (_id _body cb) (funcall cb nil)))) + (pearl-add-comment "x") + (goto-char (point-min)) + (should-not (re-search-forward "^\\*\\*\\* Comments$" nil t))))) + +(ert-deftest test-pearl-add-comment-not-on-issue-errors () + "Adding a comment outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-add-comment "x") :type 'user-error))) + +(provide 'test-pearl-comments) +;;; test-pearl-comments.el ends here diff --git a/tests/test-pearl-config.el b/tests/test-pearl-config.el new file mode 100644 index 0000000..e83414c --- /dev/null +++ b/tests/test-pearl-config.el @@ -0,0 +1,76 @@ +;;; test-pearl-config.el --- Tests for pearl config helpers -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for the small config / state helpers: `pearl--headers', +;; `pearl-toggle-debug', and `pearl-load-api-key-from-env'. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;;; pearl--headers + +(ert-deftest test-pearl-headers-no-key-errors () + "Building headers without an API key signals an error." + (let ((pearl-api-key nil)) + (should-error (pearl--headers)))) + +(ert-deftest test-pearl-headers-with-key-sets-authorization () + "With a key set, the Authorization header carries the raw key (no Bearer)." + (let ((pearl-api-key "lin_api_abc123")) + (let ((headers (pearl--headers))) + (should (string-equal "lin_api_abc123" (cdr (assoc "Authorization" headers)))) + (should (string-equal "application/json" (cdr (assoc "Content-Type" headers))))))) + +;;; pearl-toggle-debug + +(ert-deftest test-pearl-toggle-debug-flips-from-nil () + "Toggling from nil enables debug." + (let ((pearl-debug nil)) + (pearl-toggle-debug) + (should (eq t pearl-debug)))) + +(ert-deftest test-pearl-toggle-debug-flips-from-t () + "Toggling from t disables debug." + (let ((pearl-debug t)) + (pearl-toggle-debug) + (should (null pearl-debug)))) + +;;; pearl-load-api-key-from-env + +(ert-deftest test-pearl-load-api-key-from-env-present () + "When LINEAR_API_KEY is set, the key is loaded into the variable." + (let ((process-environment (cons "LINEAR_API_KEY=env-key-xyz" process-environment)) + (pearl-api-key nil)) + (pearl-load-api-key-from-env) + (should (string-equal "env-key-xyz" pearl-api-key)))) + +(ert-deftest test-pearl-load-api-key-from-env-absent-leaves-key () + "When LINEAR_API_KEY is unset, the key variable is left unchanged." + (let ((process-environment + (seq-remove (lambda (e) (string-prefix-p "LINEAR_API_KEY=" e)) + process-environment)) + (pearl-api-key nil)) + (pearl-load-api-key-from-env) + (should (null pearl-api-key)))) + +(provide 'test-pearl-config) +;;; test-pearl-config.el ends here diff --git a/tests/test-pearl-conflict.el b/tests/test-pearl-conflict.el new file mode 100644 index 0000000..03d8f31 --- /dev/null +++ b/tests/test-pearl-conflict.el @@ -0,0 +1,282 @@ +;;; test-pearl-conflict.el --- Tests for interactive conflict resolution -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the conflict-resolution foundation: the no-data-loss stash +;; (`pearl--stash-conflict-text'), the smerge conflict-string builder +;; (`pearl--conflict-smerge-string'), and the resolution prompt +;; (`pearl--read-conflict-resolution', cancel-by-default). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl-conflict--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defun test-pearl-conflict--marker () + "Return a marker at the first issue heading in the current buffer." + (goto-char (point-min)) + (re-search-forward "^\\*\\*\\* ") + (beginning-of-line) + (point-marker)) + +;;; --stash-conflict-text + +(ert-deftest test-pearl-stash-conflict-text-to-kill-ring-and-buffer () + "Stashing puts the text on the kill ring and into the backup buffer." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "My local edit.") + (should (string= "My local edit." (current-kill 0))) + (with-current-buffer "*pearl-conflict-backup*" + (let ((s (buffer-string))) + (should (string-match-p "ENG-1 description" s)) + (should (string-match-p "My local edit\\." s)))))) + +(ert-deftest test-pearl-stash-conflict-text-appends-not-overwrites () + "A second stash appends below the first, preserving earlier backups." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "First edit.") + (pearl--stash-conflict-text "ENG-2 title" "Second edit.") + (with-current-buffer "*pearl-conflict-backup*" + (let ((s (buffer-string))) + (should (string-match-p "First edit\\." s)) + (should (string-match-p "Second edit\\." s)))))) + +(ert-deftest test-pearl-stash-conflict-text-empty-is-noop () + "Stashing empty text touches neither the kill ring nor the backup buffer." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "") + (should (null kill-ring)) + (should-not (get-buffer "*pearl-conflict-backup*")))) + +;;; --conflict-smerge-string + +(ert-deftest test-pearl-conflict-smerge-string-has-markers-in-order () + "The smerge string carries the three markers with local before remote." + (let ((s (pearl--conflict-smerge-string "LOCAL TEXT" "REMOTE TEXT"))) + (should (string-match-p "^<<<<<<<" s)) + (should (string-match-p "^=======" s)) + (should (string-match-p "^>>>>>>>" s)) + (let ((lt (string-match "LOCAL TEXT" s)) + (sep (string-match "^=======" s)) + (rt (string-match "REMOTE TEXT" s))) + (should (< lt sep)) + (should (< sep rt))))) + +(ert-deftest test-pearl-conflict-smerge-string-newline-terminates-sections () + "Sections whose text lacks a trailing newline still get one before a marker." + (let ((s (pearl--conflict-smerge-string "no-newline-local" "no-newline-remote"))) + ;; The separator and closing markers must each start their own line. + (should (string-match-p "no-newline-local\n=======" s)) + (should (string-match-p "no-newline-remote\n>>>>>>>" s)))) + +;;; --read-conflict-resolution + +(ert-deftest test-pearl-read-conflict-resolution-maps-choices () + "Each prompt label maps to its resolution symbol." + (dolist (case '(("use local" . use-local) + ("use remote" . use-remote) + ("rewrite" . rewrite) + ("cancel" . cancel))) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt collection &rest _) + ;; Return the first offered label containing the case keyword. + (seq-find (lambda (c) (string-match-p (car case) c)) collection)))) + (should (eq (cdr case) (pearl--read-conflict-resolution "ENG-1 description")))))) + +(ert-deftest test-pearl-read-conflict-resolution-defaults-to-cancel () + "Selecting the default (a bare RET) resolves to `cancel'." + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _collection &rest args) + ;; Emulate RET-on-default: completing-read returns the DEF arg. + ;; args = (predicate require-match initial-input hist def ...), + ;; so DEF is the 5th element, index 4. + (nth 4 args)))) + (should (eq 'cancel (pearl--read-conflict-resolution "ENG-1 description"))))) + +;;; --set-entry-body-at-point + +(ert-deftest test-pearl-set-entry-body-replaces-body-keeps-drawer () + "Setting the body replaces the text after the drawer and preserves the drawer." + (test-pearl-conflict--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: x\n:END:\nOld body.\n" + (re-search-forward "Title") + (pearl--set-entry-body-at-point "New body line.") + (goto-char (point-min)) + (should (re-search-forward "New body line\\." nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "Old body\\." nil t)) + (should (string= "a" (org-entry-get nil "LINEAR-ID"))))) + +(ert-deftest test-pearl-set-entry-body-stops-before-child-heading () + "Setting the body does not disturb a child Comments subtree." + (test-pearl-conflict--in-org + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nOld body.\n" + "**** Comments\n***** Me — t\nmine\n") + (re-search-forward "Title") + (pearl--set-entry-body-at-point "New body.") + (goto-char (point-min)) + (should (re-search-forward "New body\\." nil t)) + (should (re-search-forward "Comments" nil t)) + (should (re-search-forward "mine" nil t)))) + +;;; --resolve-conflict + +(ert-deftest test-pearl-resolve-conflict-cancel-does-nothing () + "Cancel applies nothing, pushes nothing, and leaves the provenance hash." + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'cancel))) + (pearl--resolve-conflict + "ENG-1 description" "local" "remote" marker "LINEAR-DESC-SHA256" + (lambda (_md) (setq applied t)) + (lambda (_md cb) (setq pushed t) (funcall cb t))) + (should-not applied) + (should-not pushed) + (should (string= "H0" (org-entry-get marker "LINEAR-DESC-SHA256"))))))) + +(ert-deftest test-pearl-resolve-conflict-use-local-pushes-and-advances () + "Use-local pushes the local text and advances the hash to it on success." + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((pushed-md nil) (applied nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'use-local))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (_md) (setq applied t)) + (lambda (md cb) (setq pushed-md md) (funcall cb t))) + (should (string= "local text" pushed-md)) + (should-not applied) + (should (string= (secure-hash 'sha256 "local text") + (org-entry-get marker "LINEAR-DESC-SHA256"))))))) + +(ert-deftest test-pearl-resolve-conflict-use-remote-stashes-applies-no-push () + "Use-remote stashes local, writes remote, advances the hash, and never pushes." + (let ((kill-ring nil)) + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied-md nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'use-remote))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (md) (setq applied-md md)) + (lambda (_md cb) (setq pushed t) (funcall cb t))) + (should (string= "remote text" applied-md)) + (should-not pushed) + (should (string= (secure-hash 'sha256 "remote text") + (org-entry-get marker "LINEAR-DESC-SHA256"))) + ;; the local edit was stashed, not lost + (should (string= "local text" (current-kill 0)))))))) + +(ert-deftest test-pearl-resolve-conflict-rewrite-applies-and-pushes () + "Rewrite stashes local, then on the smerge finish applies and pushes the merge." + (let ((kill-ring nil)) + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'rewrite)) + ;; Emulate the user resolving the buffer and committing. + ((symbol-function 'pearl--resolve-conflict-in-smerge) + (lambda (_label _local _remote on-finish) + (funcall on-finish "merged text")))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (md) (setq applied md)) + (lambda (md cb) (setq pushed md) (funcall cb t))) + (should (string= "local text" (current-kill 0))) + (should (string= "merged text" applied)) + (should (string= "merged text" pushed)) + (should (string= (secure-hash 'sha256 "merged text") + (org-entry-get marker "LINEAR-DESC-SHA256")))))))) + +;;; --conflict-has-markers-p + +(ert-deftest test-pearl-conflict-has-markers-p () + "Unresolved marker text reports markers; resolved text does not." + (should (pearl--conflict-has-markers-p + (pearl--conflict-smerge-string "mine" "theirs"))) + (should-not (pearl--conflict-has-markers-p "just the merged line\n"))) + +;;; --resolve-conflict-in-smerge (buffer setup) + +(ert-deftest test-pearl-resolve-conflict-in-smerge-sets-up-buffer () + "Opening the smerge buffer fills it with both sides and arms the callback." + (let ((buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "my local" "the remote" (lambda (_) nil))) + (let ((buf (get-buffer buf-name))) + (should buf) + (with-current-buffer buf + (should (string-match-p "my local" (buffer-string))) + (should (string-match-p "the remote" (buffer-string))) + (should (bound-and-true-p smerge-mode)) + (should (functionp pearl--conflict-on-finish))) + (kill-buffer buf)))) + +;;; --conflict-commit / --conflict-abort + +(ert-deftest test-pearl-conflict-commit-refuses-with-markers () + "Committing with markers still present errors and never calls the callback." + (let ((called nil) (buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "mine" "theirs" (lambda (_) (setq called t)))) + (with-current-buffer buf-name + (should-error (pearl--conflict-commit) :type 'user-error)) + (should-not called) + (when (get-buffer buf-name) (kill-buffer buf-name)))) + +(ert-deftest test-pearl-conflict-commit-resolved-calls-callback-and-kills () + "With markers resolved, commit hands the text to the callback and kills the buffer." + (let ((got nil) (buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "mine" "theirs" (lambda (txt) (setq got txt)))) + (with-current-buffer buf-name + (erase-buffer) + (insert "the reconciled text\n") + (pearl--conflict-commit)) + (should (string= "the reconciled text\n" got)) + (should-not (get-buffer buf-name)))) + +(provide 'test-pearl-conflict) +;;; test-pearl-conflict.el ends here diff --git a/tests/test-pearl-convert.el b/tests/test-pearl-convert.el new file mode 100644 index 0000000..4125e22 --- /dev/null +++ b/tests/test-pearl-convert.el @@ -0,0 +1,172 @@ +;;; test-pearl-convert.el --- Tests for the markdown->org conversion -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl--md-to-org' and `pearl--md-line-to-org' -- +;; the pure-elisp markdown->org conversion tier. Cover each supported +;; construct (links, inline code, bold, underscore italics, headings, bullets, +;; fenced code), the heading-safety guard, and literal pass-through. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;;; inline conversion + +(ert-deftest test-pearl-convert-link () + "A markdown link becomes an org link with url and label swapped." + (should (string= "see [[https://x.y][the docs]] now" + (pearl--md-line-to-org "see [the docs](https://x.y) now")))) + +(ert-deftest test-pearl-convert-inline-code () + "Inline code backticks become org verbatim tildes." + (should (string= "call ~foo()~ here" + (pearl--md-line-to-org "call `foo()` here")))) + +(ert-deftest test-pearl-convert-bold () + "Markdown bold becomes org bold." + (should (string= "a *strong* word" (pearl--md-line-to-org "a **strong** word")))) + +(ert-deftest test-pearl-convert-italic-underscore () + "Underscore italics become org italics, but identifiers are left alone." + (should (string= "an /emphatic/ point" + (pearl--md-line-to-org "an _emphatic_ point"))) + (should (string= "the foo_bar_baz name" + (pearl--md-line-to-org "the foo_bar_baz name")))) + +;;; line / block conversion + +(ert-deftest test-pearl-convert-heading-to-bold () + "A markdown heading becomes a bold line, never an org heading." + (let ((out (pearl--md-to-org "## Big Heading"))) + (should (string= "*Big Heading*" out)) + (should-not (string-match-p "^\\*+ " out)))) + +(ert-deftest test-pearl-convert-bullets () + "Markdown `*' and `+' bullets become org `-' bullets." + (should (string= "- one\n- two" + (pearl--md-to-org "* one\n+ two")))) + +(ert-deftest test-pearl-convert-fenced-code () + "A fenced code block becomes a src block, verbatim inside." + (should (string= "#+begin_src elisp\n(+ 1 2)\n#+end_src" + (pearl--md-to-org "```elisp\n(+ 1 2)\n```")))) + +(ert-deftest test-pearl-convert-code-block-is-verbatim () + "Inline markup inside a fenced block is not converted." + (let ((out (pearl--md-to-org "```\n**not bold** here\n```"))) + (should (string-match-p "\\*\\*not bold\\*\\*" out)))) + +(ert-deftest test-pearl-convert-guards-heading-line () + "A non-bullet line that Org would read as a heading is space-guarded." + (let ((out (pearl--md-to-org "** looks like a heading"))) + (should-not (string-match-p "^\\*+ " out)) + (should (string-prefix-p " " out)))) + +(ert-deftest test-pearl-convert-passes-through-plain-and-tables () + "Plain text and unsupported constructs (tables) pass through unchanged." + (should (string= "just some text" (pearl--md-to-org "just some text"))) + (should (string= "| a | b |\n|---|---|" + (pearl--md-to-org "| a | b |\n|---|---|")))) + +(ert-deftest test-pearl-convert-empty () + "An empty or nil description converts to the empty string." + (should (string= "" (pearl--md-to-org ""))) + (should (string= "" (pearl--md-to-org nil)))) + +;;; org -> markdown (the push direction) + +(ert-deftest test-pearl-org-to-md-link () + "An org link becomes a markdown link with label and url swapped back." + (should (string= "see [the docs](https://x.y) now" + (pearl--org-line-to-md "see [[https://x.y][the docs]] now")))) + +(ert-deftest test-pearl-org-to-md-bare-link () + "An org link with no description becomes the bare url." + (should (string= "visit https://x.y" + (pearl--org-line-to-md "visit [[https://x.y]]")))) + +(ert-deftest test-pearl-org-to-md-inline-code () + "Org verbatim tildes become markdown backticks." + (should (string= "call `foo()` here" + (pearl--org-line-to-md "call ~foo()~ here")))) + +(ert-deftest test-pearl-org-to-md-bold () + "Org bold becomes markdown bold." + (should (string= "a **strong** word" (pearl--org-line-to-md "a *strong* word")))) + +(ert-deftest test-pearl-org-to-md-italic () + "Org italics become underscore italics, but paths are left alone." + (should (string= "an _emphatic_ point" + (pearl--org-line-to-md "an /emphatic/ point"))) + (should (string= "the /usr/local/bin path" + (pearl--org-line-to-md "the /usr/local/bin path")))) + +(ert-deftest test-pearl-org-to-md-fenced-code () + "An org src block becomes a fenced code block, language preserved." + (should (string= "```elisp\n(+ 1 2)\n```" + (pearl--org-to-md "#+begin_src elisp\n(+ 1 2)\n#+end_src")))) + +(ert-deftest test-pearl-org-to-md-code-block-is-verbatim () + "Org markup inside a src block is not converted back." + (let ((out (pearl--org-to-md "#+begin_src\n*not bold* here\n#+end_src"))) + (should (string-match-p "\\*not bold\\* here" out)))) + +(ert-deftest test-pearl-org-to-md-quote-block () + "An org quote block becomes markdown blockquote lines." + (should (string= "> a quote\n> second line" + (pearl--org-to-md + "#+begin_quote\na quote\nsecond line\n#+end_quote")))) + +(ert-deftest test-pearl-org-to-md-checkbox-case () + "Org uppercase checkbox marks normalize to markdown lowercase." + (should (string= "- [ ] todo\n- [x] done" + (pearl--org-to-md "- [ ] todo\n- [X] done")))) + +(ert-deftest test-pearl-org-to-md-empty () + "An empty or nil body converts to the empty string." + (should (string= "" (pearl--org-to-md ""))) + (should (string= "" (pearl--org-to-md nil)))) + +(ert-deftest test-pearl-org-to-md-passes-through-tables () + "Tables and unsupported constructs pass through unchanged." + (should (string= "| a | b |\n|---|---|" + (pearl--org-to-md "| a | b |\n|---|---|")))) + +;;; round-trip: org-to-md inverts md-to-org for the supported subset + +(ert-deftest test-pearl-convert-roundtrip-identity () + "For the cleanly-supported constructs, org->md(md->org(x)) == x. +Markdown headings and single-asterisk italics are intentionally lossy (see +the conversion-tier docstring) and are excluded here." + (dolist (md '("a **strong** word" + "call `foo()` here" + "an _emphatic_ point" + "see [the docs](https://x.y) now" + "- one\n- two\n- three" + "1. first\n2. second" + "- [ ] todo\n- [x] done" + "```elisp\n(+ 1 2)\n```" + "just some plain prose" + "| a | b |\n|---|---|")) + (should (string= md (pearl--org-to-md (pearl--md-to-org md)))))) + +(provide 'test-pearl-convert) +;;; test-pearl-convert.el ends here diff --git a/tests/test-pearl-delete.el b/tests/test-pearl-delete.el new file mode 100644 index 0000000..bd412c7 --- /dev/null +++ b/tests/test-pearl-delete.el @@ -0,0 +1,97 @@ +;;; test-pearl-delete.el --- Tests for deleting an issue -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl--delete-issue-async' (the issueDelete mutation, +;; stubbed) and `pearl-delete-current-issue', which confirms, deletes, +;; and removes the issue subtree from the buffer on success. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT at point-min." + (declare (indent 1)) + `(with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body)) + +;;; --delete-issue-async + +(ert-deftest test-pearl-delete-issue-async-success () + "A successful issueDelete reports success." + (testutil-linear-with-response + '((data (issueDelete (success . t)))) + (let (result) + (pearl--delete-issue-async "id-1" (lambda (r) (setq result r))) + (should (eq t (plist-get result :success)))))) + +(ert-deftest test-pearl-delete-issue-async-soft-fail () + "A non-success issueDelete reports failure rather than erroring." + (testutil-linear-with-response + '((data (issueDelete (success . :json-false)))) + (let ((called nil) result) + (pearl--delete-issue-async "id-1" (lambda (r) (setq called t result r))) + (should called) + (should-not (plist-get result :success))))) + +;;; delete-current-issue + +(ert-deftest test-pearl-delete-current-issue-confirmed-removes-subtree () + "Confirming the delete removes the issue subtree from the buffer." + (test-pearl--in-org + "* Header\n\n*** TODO ENG-1 Doomed\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-IDENTIFIER: ENG-1\n:END:\nbody\n*** TODO ENG-2 Survivor\n:PROPERTIES:\n:LINEAR-ID: b\n:END:\n" + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'pearl--delete-issue-async) + (lambda (_id cb) (funcall cb '(:success t))))) + (re-search-forward "Doomed") + (pearl-delete-current-issue) + (goto-char (point-min)) + (should-not (re-search-forward "Doomed" nil t)) + ;; the sibling issue is untouched + (goto-char (point-min)) + (should (re-search-forward "Survivor" nil t))))) + +(ert-deftest test-pearl-delete-current-issue-declined-keeps-subtree () + "Declining the confirmation makes no API call and leaves the subtree." + (let ((called nil)) + (test-pearl--in-org + "*** TODO ENG-1 Keepme\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n" + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'pearl--delete-issue-async) + (lambda (&rest _) (setq called t)))) + (pearl-delete-current-issue) + (should-not called) + (goto-char (point-min)) + (should (re-search-forward "Keepme" nil t)))))) + +(ert-deftest test-pearl-delete-current-issue-not-on-issue-errors () + "Deleting outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))) + (should-error (pearl-delete-current-issue) :type 'user-error)))) + +(provide 'test-pearl-delete) +;;; test-pearl-delete.el ends here diff --git a/tests/test-pearl-fields.el b/tests/test-pearl-fields.el new file mode 100644 index 0000000..7322e4f --- /dev/null +++ b/tests/test-pearl-fields.el @@ -0,0 +1,153 @@ +;;; test-pearl-fields.el --- Tests for command-managed drawer fields -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the command-managed drawer fields that need no name->id +;; resolution helper: set-priority and set-state. Covers the generic +;; issueUpdate helper (stubbed at the HTTP boundary), the heading cookie and +;; keyword/drawer mutators, and the two commands' push + buffer-update paths. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; --update-issue-async (generic issueUpdate) + +(ert-deftest test-pearl-update-issue-async-success () + "A successful generic issueUpdate reports success and the timestamp." + (testutil-linear-with-response + '((data (issueUpdate (success . t) (issue (id . "a") (updatedAt . "t1"))))) + (let (result) + (pearl--update-issue-async "a" '(("priority" . 2)) (lambda (r) (setq result r))) + (should (eq t (plist-get result :success))) + (should (string= "t1" (plist-get result :updated-at)))))) + +(ert-deftest test-pearl-update-issue-async-soft-fail () + "A non-success generic issueUpdate reports failure rather than erroring." + (testutil-linear-with-response + '((data (issueUpdate (success . :json-false) (issue . nil)))) + (let ((called nil) result) + (pearl--update-issue-async "a" '(("priority" . 2)) (lambda (r) (setq called t result r))) + (should called) + (should-not (plist-get result :success))))) + +;;; --set-priority-cookie + +(ert-deftest test-pearl-set-priority-cookie-replaces () + "Setting a priority rewrites the heading cookie." + (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (pearl--set-priority-cookie 1) + (goto-char (point-min)) + (should (string-match-p "^\\*\\*\\* TODO \\[#A\\] Title" (thing-at-point 'line t))))) + +(ert-deftest test-pearl-set-priority-cookie-low () + "Low priority renders the #D cookie." + (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (pearl--set-priority-cookie 4) + (goto-char (point-min)) + (should (string-match-p "^\\*\\*\\* TODO \\[#D\\] Title" (thing-at-point 'line t))))) + +(ert-deftest test-pearl-set-priority-cookie-none-removes () + "Priority None removes the cookie." + (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (pearl--set-priority-cookie 0) + (goto-char (point-min)) + (should (string-match-p "^\\*\\*\\* TODO Title" (thing-at-point 'line t))) + (should-not (string-match-p "\\[#" (thing-at-point 'line t))))) + +;;; pearl-set-priority + +(ert-deftest test-pearl-set-priority-pushes-and-updates-cookie () + "Setting priority pushes the numeric value and rewrites the cookie." + (let ((pushed nil)) + (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (cl-letf (((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) + (re-search-forward "Title") + (pearl-set-priority "High") + (should (equal 2 (cdr (assoc "priority" pushed)))) + (goto-char (point-min)) + (should (string-match-p "\\[#B\\]" (thing-at-point 'line t))))))) + +(ert-deftest test-pearl-set-priority-not-on-issue-errors () + "Setting priority outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-set-priority "High") :type 'user-error))) + +;;; --set-heading-state + +(ert-deftest test-pearl-set-heading-state-updates-keyword-and-drawer () + "Setting the heading state updates the TODO keyword and the LINEAR-STATE drawer." + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-STATE-ID: old\n:LINEAR-STATE-NAME: Todo\n:END:\n" + (pearl--set-heading-state "In Progress" "s2") + (goto-char (point-min)) + (should (string-match-p "^\\*\\*\\* IN-PROGRESS " (thing-at-point 'line t))) + (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))) + (should (string= "s2" (org-entry-get nil "LINEAR-STATE-ID"))))) + +(ert-deftest test-pearl-set-heading-state-does-not-fire-sync-hook () + "Setting the keyword must not trigger the Linear org-todo sync hook." + (let ((fired nil)) + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (let ((org-after-todo-state-change-hook (list (lambda () (setq fired t))))) + (pearl--set-heading-state "Done" "s3") + (should-not fired))))) + +;;; pearl-set-state + +(ert-deftest test-pearl-set-state-pushes-id-and-updates-heading () + "Setting state resolves the name to an id, pushes it, and updates the heading." + (let ((pushed nil)) + (test-pearl--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" + (cl-letf (((symbol-function 'pearl--team-states) + (lambda (_team) '(((id . "s1") (name . "Todo")) + ((id . "s2") (name . "In Progress"))))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) + (pearl-set-state "In Progress") + (should (string= "s2" (cdr (assoc "stateId" pushed)))) + (goto-char (point-min)) + (should (string-match-p "^\\*\\*\\* IN-PROGRESS " (thing-at-point 'line t))) + (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))))))) + +(ert-deftest test-pearl-set-state-not-on-issue-errors () + "Setting state outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-set-state "Done") :type 'user-error))) + +(provide 'test-pearl-fields) +;;; test-pearl-fields.el ends here diff --git a/tests/test-pearl-filter.el b/tests/test-pearl-filter.el new file mode 100644 index 0000000..6143311 --- /dev/null +++ b/tests/test-pearl-filter.el @@ -0,0 +1,193 @@ +;;; test-pearl-filter.el --- Tests for the issue filter DSL -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the Layer 1 issue-filter DSL: `pearl--build-issue-filter' +;; (and its predicate helpers) and `pearl--validate-issue-filter'. All +;; pure -- no network. Each authoring key is checked in isolation, then in +;; combination (sibling clauses AND-ed), with `:state'/`:open' precedence and a +;; json-encode round-trip; validation covers the error cases. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'json) + +;;; predicate helpers + +(ert-deftest test-pearl-filter-eq-helper () + "`--eq' wraps a value in an eq comparator." + (should (equal (pearl--eq "x") '(("eq" . "x")))) + (should (equal (pearl--eq t) '(("eq" . t))))) + +(ert-deftest test-pearl-filter-in-nin-helpers-make-vectors () + "`--in' / `--nin' encode their values as JSON arrays (vectors)." + (should (equal (pearl--in '("a" "b")) '(("in" . ["a" "b"])))) + (should (equal (pearl--nin '("a")) '(("nin" . ["a"]))))) + +;;; compile-priority + +(ert-deftest test-pearl-filter-compile-priority-symbol-and-int () + "Priority symbols map to numbers; integers pass through." + (should (= 1 (pearl--compile-priority 'urgent))) + (should (= 0 (pearl--compile-priority 'none))) + (should (= 4 (pearl--compile-priority 'low))) + (should (= 3 (pearl--compile-priority 3)))) + +;;; build-issue-filter -- single dimensions (Normal) + +(ert-deftest test-pearl-filter-assignee-me () + ":assignee :me compiles to assignee.isMe.eq true." + (should (equal (pearl--build-issue-filter '(:assignee :me)) + '(("assignee" ("isMe" ("eq" . t))))))) + +(ert-deftest test-pearl-filter-assignee-email () + ":assignee with an email compiles to assignee.email.eq." + (should (equal (pearl--build-issue-filter '(:assignee "x@y.com")) + '(("assignee" ("email" ("eq" . "x@y.com"))))))) + +(ert-deftest test-pearl-filter-open () + ":open t compiles to state.type nin the closed types." + (should (equal (pearl--build-issue-filter '(:open t)) + '(("state" ("type" ("nin" . ["completed" "canceled" "duplicate"]))))))) + +(ert-deftest test-pearl-filter-state-name () + ":state compiles to state.name.eq." + (should (equal (pearl--build-issue-filter '(:state "In Progress")) + '(("state" ("name" ("eq" . "In Progress"))))))) + +(ert-deftest test-pearl-filter-state-type-list () + ":state-type with a list compiles to state.type.in." + (should (equal (pearl--build-issue-filter '(:state-type ("started" "unstarted"))) + '(("state" ("type" ("in" . ["started" "unstarted"]))))))) + +(ert-deftest test-pearl-filter-state-type-single () + ":state-type with a bare string is wrapped into a one-element array." + (should (equal (pearl--build-issue-filter '(:state-type "started")) + '(("state" ("type" ("in" . ["started"]))))))) + +(ert-deftest test-pearl-filter-project-team-cycle () + ":project / :cycle compile to id.eq; :team to key.eq." + (should (equal (pearl--build-issue-filter '(:project "p-1")) + '(("project" ("id" ("eq" . "p-1")))))) + (should (equal (pearl--build-issue-filter '(:team "ENG")) + '(("team" ("key" ("eq" . "ENG")))))) + (should (equal (pearl--build-issue-filter '(:cycle "c-1")) + '(("cycle" ("id" ("eq" . "c-1"))))))) + +(ert-deftest test-pearl-filter-labels-any-of () + ":labels compiles to labels.some.name.in (carries any of the listed labels)." + (should (equal (pearl--build-issue-filter '(:labels ("bug" "p1"))) + '(("labels" ("some" ("name" ("in" . ["bug" "p1"])))))))) + +(ert-deftest test-pearl-filter-priority-symbol () + ":priority symbol compiles to priority.eq with the numeric value." + (should (equal (pearl--build-issue-filter '(:priority high)) + '(("priority" ("eq" . 2)))))) + +;;; precedence (:state / :state-type win over :open) + +(ert-deftest test-pearl-filter-explicit-state-beats-open () + "An explicit :state overrides :open." + (should (equal (pearl--build-issue-filter '(:open t :state "Done")) + '(("state" ("name" ("eq" . "Done"))))))) + +(ert-deftest test-pearl-filter-state-type-beats-open () + ":state-type overrides :open." + (should (equal (pearl--build-issue-filter '(:open t :state-type ("started"))) + '(("state" ("type" ("in" . ["started"]))))))) + +;;; composition (sibling clauses AND-ed) + ordering keys ignored + +(ert-deftest test-pearl-filter-composition-keeps-all-clauses () + "Multiple keys produce sibling clauses; :sort/:order don't affect the filter." + (let ((f (pearl--build-issue-filter + '(:assignee :me :open t :project "p-1" :labels ("bug") + :priority urgent :sort updated :order desc)))) + (should (assoc "assignee" f)) + (should (assoc "state" f)) + (should (assoc "project" f)) + (should (assoc "labels" f)) + (should (assoc "priority" f)) + ;; ordering keys are not part of the IssueFilter + (should-not (assoc "sort" f)) + (should-not (assoc "order" f)))) + +;;; boundary + +(ert-deftest test-pearl-filter-empty-plist-empty-filter () + "An empty plist compiles to an empty filter." + (should (null (pearl--build-issue-filter '())))) + +(ert-deftest test-pearl-filter-priority-zero-kept () + ":priority 0 (none) is kept, not treated as absent." + (should (equal (pearl--build-issue-filter '(:priority 0)) + '(("priority" ("eq" . 0)))))) + +;;; json-encode round-trip (proves the alist shape renders the right JSON) + +(ert-deftest test-pearl-filter-json-encodes-as-expected () + "The compiled filter json-encodes to the expected IssueFilter JSON." + (should (string= (json-encode (pearl--build-issue-filter '(:assignee :me :open t))) + (concat "{\"assignee\":{\"isMe\":{\"eq\":true}}," + "\"state\":{\"type\":{\"nin\":" + "[\"completed\",\"canceled\",\"duplicate\"]}}}")))) + +;;; validation (Error cases) + +(ert-deftest test-pearl-filter-validate-accepts-good-filter () + "A well-formed filter validates to t." + (should (eq t (pearl--validate-issue-filter + '(:assignee :me :open t :priority high :labels ("bug") :order desc))))) + +(ert-deftest test-pearl-filter-validate-rejects-unknown-key () + "An unknown key is a user-error." + (should-error (pearl--validate-issue-filter '(:bogus 1)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-odd-plist () + "A plist with an odd number of elements is a user-error." + (should-error (pearl--validate-issue-filter '(:open)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-bad-priority-symbol () + "An unrecognized priority symbol is a user-error." + (should-error (pearl--validate-issue-filter '(:priority huge)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-priority-out-of-range () + "A priority integer outside 0-4 is a user-error." + (should-error (pearl--validate-issue-filter '(:priority 9)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-bad-assignee () + "An :assignee that is neither :me nor a string is a user-error." + (should-error (pearl--validate-issue-filter '(:assignee 42)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-empty-string () + "An empty string for a value key is a user-error." + (should-error (pearl--validate-issue-filter '(:project "")) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-bad-order () + "An :order other than asc/desc is a user-error." + (should-error (pearl--validate-issue-filter '(:order sideways)) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-non-string-label () + "A non-string entry in :labels is a user-error." + (should-error (pearl--validate-issue-filter '(:labels ("bug" 7))) :type 'user-error)) + +(provide 'test-pearl-filter) +;;; test-pearl-filter.el ends here diff --git a/tests/test-pearl-fixtures.el b/tests/test-pearl-fixtures.el new file mode 100644 index 0000000..dfd9e1d --- /dev/null +++ b/tests/test-pearl-fixtures.el @@ -0,0 +1,68 @@ +;;; test-pearl-fixtures.el --- smoke tests for the API fixtures -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Smoke tests for `testutil-fixtures'. The fixtures exist for the upcoming +;; query/representation tests, which don't exist yet, so without this file the +;; suite would never load the fixtures and a syntax slip or shape change would +;; rot unnoticed. These assertions exercise the file and lock the key shapes +;; the consuming tests will rely on (json-read conventions: missing keys for +;; absent fields, `t' / `:json-false' booleans). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-fixtures (expand-file-name "testutil-fixtures.el")) + +(ert-deftest test-pearl-fixture-assigned-page-shape () + "The assignedIssues page fixture has nodes and a pageInfo." + (let* ((page (testutil-linear-fixture-assigned-issues-page)) + (conn (cdr (assoc 'assignedIssues + (assoc 'viewer (assoc 'data page)))))) + (should (= 2 (length (cdr (assoc 'nodes conn))))) + (should (eq :json-false (cdr (assoc 'hasNextPage (assoc 'pageInfo conn))))))) + +(ert-deftest test-pearl-fixture-null-fields-omits-optionals () + "The null-fields issue carries empty/absent project, assignee, and labels." + (let ((issue (testutil-linear-fixture-issue-null-fields))) + ;; present-but-empty: the key exists with a nil value (JSON null) + (should (assoc 'project issue)) + (should (null (cdr (assoc 'project issue)))) + (should (null (cdr (assoc 'assignee issue)))) + ;; labels is an empty connection, not missing + (should (null (cdr (assoc 'nodes (assoc 'labels issue))))))) + +(ert-deftest test-pearl-fixture-custom-views-shape () + "The customViews fixture exposes named views with a shared flag." + (let* ((views (cdr (assoc 'nodes (assoc 'customViews + (assoc 'data (testutil-linear-fixture-custom-views))))))) + (should (= 2 (length views))) + (should (string-equal "My open work" (cdr (assoc 'name (car views))))) + (should (eq t (cdr (assoc 'shared (cadr views))))))) + +(ert-deftest test-pearl-fixture-comments-oldest-first () + "The issue-with-comments fixture orders comments oldest first." + (let ((comments (cdr (assoc 'nodes (assoc 'comments + (testutil-linear-fixture-issue-with-comments)))))) + (should (= 2 (length comments))) + (should (string-equal "First comment" (cdr (assoc 'body (car comments))))))) + +(provide 'test-pearl-fixtures) +;;; test-pearl-fixtures.el ends here diff --git a/tests/test-pearl-format.el b/tests/test-pearl-format.el new file mode 100644 index 0000000..7310413 --- /dev/null +++ b/tests/test-pearl-format.el @@ -0,0 +1,188 @@ +;;; test-pearl-format.el --- Tests for org entry rendering -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the org renderer: `pearl--format-issue-as-org-entry' (a +;; normalized issue plist -> heading + LINEAR-* drawer + body description), +;; `pearl--description-to-org-body' (the interim heading guard), and +;; `pearl--build-org-content'. Issues come from the shared fixtures via +;; `pearl--normalize-issue', so the renderer is exercised on the same +;; shapes production hands it. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-fixtures (expand-file-name "testutil-fixtures.el")) + +(defmacro test-pearl--with-default-mapping (&rest body) + "Run BODY with the default state mapping and a clean pattern cache." + (declare (indent 0)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") + ("In Review" . "IN-REVIEW") ("Backlog" . "BACKLOG") + ("Blocked" . "BLOCKED") ("Done" . "DONE"))) + (pearl-todo-states-pattern nil) + (pearl--todo-states-pattern-source nil)) + ,@body)) + +(defun test-pearl--norm-full () + "A normalized fully-populated issue." + (pearl--normalize-issue (testutil-linear-fixture-issue-full))) + +(defun test-pearl--norm-bare () + "A normalized issue with null/missing optional fields." + (pearl--normalize-issue (testutil-linear-fixture-issue-null-fields))) + +;;; format-issue-as-org-entry + +(ert-deftest test-pearl-format-issue-full-renders-heading-and-drawer () + "A full issue renders the heading and the namespaced LINEAR-* drawer." + (test-pearl--with-default-mapping + (let ((out (pearl--format-issue-as-org-entry (test-pearl--norm-full)))) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] Fix the thing$" out)) + (should (string-match-p "^:LINEAR-ID: +uuid-1$" out)) + (should (string-match-p "^:LINEAR-IDENTIFIER: +ENG-42$" out)) + (should (string-match-p "^:LINEAR-STATE-NAME: +In Progress$" out)) + (should (string-match-p "^:LINEAR-TEAM-NAME: +Engineering$" out)) + (should (string-match-p "^:LINEAR-PROJECT-NAME: +Platform$" out)) + (should (string-match-p "^:LINEAR-ASSIGNEE-NAME: +Craig$" out)) + (should (string-match-p "^:LINEAR-LABELS: +\\[bug, backend\\]$" out)) + (should (string-match-p "^:LINEAR-DESC-SHA256: +[0-9a-f]\\{64\\}$" out)) + (should (string-match-p "^:LINEAR-TITLE-SHA256: +[0-9a-f]\\{64\\}$" out)) + (should (string-match-p "^:END:$" out))))) + +(ert-deftest test-pearl-format-issue-description-in-body-not-property () + "The description renders as body text, not a :DESCRIPTION: property." + (test-pearl--with-default-mapping + (let ((out (pearl--format-issue-as-org-entry (test-pearl--norm-full)))) + (should-not (string-match-p ":DESCRIPTION:" out)) + (should (string-match-p "Line one" out)) + (should (string-match-p "Line two" out))))) + +(ert-deftest test-pearl-format-issue-bare-empty-optionals () + "Null/missing optional fields render as empty values, and the body is empty." + (test-pearl--with-default-mapping + (let ((out (pearl--format-issue-as-org-entry (test-pearl--norm-bare)))) + (should (string-match-p "^\\*\\* TODO \\[#C\\] Bare issue$" out)) + (should (string-match-p "^:LINEAR-PROJECT-NAME: +$" out)) + (should (string-match-p "^:LINEAR-ASSIGNEE-NAME: +$" out)) + (should (string-match-p "^:LINEAR-LABELS: +\\[\\]$" out)) + ;; null description -> nothing after :END: + (should (string-match-p ":END:\n\\'" out))))) + +(ert-deftest test-pearl-format-issue-strips-brackets-from-title () + "Square brackets in the title are stripped so org parsing stays sane." + (test-pearl--with-default-mapping + (let ((out (pearl--format-issue-as-org-entry + '(:id "u" :identifier "ENG-1" :title "Fix [URGENT] bug" + :priority 1 :state (:name "Todo"))))) + (should (string-match-p "^\\*\\* TODO \\[#A\\] Fix URGENT bug$" out)) + ;; the title provenance hash is of the stripped (rendered) title, so a + ;; later no-op title sync matches the heading and never clobbers brackets + (should (string-match-p + (format "^:LINEAR-TITLE-SHA256: +%s$" (secure-hash 'sha256 "Fix URGENT bug")) + out))))) + +;;; build-org-content + +(ert-deftest test-pearl-build-org-content-empty-issues-header-only () + "With no issues the content is the file header plus the empty parent, no entries." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content '()))) + (should (string-match-p "^#\\+title:" out)) + (should-not (string-match-p "^\\*\\* " out))))) + +(ert-deftest test-pearl-build-org-content-no-hardcoded-filetags () + "The header carries no hardcoded =#+filetags= (a personal value used to leak in)." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content '()))) + (should-not (string-match-p "#\\+filetags" out)) + (should-not (string-match-p "twai" out))))) + +(ert-deftest test-pearl-build-org-content-renders-view-parent-heading () + "Issues nest under a single top-level heading named after the view, so they +sort together (org-sort on the parent) instead of being orphan headings." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content + (list (test-pearl--norm-full)) + '(:type filter :name "My open issues" :filter nil)))) + (should (string-match-p "^\\* My open issues$" out)) + ;; the parent precedes the issue, which renders one level deeper + (should (< (string-match "^\\* My open issues$" out) + (string-match "^\\*\\* IN-PROGRESS" out)))))) + +(ert-deftest test-pearl-build-org-content-startup-show3levels () + "The page opens folded to headings (parent, issues, Comments), bodies hidden." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content '()))) + (should (string-match-p "^#\\+STARTUP: show3levels$" out)) + (should-not (string-match-p "^#\\+STARTUP: overview$" out))))) + +(ert-deftest test-pearl-build-org-content-no-shared-file-id () + "The file header carries no hardcoded org :ID: drawer." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content '()))) + (should-not (string-match-p "a12acb12" out)) + (should-not (string-match-p "^:PROPERTIES:$" out))))) + +(ert-deftest test-pearl-build-org-content-includes-each-issue () + "Each issue contributes one heading to the rendered content." + (test-pearl--with-default-mapping + (let ((out (pearl--build-org-content + (list (test-pearl--norm-full) (test-pearl--norm-bare))))) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] Fix the thing$" out)) + (should (string-match-p "^\\*\\* TODO \\[#C\\] Bare issue$" out))))) + +;;; --restore-page-visibility + +(defun test-pearl--line-visible-p (re) + "Non-nil when the line matching RE from point-min is not folded away." + (save-excursion + (goto-char (point-min)) + (and (re-search-forward re nil t) + (not (invisible-p (line-beginning-position)))))) + +(ert-deftest test-pearl-restore-page-visibility-folds-bodies-keeps-headings () + "After a repopulation the page folds to headings: parent and issues stay +visible while property drawers fold away." + (test-pearl--with-default-mapping + (let ((pearl-fold-after-update t)) + (with-temp-buffer + (insert (pearl--build-org-content (list (test-pearl--norm-full)))) + (org-mode) + (org-fold-show-all) + (pearl--restore-page-visibility) + (should (test-pearl--line-visible-p "^\\* ")) + (should (test-pearl--line-visible-p "^\\*\\* IN-PROGRESS")) + (should-not (test-pearl--line-visible-p "^:LINEAR-ID:")))))) + +(ert-deftest test-pearl-restore-page-visibility-noop-when-disabled () + "With `pearl-fold-after-update' nil the buffer is left fully expanded." + (test-pearl--with-default-mapping + (let ((pearl-fold-after-update nil)) + (with-temp-buffer + (insert (pearl--build-org-content (list (test-pearl--norm-full)))) + (org-mode) + (org-fold-show-all) + (pearl--restore-page-visibility) + (should (test-pearl--line-visible-p "^:LINEAR-ID:")))))) + +(provide 'test-pearl-format) +;;; test-pearl-format.el ends here diff --git a/tests/test-pearl-issues.el b/tests/test-pearl-issues.el new file mode 100644 index 0000000..0976e0a --- /dev/null +++ b/tests/test-pearl-issues.el @@ -0,0 +1,73 @@ +;;; test-pearl-issues.el --- Tests for pearl issue fetch/create -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for issue creation with `request' stubbed, focused on +;; `pearl--created-issue' (the success-checking helper that prevents +;; phantom "created" reports) and the create-issue async path. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) + +;;; pearl--created-issue (pure) + +(ert-deftest test-pearl-created-issue-success-returns-node () + "A successful create returns the issue node." + (let ((issue (pearl--created-issue + '((data (issueCreate (success . t) + (issue (id . "i1") (identifier . "ENG-1") (title . "T")))))))) + (should (string-equal "ENG-1" (cdr (assoc 'identifier issue)))))) + +(ert-deftest test-pearl-created-issue-soft-fail-returns-nil () + "A soft failure (success=false, issue=null) returns nil, not a phantom node." + (should (null (pearl--created-issue + '((data (issueCreate (success . :json-false) (issue)))))))) + +(ert-deftest test-pearl-created-issue-graphql-error-returns-nil () + "A GraphQL error body (no data) returns nil." + (should (null (pearl--created-issue '((errors . (((message . "bad"))))))))) + +(ert-deftest test-pearl-created-issue-empty-response-returns-nil () + "A nil/empty response returns nil." + (should (null (pearl--created-issue nil)))) + +;;; pearl-create-issue-async + +(ert-deftest test-pearl-create-issue-async-success-passes-issue () + "A successful create passes the issue node to the callback." + (let ((got 'unset)) + (testutil-linear-with-response + '((data (issueCreate (success . t) + (issue (id . "i1") (identifier . "ENG-1") (title . "T"))))) + (pearl-create-issue-async "T" "" "team" (lambda (i) (setq got i)))) + (should (string-equal "ENG-1" (cdr (assoc 'identifier got)))))) + +(ert-deftest test-pearl-create-issue-async-soft-fail-passes-nil () + "A soft failure passes nil to the callback rather than a phantom issue." + (let ((got 'unset)) + (testutil-linear-with-response + '((data (issueCreate (success . :json-false) (issue)))) + (pearl-create-issue-async "T" "" "team" (lambda (i) (setq got i)))) + (should (null got)))) + +(provide 'test-pearl-issues) +;;; test-pearl-issues.el ends here diff --git a/tests/test-pearl-mapping.el b/tests/test-pearl-mapping.el new file mode 100644 index 0000000..a4e02e7 --- /dev/null +++ b/tests/test-pearl-mapping.el @@ -0,0 +1,145 @@ +;;; test-pearl-mapping.el --- Tests for pearl mapping helpers -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for the pure mapping helpers in pearl.el: +;; Linear state <-> org keyword, the cached TODO-states regex, and +;; Linear priority -> org cookie / readable name. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;; A small, explicit mapping used across the state tests so cases don't +;; depend on the package default. +(defmacro test-pearl--with-mapping (mapping &rest body) + "Run BODY with the state mapping bound to MAPPING and the cache cleared." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping ,mapping) + (pearl-todo-states-pattern nil) + (pearl--todo-states-pattern-source nil)) + ,@body)) + +;;; pearl--map-linear-state-to-org + +(ert-deftest test-pearl-map-linear-state-to-org-mapped-returns-keyword () + "A Linear state present in the mapping returns its org keyword." + (test-pearl--with-mapping '(("Todo" . "TODO") ("In Progress" . "DOING")) + (should (string-equal "DOING" (pearl--map-linear-state-to-org "In Progress"))))) + +(ert-deftest test-pearl-map-linear-state-to-org-unmapped-defaults-todo () + "An unmapped Linear state falls back to TODO." + (test-pearl--with-mapping '(("Todo" . "TODO") ("Done" . "DONE")) + (should (string-equal "TODO" (pearl--map-linear-state-to-org "Triage"))))) + +(ert-deftest test-pearl-map-linear-state-to-org-nil-defaults-todo () + "A nil state falls back to TODO rather than erroring." + (test-pearl--with-mapping '(("Todo" . "TODO")) + (should (string-equal "TODO" (pearl--map-linear-state-to-org nil))))) + +;;; pearl--map-org-state-to-linear + +(ert-deftest test-pearl-map-org-state-to-linear-mapped-returns-state () + "An org keyword present in the mapping returns its Linear state." + (test-pearl--with-mapping '(("Todo" . "TODO") ("In Progress" . "DOING")) + (should (string-equal "In Progress" (pearl--map-org-state-to-linear "DOING"))))) + +(ert-deftest test-pearl-map-org-state-to-linear-unmapped-returns-nil () + "An org keyword not in the mapping returns nil." + (test-pearl--with-mapping '(("Todo" . "TODO") ("Done" . "DONE")) + (should (null (pearl--map-org-state-to-linear "WAITING"))))) + +(ert-deftest test-pearl-map-org-state-to-linear-nil-returns-nil () + "A nil org keyword returns nil." + (test-pearl--with-mapping '(("Todo" . "TODO")) + (should (null (pearl--map-org-state-to-linear nil))))) + +;;; pearl--get-todo-states-pattern + +(ert-deftest test-pearl-get-todo-states-pattern-builds-alternation () + "The pattern is the org keywords joined with regex alternation." + (test-pearl--with-mapping '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE")) + (should (string-equal "TODO\\|IN-PROGRESS\\|DONE" + (pearl--get-todo-states-pattern))))) + +(ert-deftest test-pearl-get-todo-states-pattern-empty-mapping () + "An empty mapping yields an empty pattern string." + (test-pearl--with-mapping '() + (should (string-equal "" (pearl--get-todo-states-pattern))))) + +(ert-deftest test-pearl-get-todo-states-pattern-recomputes-after-mapping-change () + "The cached pattern is recomputed when the mapping changes mid-session. + +Regression for the stale-cache bug: a once-populated pattern must not +outlive a change to `pearl-state-to-todo-mapping'." + (test-pearl--with-mapping '(("Todo" . "TODO") ("Done" . "DONE")) + (should (string-equal "TODO\\|DONE" (pearl--get-todo-states-pattern))) + ;; Change the mapping after the pattern has been cached. + (setq pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "DOING") ("Done" . "DONE"))) + (should (string-equal "TODO\\|DOING\\|DONE" + (pearl--get-todo-states-pattern))))) + +;;; pearl--map-linear-priority-to-org + +(ert-deftest test-pearl-map-linear-priority-to-org-known-values () + "Linear priorities 1-4 map to org cookies A-D." + (should (string-equal "[#A]" (pearl--map-linear-priority-to-org 1))) + (should (string-equal "[#B]" (pearl--map-linear-priority-to-org 2))) + (should (string-equal "[#C]" (pearl--map-linear-priority-to-org 3))) + (should (string-equal "[#D]" (pearl--map-linear-priority-to-org 4)))) + +(ert-deftest test-pearl-map-linear-priority-to-org-zero-defaults-c () + "Priority 0 (No priority) falls back to [#C]." + (should (string-equal "[#C]" (pearl--map-linear-priority-to-org 0)))) + +(ert-deftest test-pearl-map-linear-priority-to-org-nil-and-unknown-default-c () + "A nil or out-of-range priority falls back to [#C]." + (should (string-equal "[#C]" (pearl--map-linear-priority-to-org nil))) + (should (string-equal "[#C]" (pearl--map-linear-priority-to-org 99)))) + +;;; pearl--get-linear-priority-name + +(ert-deftest test-pearl-get-linear-priority-name-known-values () + "Linear priorities 1-4 have readable names." + (should (string-equal "Urgent" (pearl--get-linear-priority-name 1))) + (should (string-equal "High" (pearl--get-linear-priority-name 2))) + (should (string-equal "Medium" (pearl--get-linear-priority-name 3))) + (should (string-equal "Low" (pearl--get-linear-priority-name 4)))) + +(ert-deftest test-pearl-get-linear-priority-name-nil-and-unknown-default-medium () + "A nil, zero, or out-of-range priority falls back to Medium." + (should (string-equal "Medium" (pearl--get-linear-priority-name 0))) + (should (string-equal "Medium" (pearl--get-linear-priority-name nil))) + (should (string-equal "Medium" (pearl--get-linear-priority-name 99)))) + +;;; pearl-get-priorities + +(ert-deftest test-pearl-get-priorities-returns-fixed-alist () + "The priority list maps the five Linear priority names to their integers." + (let ((priorities (pearl-get-priorities))) + (should (equal 0 (cdr (assoc "No priority" priorities)))) + (should (equal 1 (cdr (assoc "Urgent" priorities)))) + (should (equal 2 (cdr (assoc "High" priorities)))) + (should (equal 3 (cdr (assoc "Medium" priorities)))) + (should (equal 4 (cdr (assoc "Low" priorities)))))) + +(provide 'test-pearl-mapping) +;;; test-pearl-mapping.el ends here diff --git a/tests/test-pearl-menu.el b/tests/test-pearl-menu.el new file mode 100644 index 0000000..1362b2e --- /dev/null +++ b/tests/test-pearl-menu.el @@ -0,0 +1,73 @@ +;;; test-pearl-menu.el --- Tests for the transient menu -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `pearl-menu', the transient dispatcher. The menu is +;; interactive UI, so these test the integration -- the prefix is a real +;; command, every suffix dispatches to a bound command, and the key bindings +;; don't collide -- rather than transient's own rendering behavior. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el" + (file-name-directory + (or load-file-name buffer-file-name)))) +(require 'transient) + +(defun test-pearl-menu--suffixes (node) + "Collect (KEY . COMMAND) pairs from a transient layout NODE. +Walks vectors and lists recursively; whenever it reaches a plist +\(a list whose car is a keyword) it reads :key and :command from it." + (cond + ((vectorp node) + (apply #'append (mapcar #'test-pearl-menu--suffixes + (append node nil)))) + ((and (consp node) (keywordp (car node))) + (let ((cmd (plist-get node :command)) + (key (plist-get node :key))) + (when cmd (list (cons key cmd))))) + ((consp node) + (apply #'append (mapcar #'test-pearl-menu--suffixes node))) + (t nil))) + +(defun test-pearl-menu--pairs () + "Return the (KEY . COMMAND) pairs declared in `pearl-menu'." + (test-pearl-menu--suffixes + (get 'pearl-menu 'transient--layout))) + +(ert-deftest test-pearl-menu-is-command () + "The dispatcher is defined and is an interactive command." + (should (fboundp 'pearl-menu)) + (should (commandp 'pearl-menu))) + +(ert-deftest test-pearl-menu-suffixes-dispatch-to-real-commands () + "Every suffix in the menu names a bound, interactive command. +This is the regression guard: rename or remove a command and the +menu entry that still points at it fails here." + (let ((pairs (test-pearl-menu--pairs))) + (should pairs) + (dolist (pair pairs) + (let ((cmd (cdr pair))) + (should (fboundp cmd)) + (should (commandp cmd)))))) + +(ert-deftest test-pearl-menu-keys-are-unique () + "No two suffixes share a key binding." + (let* ((pairs (test-pearl-menu--pairs)) + (keys (delq nil (mapcar #'car pairs)))) + (should (= (length keys) (length (delete-dups (copy-sequence keys))))))) + +(ert-deftest test-pearl-menu-covers-core-commands () + "A representative slice of the command surface is reachable from the menu." + (let ((cmds (mapcar #'cdr (test-pearl-menu--pairs)))) + (dolist (expected '(pearl-list-issues + pearl-run-view + pearl-run-saved-query + pearl-sync-current-issue + pearl-set-state + pearl-add-comment + pearl-new-issue + pearl-delete-current-issue)) + (should (memq expected cmds))))) + +(provide 'test-pearl-menu) +;;; test-pearl-menu.el ends here diff --git a/tests/test-pearl-merge.el b/tests/test-pearl-merge.el new file mode 100644 index 0000000..180539e --- /dev/null +++ b/tests/test-pearl-merge.el @@ -0,0 +1,252 @@ +;;; test-pearl-merge.el --- Tests for merge-by-LINEAR-ID refresh -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the same-source refresh merge: `pearl--merge-issues-into-buffer' +;; updates existing issue subtrees in place by LINEAR-ID, appends new matches, +;; drops issues gone from the result, and protects unpushed local edits (it +;; neither overwrites nor drops a subtree whose body diverges from its stored +;; provenance hash). Also covers the header refresh and the `--merge-query-result' +;; render boundary that drives `pearl-refresh-current-view'. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl-merge--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defun test-pearl-merge--issue (id title desc) + "A normalized issue plist with ID, TITLE, and DESC for merge input." + (list :id id :identifier (concat "ENG-" id) :title title :description desc + :priority 2 :url (concat "https://linear.app/x/" id) + :updated-at "2026-05-23T03:00:00.000Z" + :state (list :id "s1" :name "Todo" :type "unstarted") + :team (list :id "t1" :key "ENG" :name "Engineering"))) + +(defun test-pearl-merge--raw (id title desc) + "A raw issue node (json-read shape) with ID, TITLE, and DESC." + `((id . ,id) (identifier . ,(concat "ENG-" id)) (title . ,title) + (description . ,desc) (priority . 2) (url . ,(concat "https://linear.app/x/" id)) + (updatedAt . "2026-05-23T03:00:00.000Z") + (state (id . "s1") (name . "Todo") (type . "unstarted")) + (team (id . "t1") (key . "ENG") (name . "Engineering")) + (labels (nodes . [])))) + +(defun test-pearl-merge--buffer (&rest issues) + "A header plus the formatted ISSUES, as the active file would hold them." + (concat "#+title: Linear — My open issues\n" + "#+LINEAR-SOURCE: (:type filter :name \"My open issues\" :filter (:assignee :me))\n" + "#+LINEAR-RUN-AT: 2026-05-01 09:00\n" + "#+LINEAR-COUNT: 9\n" + "#+LINEAR-TRUNCATED: no\n\n" + (mapconcat #'pearl--format-issue-as-org-entry issues ""))) + +;;; --merge-issues-into-buffer + +(ert-deftest test-pearl-merge-updates-existing-in-place () + "An existing issue still in the result is re-rendered from the fetch in place." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta.")) + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha Renamed" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta."))))) + (should (= 2 (plist-get counts :updated))) + (should (= 0 (plist-get counts :added))) + (should (= 0 (plist-get counts :dropped))) + (should (= 0 (plist-get counts :skipped))) + (goto-char (point-min)) + (should (re-search-forward "Alpha Renamed" nil t)) + (should-not (save-excursion (re-search-forward "^\\*\\*\\* .*Alpha$" nil t))) + ;; Alpha still precedes Beta — order is stable. + (goto-char (point-min)) + (let ((a (progn (re-search-forward "Alpha Renamed") (point))) + (b (progn (re-search-forward "Beta") (point)))) + (should (< a b)))))) + +(ert-deftest test-pearl-merge-appends-new-issue () + "An issue new to the result is appended after the existing ones." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")) + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta."))))) + (should (= 1 (plist-get counts :added))) + (goto-char (point-min)) + (should (string= "a" (progn (re-search-forward "LINEAR-ID: *\\(.*\\)$") (match-string 1)))) + (should (re-search-forward "LINEAR-ID: *b" nil t)) + (goto-char (point-min)) + (should (< (progn (re-search-forward "Alpha") (point)) + (progn (re-search-forward "Beta") (point))))))) + +(ert-deftest test-pearl-merge-drops-absent-issue () + "A clean issue no longer in the result is dropped." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta.")) + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))))) + (should (= 1 (plist-get counts :dropped))) + (goto-char (point-min)) + (should (re-search-forward "Alpha" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "Beta" nil t))))) + +(ert-deftest test-pearl-merge-keeps-unpushed-edit-on-update () + "An existing subtree with unpushed body edits is kept, not overwritten." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")) + ;; Dirty the body so its hash no longer matches the stored provenance. + (goto-char (point-min)) + (re-search-forward "Desc Alpha\\.") + (end-of-line) + (insert " UNPUSHED EDIT") + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha Renamed" "Remote desc."))))) + (should (= 1 (plist-get counts :skipped))) + (should (= 0 (plist-get counts :updated))) + (goto-char (point-min)) + ;; Local edit and old heading survive; the remote rename did not land. + (should (re-search-forward "UNPUSHED EDIT" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "Alpha Renamed" nil t))))) + +(ert-deftest test-pearl-merge-keeps-dirty-issue-absent-from-result () + "A dirty issue gone from the result is kept rather than dropped (no data loss)." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta.")) + (goto-char (point-min)) + (re-search-forward "Desc Alpha\\.") + (end-of-line) + (insert " UNPUSHED EDIT") + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "b" "Beta" "Desc Beta."))))) + (should (= 1 (plist-get counts :skipped))) + (should (= 0 (plist-get counts :dropped))) + (goto-char (point-min)) + (should (re-search-forward "UNPUSHED EDIT" nil t))))) + +(ert-deftest test-pearl-merge-updates-rich-description-issue-in-place () + "An unedited issue with lossy markdown (a heading) is updated, not skipped. +Regression: the dirty check round-tripped Org back to markdown and mistook a +lossy round-trip (# heading -> bold, *italic* -> **bold**) for a local edit, so +refresh silently skipped every rich-text issue." + (test-pearl-merge--in-org + (test-pearl-merge--buffer + (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text.")) + (let ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha Renamed" + "# Heading\n\nSome body text."))))) + (should (= 1 (plist-get counts :updated))) + (should (= 0 (plist-get counts :skipped))) + (goto-char (point-min)) + (should (re-search-forward "Alpha Renamed" nil t))))) + +(ert-deftest test-pearl-subtree-dirty-p-rich-description-unedited-not-dirty () + "A freshly rendered subtree with lossy-markdown description is not dirty unedited." + (test-pearl-merge--in-org + (test-pearl-merge--buffer + (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text.")) + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + (beginning-of-line) + (should-not (pearl--subtree-dirty-p)))) + +(ert-deftest test-pearl-subtree-dirty-p-empty-description-not-dirty () + "An issue with an empty description is not dirty. +Regression: body extraction overshot an empty body into the next issue's +subtree, so every description-less issue read as a local edit." + (test-pearl-merge--in-org + (test-pearl-merge--buffer + (test-pearl-merge--issue "a" "Alpha" "") + (test-pearl-merge--issue "b" "Beta" "Desc Beta.")) + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + (beginning-of-line) + (should (string= "" (pearl--issue-body-at-point))) + (should-not (pearl--subtree-dirty-p)))) + +(ert-deftest test-pearl-subtree-dirty-p-edited-body-is-dirty () + "Editing the rendered body still marks the subtree dirty (edit detection holds)." + (test-pearl-merge--in-org + (test-pearl-merge--buffer + (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text.")) + (goto-char (point-min)) + (re-search-forward "Some body text\\.") + (end-of-line) + (insert " LOCAL EDIT") + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + (beginning-of-line) + (should (pearl--subtree-dirty-p)))) + +;;; --update-source-header + +(ert-deftest test-pearl-merge-update-source-header-rewrites-count () + "The header refresh updates the count and truncation lines in place." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")) + (pearl--update-source-header 5 t) + (goto-char (point-min)) + (should (re-search-forward "^#\\+LINEAR-COUNT: 5$" nil t)) + (goto-char (point-min)) + (should (re-search-forward "^#\\+LINEAR-TRUNCATED: yes$" nil t)))) + +;;; --merge-query-result (render boundary) + +(ert-deftest test-pearl-merge-query-result-merges-and-updates-header () + "An ok result normalizes its raw nodes, merges them, and refreshes the count." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")) + (let ((source '(:type filter :name "My open issues" :filter (:assignee :me))) + (result (pearl--make-query-result + 'ok :issues (list (test-pearl-merge--raw "a" "Alpha Renamed" "Desc Alpha.") + (test-pearl-merge--raw "c" "Gamma" "Desc Gamma."))))) + (pearl--merge-query-result result source) + (goto-char (point-min)) + (should (re-search-forward "Alpha Renamed" nil t)) + (should (re-search-forward "Gamma" nil t)) + (goto-char (point-min)) + (should (re-search-forward "^#\\+LINEAR-COUNT: 2$" nil t))))) + +(ert-deftest test-pearl-merge-query-result-empty-leaves-buffer () + "An empty result leaves the buffer unchanged rather than dropping everything." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")) + (let ((source '(:type filter :name "My open issues" :filter (:assignee :me))) + (before (buffer-string))) + (pearl--merge-query-result (pearl--make-query-result 'empty) source) + (should (string= before (buffer-string)))))) + +(provide 'test-pearl-merge) +;;; test-pearl-merge.el ends here diff --git a/tests/test-pearl-normalize.el b/tests/test-pearl-normalize.el new file mode 100644 index 0000000..78874ab --- /dev/null +++ b/tests/test-pearl-normalize.el @@ -0,0 +1,138 @@ +;;; test-pearl-normalize.el --- Tests for API model normalization -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the normalizers that flatten raw json-read Linear responses into +;; internal plists. Driven by the shared fixtures so the renderer-facing +;; contract is locked: vectors become lists, absent/`:json-false' fields become +;; nil, and a null comment author falls back to the bot/external actor. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-fixtures (expand-file-name "testutil-fixtures.el")) + +;;; node-list + +(ert-deftest test-pearl-normalize-node-list-vector-to-list () + "A connection's nodes vector is returned as a list." + (should (equal '(1 2 3) (pearl--node-list '((nodes . [1 2 3])))))) + +(ert-deftest test-pearl-normalize-node-list-empty-and-missing () + "An empty or missing nodes connection yields an empty list." + (should (null (pearl--node-list '((nodes . []))))) + (should (null (pearl--node-list '((pageInfo . nil)))))) + +;;; normalize-issue -- fully populated + +(ert-deftest test-pearl-normalize-issue-full () + "A full issue normalizes every field, flattening nested objects." + (let ((i (pearl--normalize-issue (testutil-linear-fixture-issue-full)))) + (should (string= "ENG-42" (plist-get i :identifier))) + (should (string= "Fix the thing" (plist-get i :title))) + (should (= 2 (plist-get i :priority))) + (should (string= "In Progress" (plist-get (plist-get i :state) :name))) + (should (string= "started" (plist-get (plist-get i :state) :type))) + (should (string= "Craig" (plist-get (plist-get i :assignee) :name))) + (should (string= "ENG" (plist-get (plist-get i :team) :key))) + (should (string= "Platform" (plist-get (plist-get i :project) :name))) + (should (string= "Cycle 12" (plist-get (plist-get i :cycle) :name))) + ;; labels: vector of nodes -> list of (:id :name) plists + (should (equal '("bug" "backend") + (mapcar (lambda (l) (plist-get l :name)) (plist-get i :labels)))))) + +;;; normalize-issue -- null / missing optional fields + +(ert-deftest test-pearl-normalize-issue-null-fields () + "Absent or null optional fields normalize to nil, not an error." + (let ((i (pearl--normalize-issue (testutil-linear-fixture-issue-null-fields)))) + (should (string= "ENG-7" (plist-get i :identifier))) + (should (null (plist-get i :description))) + (should (null (plist-get i :assignee))) + (should (null (plist-get i :project))) + (should (null (plist-get i :cycle))) + (should (null (plist-get i :labels))) + ;; state is still present + (should (string= "Todo" (plist-get (plist-get i :state) :name))))) + +(ert-deftest test-pearl-normalize-issue-nil-input () + "Normalizing nil yields nil." + (should (null (pearl--normalize-issue nil)))) + +(ert-deftest test-pearl-normalize-issue-omits-comments-when-absent () + "An issue fetched without comments has a nil :comments, not an empty list." + (let ((i (pearl--normalize-issue (testutil-linear-fixture-issue-full)))) + (should (null (plist-get i :comments))))) + +;;; normalize-comment -- author fallback + +(ert-deftest test-pearl-normalize-comment-user-author () + "A comment with a user takes the user's name as author." + (let* ((raw (car (pearl--node-list + (cdr (assoc 'comments (testutil-linear-fixture-issue-with-comments)))))) + (c (pearl--normalize-comment raw))) + (should (string= "Alice" (plist-get c :author))) + (should (string= "First comment" (plist-get c :body))))) + +(ert-deftest test-pearl-normalize-comment-null-user-falls-back-to-bot () + "A comment with a null user falls back to the bot actor's name. + +`Comment.user' is null for integration/bot comments, so the renderer must not +assume a user is present." + (let ((c (pearl--normalize-comment + '((id . "cm-bot") (body . "Deployed") (createdAt . "2026-05-20T00:00:00Z") + (user) (botActor . ((name . "GitHub"))))))) + (should (string= "GitHub" (plist-get c :author))))) + +(ert-deftest test-pearl-normalize-comment-null-user-no-actor-nil () + "A null user with no bot or external actor leaves :author nil. +The renderer is responsible for showing a placeholder; the normalizer reports +the absence honestly rather than inventing a name." + (let ((c (pearl--normalize-comment '((id . "cm-x") (body . "x") (user))))) + (should (null (plist-get c :author))))) + +(ert-deftest test-pearl-normalize-comment-bot-without-name-default () + "A bot actor with no name falls back to the literal \"automation\"." + (let ((c (pearl--normalize-comment + '((id . "cm-b") (body . "x") (user) (botActor . ((id . "b1"))))))) + (should (string= "automation" (plist-get c :author))))) + +;;; normalize-custom-view + +(ert-deftest test-pearl-normalize-custom-view-personal () + "A personal (shared=false) workspace-wide view: :shared nil, :team nil." + (let* ((views (cdr (assoc 'nodes (assoc 'customViews + (assoc 'data (testutil-linear-fixture-custom-views)))))) + (cv (pearl--normalize-custom-view (elt views 0)))) + (should (string= "My open work" (plist-get cv :name))) + (should (null (plist-get cv :shared))) + (should (null (plist-get cv :team))) + (should (string= "Craig" (plist-get (plist-get cv :owner) :name))))) + +(ert-deftest test-pearl-normalize-custom-view-shared-with-team () + "A shared team view: :shared t and a normalized :team plist." + (let* ((views (cdr (assoc 'nodes (assoc 'customViews + (assoc 'data (testutil-linear-fixture-custom-views)))))) + (cv (pearl--normalize-custom-view (elt views 1)))) + (should (eq t (plist-get cv :shared))) + (should (string= "ENG" (plist-get (plist-get cv :team) :key))))) + +(provide 'test-pearl-normalize) +;;; test-pearl-normalize.el ends here diff --git a/tests/test-pearl-open.el b/tests/test-pearl-open.el new file mode 100644 index 0000000..1be6114 --- /dev/null +++ b/tests/test-pearl-open.el @@ -0,0 +1,66 @@ +;;; test-pearl-open.el --- Tests for open-issue-in-browser -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl-open-current-issue', which opens the issue at point +;; in the browser from its LINEAR-URL property. `browse-url' is stubbed. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT at point-min." + (declare (indent 1)) + `(with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body)) + +(ert-deftest test-pearl-open-current-issue-visits-url () + "The command passes the heading's LINEAR-URL to `browse-url'." + (let ((visited nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-URL: https://linear.app/x/ENG-1\n:END:\nbody\n" + (cl-letf (((symbol-function 'browse-url) + (lambda (url &rest _) (setq visited url)))) + (goto-char (point-max)) + (pearl-open-current-issue) + (should (string= "https://linear.app/x/ENG-1" visited)))))) + +(ert-deftest test-pearl-open-current-issue-no-url-errors () + "An issue heading without a LINEAR-URL signals a user error, no browse." + (let ((visited nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (cl-letf (((symbol-function 'browse-url) + (lambda (url &rest _) (setq visited url)))) + (should-error (pearl-open-current-issue) :type 'user-error) + (should-not visited))))) + +(ert-deftest test-pearl-open-current-issue-not-on-issue-errors () + "Running outside a heading signals a user error." + (test-pearl--in-org "plain text, no heading\n" + (should-error (pearl-open-current-issue) :type 'user-error))) + +(provide 'test-pearl-open) +;;; test-pearl-open.el ends here diff --git a/tests/test-pearl-org-parse.el b/tests/test-pearl-org-parse.el new file mode 100644 index 0000000..87f4a02 --- /dev/null +++ b/tests/test-pearl-org-parse.el @@ -0,0 +1,152 @@ +;;; test-pearl-org-parse.el --- Tests for pearl org parsing -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the org readers `pearl--extract-org-heading-properties' and +;; `pearl--process-heading-at-point'. The reader uses org APIs over the +;; LINEAR-* property drawer, so it works from anywhere in the entry, at any +;; heading depth, and is unbothered by body text or nested sub-entries. The one +;; network boundary reached during processing (`--update-issue-state-async') is +;; stubbed. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + ;; Declare the Linear keywords so `org-get-todo-state' recognizes them, the + ;; way the generated file's `#+TODO:' line does in real use. + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (pearl-todo-states-pattern nil) + (pearl--todo-states-pattern-source nil) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; extract-org-heading-properties + +(ert-deftest test-pearl-extract-heading-properties-full () + "A complete Linear entry yields the todo keyword, ids, and team id." + (test-pearl--in-org + "*** TODO My issue\n:PROPERTIES:\n:LINEAR-ID: abc-123\n:LINEAR-IDENTIFIER: ENG-5\n:LINEAR-TEAM-ID: team-9\n:END:\n" + (re-search-forward "My issue") + (let ((props (pearl--extract-org-heading-properties))) + (should (string-equal "TODO" (plist-get props :todo-state))) + (should (string-equal "abc-123" (plist-get props :issue-id))) + (should (string-equal "ENG-5" (plist-get props :issue-identifier))) + (should (string-equal "team-9" (plist-get props :team-id)))))) + +(ert-deftest test-pearl-extract-reads-from-inside-the-entry () + "The reader works with point in the body, not only on the heading line." + (test-pearl--in-org + "*** TODO My issue\n:PROPERTIES:\n:LINEAR-ID: abc\n:END:\nsome body text here\n" + (goto-char (point-max)) + (should (string-equal "abc" (plist-get (pearl--extract-org-heading-properties) :issue-id))))) + +(ert-deftest test-pearl-extract-team-id-is-read-not-looked-up () + "The team id comes straight from LINEAR-TEAM-ID, with no network call." + (cl-letf (((symbol-function 'pearl--get-team-id-by-name) + (lambda (&rest _) (error "should not be called")))) + (test-pearl--in-org + "*** TODO x\n:PROPERTIES:\n:LINEAR-ID: i\n:LINEAR-TEAM-ID: t-1\n:END:\n" + (re-search-forward "x") + (should (string-equal "t-1" (plist-get (pearl--extract-org-heading-properties) :team-id)))))) + +(ert-deftest test-pearl-extract-missing-id () + "A drawer with no LINEAR-ID yields a nil issue-id." + (test-pearl--in-org + "*** TODO x\n:PROPERTIES:\n:LINEAR-IDENTIFIER: ENG-9\n:END:\n" + (re-search-forward "x") + (let ((props (pearl--extract-org-heading-properties))) + (should (string-equal "TODO" (plist-get props :todo-state))) + (should (null (plist-get props :issue-id))) + (should (string-equal "ENG-9" (plist-get props :issue-identifier)))))) + +(ert-deftest test-pearl-extract-deeper-heading-now-supported () + "A level-4 entry is read the same as level-3 (the reader is depth-agnostic)." + (test-pearl--in-org + "*** TODO parent\n**** TODO child\n:PROPERTIES:\n:LINEAR-ID: c\n:END:\n" + (re-search-forward "child") + (should (string-equal "c" (plist-get (pearl--extract-org-heading-properties) :issue-id))))) + +(ert-deftest test-pearl-extract-off-heading-nil () + "Before the first heading, nothing is extracted." + (test-pearl--in-org + "preamble line\n* Top\n" + (goto-char (point-min)) + (should (null (pearl--extract-org-heading-properties))))) + +;;; process-heading-at-point + +(ert-deftest test-pearl-process-heading-updates-when-complete () + "A complete entry triggers an async state update with the mapped state." + (let ((captured nil)) + (cl-letf (((symbol-function 'pearl--update-issue-state-async) + (lambda (id state team) (setq captured (list id state team))))) + (test-pearl--in-org + "*** IN-PROGRESS x\n:PROPERTIES:\n:LINEAR-ID: i-1\n:LINEAR-IDENTIFIER: ENG-2\n:LINEAR-TEAM-ID: t-1\n:END:\n" + (re-search-forward "x") + (pearl--process-heading-at-point) + (should (equal '("i-1" "In Progress" "t-1") captured)))))) + +(ert-deftest test-pearl-process-heading-skips-without-team () + "An entry missing its team id makes no API call." + (let ((called nil)) + (cl-letf (((symbol-function 'pearl--update-issue-state-async) + (lambda (&rest _) (setq called t)))) + (test-pearl--in-org + "*** TODO x\n:PROPERTIES:\n:LINEAR-ID: i-1\n:LINEAR-IDENTIFIER: ENG-2\n:END:\n" + (re-search-forward "x") + (pearl--process-heading-at-point) + (should-not called))))) + +;;; render -> parse round trip + +(ert-deftest test-pearl-render-parse-round-trip () + "An issue rendered by build-org-content parses back through the reader. +Locks the render/parse contract: the LINEAR-* drawer the renderer writes is +exactly what the reader extracts, and the rendered keyword is recognized." + (let ((pearl-state-to-todo-mapping '(("In Progress" . "IN-PROGRESS"))) + (pearl-todo-states-pattern nil) + (pearl--todo-states-pattern-source nil) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (let ((content (pearl--build-org-content + '((:id "i-1" :identifier "ENG-2" :title "round trip" + :priority 2 :state (:name "In Progress") :team (:id "t-1")))))) + (with-temp-buffer + (insert content) + (org-mode) + (goto-char (point-min)) + (re-search-forward "round trip") + (let ((props (pearl--extract-org-heading-properties))) + (should (string-equal "i-1" (plist-get props :issue-id))) + (should (string-equal "ENG-2" (plist-get props :issue-identifier))) + (should (string-equal "IN-PROGRESS" (plist-get props :todo-state))) + (should (string-equal "t-1" (plist-get props :team-id)))))))) + +(provide 'test-pearl-org-parse) +;;; test-pearl-org-parse.el ends here diff --git a/tests/test-pearl-org-write.el b/tests/test-pearl-org-write.el new file mode 100644 index 0000000..c253190 --- /dev/null +++ b/tests/test-pearl-org-write.el @@ -0,0 +1,85 @@ +;;; test-pearl-org-write.el --- Tests for pearl org file write-back -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl--update-org-from-issues', the buffer-aware +;; write-back. Uses real temp files (file I/O is the behavior under test); +;; the three branches are no-buffer, clean-buffer, and dirty-buffer. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +(defvar test-pearl--sample-issues + '((:id "u" :identifier "ENG-1" :title "T" :priority 3 :state (:name "Todo"))) + "One normalized issue, enough to render a recognizable org entry.") + +(defmacro test-pearl--with-org-file (var &rest body) + "Bind VAR to a fresh temp .org path and run BODY, cleaning up after. +The state mapping is bound so rendering is deterministic." + (declare (indent 1)) + `(let* ((,var (make-temp-file "linear-test-" nil ".org")) + (pearl-org-file-path ,var) + (pearl-state-to-todo-mapping '(("Todo" . "TODO")))) + (unwind-protect + (progn ,@body) + (let ((b (find-buffer-visiting ,var))) + (when b + (with-current-buffer b (set-buffer-modified-p nil)) + (kill-buffer b))) + (when (file-exists-p ,var) (delete-file ,var))))) + +(ert-deftest test-pearl-update-org-no-buffer-writes-file () + "With no buffer visiting the file, issues are written to disk." + (test-pearl--with-org-file tmp + (let ((b (find-buffer-visiting tmp))) (when b (kill-buffer b))) + (pearl--update-org-from-issues test-pearl--sample-issues) + (let ((content (with-temp-buffer (insert-file-contents tmp) (buffer-string)))) + (should (string-match-p "#\\+title: Linear" content)) + (should (string-match-p "#\\+LINEAR-SOURCE: " content)) + (should (string-match-p "\\*\\* TODO \\[#C\\] T" content))))) + +(ert-deftest test-pearl-update-org-clean-buffer-replaces-contents () + "A clean visiting buffer is replaced in place and saved." + (test-pearl--with-org-file tmp + (let ((buf (find-file-noselect tmp))) + (with-current-buffer buf + (insert "old content") + (save-buffer)) + (pearl--update-org-from-issues test-pearl--sample-issues) + (with-current-buffer buf + (should-not (buffer-modified-p)) + (should (string-match-p "\\*\\* TODO \\[#C\\] T" (buffer-string))) + (should-not (string-match-p "old content" (buffer-string))))))) + +(ert-deftest test-pearl-update-org-dirty-buffer-not-overwritten () + "A buffer with unsaved edits is left untouched, not clobbered." + (test-pearl--with-org-file tmp + (let ((buf (find-file-noselect tmp))) + (with-current-buffer buf + (insert "unsaved edits")) + (pearl--update-org-from-issues test-pearl--sample-issues) + (with-current-buffer buf + (should (buffer-modified-p)) + (should (string-match-p "unsaved edits" (buffer-string))) + (should-not (string-match-p "ENG-1" (buffer-string))))))) + +(provide 'test-pearl-org-write) +;;; test-pearl-org-write.el ends here diff --git a/tests/test-pearl-output.el b/tests/test-pearl-output.el new file mode 100644 index 0000000..79b7a82 --- /dev/null +++ b/tests/test-pearl-output.el @@ -0,0 +1,145 @@ +;;; test-pearl-output.el --- Tests for the active-file output model -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the active-file output model: the filter summary, the +;; source-tracking header (with the affordance preamble) written by +;; `--build-org-content', reading the active source back from a buffer, and +;; `pearl-refresh-current-view' re-running the recorded source. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +;;; --summarize-filter + +(ert-deftest test-pearl-summarize-filter-fields () + "A filter plist summarizes its set dimensions in a readable string." + (let ((s (pearl--summarize-filter '(:assignee :me :open t :state "In Progress")))) + (should (string-match-p "assignee" s)) + (should (string-match-p "open" s)) + (should (string-match-p "In Progress" s)))) + +(ert-deftest test-pearl-summarize-filter-empty () + "An empty filter summarizes as all issues." + (should (string-match-p "all" (pearl--summarize-filter nil)))) + +;;; --build-org-content with a source + +(ert-deftest test-pearl-build-org-content-source-header () + "With a source, the header carries the title, serialized source, and count." + (let* ((source '(:type filter :name "My open issues" :filter (:assignee :me :open t))) + (out (pearl--build-org-content '() source))) + (should (string-match-p "^#\\+title: Linear — My open issues$" out)) + (should (string-match-p "^#\\+LINEAR-SOURCE: " out)) + (should (string-match-p "^#\\+LINEAR-COUNT: 0$" out)) + ;; affordance preamble is present as org comments, not content + (should (string-match-p "^# .*pearl-sync-current-issue" out)))) + +(ert-deftest test-pearl-build-org-content-source-roundtrips () + "The serialized source in the header reads back to the original plist." + (let* ((source '(:type filter :name "Bugs" :filter (:labels ("bug") :open t))) + (out (pearl--build-org-content '() source))) + (with-temp-buffer + (insert out) + (should (equal source (pearl--read-active-source)))))) + +(ert-deftest test-pearl-build-org-content-default-source-back-compat () + "Called with no source, the content still has a title and no entries." + (let ((out (pearl--build-org-content '()))) + (should (string-match-p "^#\\+title:" out)) + (should-not (string-match-p "^\\*\\*\\* " out)))) + +;;; --read-active-source + +(ert-deftest test-pearl-read-active-source-absent () + "A buffer with no source header reads back nil." + (with-temp-buffer + (insert "#+title: something\n\n* a heading\n") + (should-not (pearl--read-active-source)))) + +;;; refresh-current-view + +(ert-deftest test-pearl-refresh-current-view-reruns-source () + "Refresh reads the recorded filter source and merges the re-run result." + (let ((ran nil) (merged-source nil) + (source '(:type filter :name "My open issues" :filter (:assignee :me :open t)))) + (with-temp-buffer + (insert (format "#+title: Linear — My open issues\n#+LINEAR-SOURCE: %s\n\n" + (prin1-to-string source))) + (org-mode) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb) + (setq ran t) + (funcall cb (pearl--make-query-result 'ok :issues nil)))) + ((symbol-function 'pearl--merge-query-result) + (lambda (_result src) (setq merged-source src)))) + (pearl-refresh-current-view) + (should ran) + (should (equal source merged-source)))))) + +(ert-deftest test-pearl-refresh-current-view-no-source-errors () + "Refresh with no recorded source signals a user error." + (with-temp-buffer + (insert "#+title: plain\n") + (org-mode) + (should-error (pearl-refresh-current-view) :type 'user-error))) + +;;; --update-org-from-issues surfaces the result + +(ert-deftest test-pearl-update-org-surfaces-fresh-buffer () + "With no buffer visiting the file, the write creates one and surfaces it." + (let* ((tmp (make-temp-file "pearl-out" nil ".org")) + (pearl-org-file-path tmp) + (surfaced nil)) + (unwind-protect + (progn + (when (find-buffer-visiting tmp) (kill-buffer (find-buffer-visiting tmp))) + (cl-letf (((symbol-function 'pearl--surface-buffer) + (lambda (b) (setq surfaced b)))) + (pearl--update-org-from-issues '() '(:type filter :name "X" :filter nil) nil)) + (should (bufferp surfaced)) + (should (buffer-live-p surfaced)) + (should (string= (file-truename tmp) + (file-truename (buffer-file-name surfaced))))) + (when (find-buffer-visiting tmp) (kill-buffer (find-buffer-visiting tmp))) + (ignore-errors (delete-file tmp))))) + +(ert-deftest test-pearl-update-org-surfaces-existing-buffer () + "With a clean buffer visiting the file, the update surfaces that buffer." + (let* ((tmp (make-temp-file "pearl-out" nil ".org")) + (pearl-org-file-path tmp) + (surfaced nil) + (buf (find-file-noselect tmp))) + (unwind-protect + (progn + (with-current-buffer buf (set-buffer-modified-p nil)) + (cl-letf (((symbol-function 'pearl--surface-buffer) + (lambda (b) (setq surfaced b)))) + (pearl--update-org-from-issues '() '(:type filter :name "X" :filter nil) nil)) + (should (eq surfaced buf))) + (when (buffer-live-p buf) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmp))))) + +(provide 'test-pearl-output) +;;; test-pearl-output.el ends here diff --git a/tests/test-pearl-query.el b/tests/test-pearl-query.el new file mode 100644 index 0000000..87e48b9 --- /dev/null +++ b/tests/test-pearl-query.el @@ -0,0 +1,151 @@ +;;; test-pearl-query.el --- Tests for the general issue query -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl--query-issues-async' and the `--page-issues' pager, +;; with `--graphql-request-async' stubbed. Cover the query/variable +;; construction, pagination across pages, the page-cap truncation, and the +;; full set of result statuses (ok / empty / graphql-failed / request-failed). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defun test-lq--page (nodes has-next &optional cursor) + "Build a raw issues-page response with NODES, HAS-NEXT, and CURSOR." + `((data (issues (nodes . ,(vconcat nodes)) + (pageInfo (hasNextPage . ,(if has-next t :json-false)) + (endCursor . ,(or cursor "c"))))))) + +;;; construction + +(ert-deftest test-pearl-query-issues-construction () + "The query targets issues(filter:) and passes the filter + default orderBy." + (let (captured result) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (query variables success-fn _error-fn) + (setq captured (list query variables)) + (funcall success-fn (test-lq--page '(((id . "i1"))) nil))))) + (pearl--query-issues-async '(("assignee" ("isMe" ("eq" . t)))) + (lambda (r) (setq result r))) + (should (string-match-p "issues(filter:" (car captured))) + (should (equal '(("assignee" ("isMe" ("eq" . t)))) (cdr (assoc "filter" (cadr captured))))) + (should (string= "updatedAt" (cdr (assoc "orderBy" (cadr captured))))) + (should (= 100 (cdr (assoc "first" (cadr captured)))))))) + +(ert-deftest test-pearl-query-issues-no-filter-omits-variable () + "With a nil filter, the filter variable is omitted (no filter applied)." + (let (vars) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q variables success-fn _e) + (setq vars variables) + (funcall success-fn (test-lq--page '() nil))))) + (pearl--query-issues-async nil #'ignore) + (should-not (assoc "filter" vars))))) + +(ert-deftest test-pearl-query-issues-order-by-override () + "An explicit ORDER-BY overrides the updatedAt default." + (let (vars) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q variables success-fn _e) + (setq vars variables) + (funcall success-fn (test-lq--page '() nil))))) + (pearl--query-issues-async nil #'ignore 'createdAt) + (should (string= "createdAt" (cdr (assoc "orderBy" vars))))))) + +;;; result statuses + +(ert-deftest test-pearl-query-issues-single-page-ok () + "A single page with issues yields an ok result carrying the raw nodes." + (let (result) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q _v success-fn _e) + (funcall success-fn (test-lq--page '(((id . "i1")) ((id . "i2"))) nil))))) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (eq 'ok (pearl--query-result-status result))) + (should (= 2 (length (pearl--query-result-issues result)))) + (should-not (pearl--query-result-truncated-p result))))) + +(ert-deftest test-pearl-query-issues-empty () + "A page with no nodes yields an empty result, not a failure." + (let (result) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q _v success-fn _e) + (funcall success-fn (test-lq--page '() nil))))) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (eq 'empty (pearl--query-result-status result)))))) + +(ert-deftest test-pearl-query-issues-graphql-error () + "A GraphQL error response surfaces as a graphql-failed result." + (let (result) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q _v success-fn _e) + (funcall success-fn '((errors . (((message . "bad filter")))))))) ) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (eq 'graphql-failed (pearl--query-result-status result))) + (should (string= "bad filter" (pearl--query-result-message result)))))) + +(ert-deftest test-pearl-query-issues-transport-error () + "A transport failure (error callback) surfaces as request-failed." + (let (result) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q _v _success-fn error-fn) + (funcall error-fn "boom" nil nil)))) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (eq 'request-failed (pearl--query-result-status result)))))) + +;;; pagination + +(ert-deftest test-pearl-query-issues-paginates () + "Multiple pages accumulate; the cursor drives the next fetch." + (let ((result nil) (calls 0)) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q variables success-fn _e) + (setq calls (1+ calls)) + (if (assoc "after" variables) + (funcall success-fn (test-lq--page '(((id . "i2"))) nil)) + (funcall success-fn (test-lq--page '(((id . "i1"))) t "cur")))))) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (= 2 calls)) + (should (eq 'ok (pearl--query-result-status result))) + (should (= 2 (length (pearl--query-result-issues result))))))) + +(ert-deftest test-pearl-query-issues-cap-truncates () + "Hitting the page cap stops paging and marks the result truncated." + (let ((result nil) (calls 0) + (pearl-max-issue-pages 3)) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (_q _v success-fn _e) + (setq calls (1+ calls)) + (funcall success-fn (test-lq--page '(((id . "x"))) t "cur"))))) + (pearl--query-issues-async nil (lambda (r) (setq result r))) + (should (pearl--query-result-truncated-p result)) + (should (= 3 calls)) + (should (= 3 (length (pearl--query-result-issues result))))))) + +;;; the bulk query fetches comments so the list can render them + +(ert-deftest test-pearl-issues-query-requests-comments () + "The bulk issues query selects comments, so a populated list shows them." + (should (string-match-p "comments[[:space:]]*{[[:space:]]*nodes" pearl--issues-query))) + +(provide 'test-pearl-query) +;;; test-pearl-query.el ends here diff --git a/tests/test-pearl-refresh.el b/tests/test-pearl-refresh.el new file mode 100644 index 0000000..6b8ba7b --- /dev/null +++ b/tests/test-pearl-refresh.el @@ -0,0 +1,148 @@ +;;; test-pearl-refresh.el --- Tests for single-issue refresh -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl-refresh-current-issue' and its helpers: the single +;; issue fetch (stubbed at the HTTP boundary), the in-place subtree replace, +;; and the per-subtree conflict guard that refuses to clobber unpushed local +;; description edits. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defconst test-pearl--refresh-raw + '((id . "a") (identifier . "ENG-1") (title . "Refreshed Title") + (description . "New remote desc.") (priority . 2) + (url . "https://linear.app/x/ENG-1") (updatedAt . "2026-05-23T03:00:00.000Z") + (state (id . "s1") (name . "In Progress") (type . "started")) + (assignee (id . "u1") (name . "Craig") (displayName . "craig") (email . "c@x")) + (team (id . "t1") (key . "ENG") (name . "Engineering")) + (project (id . "p1") (name . "Proj")) + (labels (nodes . [((id . "l1") (name . "bug"))])) + (cycle (id . "c1") (number . 3) (name . "Cycle 3"))) + "A raw issue node as Linear would return it for a single-issue fetch.") + +(defun test-pearl--clean-entry () + "An issue entry whose empty body matches its stored hash (no local edit)." + (format "*** TODO [#B] Stale Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-IDENTIFIER: ENG-1\n:LINEAR-DESC-SHA256: %s\n:END:\n" + (secure-hash 'sha256 ""))) + +;;; --fetch-issue-async + +(ert-deftest test-pearl-fetch-issue-returns-raw-node () + "The single-issue fetch hands its callback the raw issue node." + (testutil-linear-with-response + `((data (issue . ,test-pearl--refresh-raw))) + (let (result) + (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) + (should (string= "Refreshed Title" (cdr (assoc 'title result))))))) + +(ert-deftest test-pearl-fetch-issue-missing-yields-missing () + "A successful response with a null issue node yields `:missing'." + (testutil-linear-with-response + '((data (issue . nil))) + (let ((result 'untouched)) + (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) + (should (eq :missing result))))) + +(ert-deftest test-pearl-fetch-issue-graphql-error-yields-error () + "A GraphQL error response yields `:error', distinct from a missing issue." + (testutil-linear-with-response + '((errors . [((message . "boom"))]) (data . nil)) + (let ((result 'untouched)) + (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) + (should (eq :error result))))) + +;;; refresh-current-issue + +(ert-deftest test-pearl-refresh-replaces-subtree-from-remote () + "A clean refresh rewrites the subtree from the fetched issue." + (test-pearl--in-org (test-pearl--clean-entry) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb test-pearl--refresh-raw)))) + (re-search-forward "Stale Title") + (pearl-refresh-current-issue) + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + ;; heading + drawer reflect the remote + (should (string-match-p "Refreshed Title" (thing-at-point 'line t))) + (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))) + ;; body is the remote description, and provenance matches it + (should (string= "New remote desc." (pearl--issue-body-at-point))) + (should (string= (secure-hash 'sha256 "New remote desc.") + (org-entry-get nil "LINEAR-DESC-SHA256")))))) + +(ert-deftest test-pearl-refresh-stashes-then-replaces-when-body-edited () + "An unpushed local edit is stashed before the refresh overwrites it (decision 4)." + (let ((kill-ring nil)) + (test-pearl--in-org + (format "*** TODO [#B] Stale Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: %s\n:END:\nLocal edit not yet pushed.\n" + (secure-hash 'sha256 "")) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb test-pearl--refresh-raw)))) + (pearl-refresh-current-issue) + ;; the unpushed edit was stashed before the overwrite, not lost + (should (string-match-p "Local edit not yet pushed\\." (current-kill 0))) + ;; and the refresh proceeded, replacing the subtree with the remote + (goto-char (point-min)) + (should (re-search-forward "Refreshed Title" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "Local edit not yet pushed\\." nil t)))))) + +(ert-deftest test-pearl-refresh-handles-fetch-error () + "A fetch error leaves the subtree untouched." + (test-pearl--in-org (test-pearl--clean-entry) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb :error)))) + (pearl-refresh-current-issue) + (goto-char (point-min)) + (should (re-search-forward "Stale Title" nil t))))) + +(ert-deftest test-pearl-refresh-handles-missing-issue () + "A missing issue leaves the subtree untouched." + (test-pearl--in-org (test-pearl--clean-entry) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb :missing)))) + (pearl-refresh-current-issue) + (goto-char (point-min)) + (should (re-search-forward "Stale Title" nil t))))) + +(ert-deftest test-pearl-refresh-not-on-issue-errors () + "Refreshing outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-refresh-current-issue) :type 'user-error))) + +(provide 'test-pearl-refresh) +;;; test-pearl-refresh.el ends here diff --git a/tests/test-pearl-resolve.el b/tests/test-pearl-resolve.el new file mode 100644 index 0000000..d8dda7d --- /dev/null +++ b/tests/test-pearl-resolve.el @@ -0,0 +1,141 @@ +;;; test-pearl-resolve.el --- Tests for name->id resolution helpers -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the per-team cached collection fetch (`--team-collection') and +;; the name->id resolver (`--resolve-team-id'), which back the field commands, +;; the ad-hoc filter, and saved queries. The HTTP boundary is stubbed; the +;; cache is reset around each test. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl--with-clean-caches (&rest body) + "Run BODY with the Linear caches reset and an API key set." + (declare (indent 0)) + `(let ((pearl-api-key "test-key") + (pearl--cache-team-collections nil) + (pearl--cache-states nil) + (pearl--cache-teams nil) + (pearl--cache-issues nil)) + ,@body)) + +(defmacro test-pearl--counting-request (data counter &rest body) + "Run BODY with `request' stubbed to succeed with DATA, counting calls in COUNTER." + (declare (indent 2)) + `(cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (cl-incf ,counter) + (let ((cb (plist-get args :success))) + (when cb (funcall cb :data ,data)))))) + ,@body)) + +;;; --team-collection + +(ert-deftest test-pearl-team-collection-fetches-and-caches () + "A collection is fetched once and served from cache on the second call." + (test-pearl--with-clean-caches + (let ((calls 0)) + (test-pearl--counting-request + '((data (team (projects (nodes . [((id . "p1") (name . "Foo")) + ((id . "p2") (name . "Bar"))]))))) calls + (let ((first (pearl--team-collection 'projects "team-1"))) + (should (= 2 (length first))) + (should (string= "p1" (cdr (assoc 'id (car first))))) + (pearl--team-collection 'projects "team-1") + (should (= 1 calls))))))) + +(ert-deftest test-pearl-team-collection-force-refetches () + "A force refresh bypasses the cache and fetches again." + (test-pearl--with-clean-caches + (let ((calls 0)) + (test-pearl--counting-request + '((data (team (labels (nodes . [((id . "l1") (name . "bug"))]))))) calls + (pearl--team-collection 'labels "team-1") + (pearl--team-collection 'labels "team-1" t) + (should (= 2 calls)))))) + +(ert-deftest test-pearl-team-collection-keyed-by-team () + "Different teams cache separately." + (test-pearl--with-clean-caches + (let ((calls 0)) + (test-pearl--counting-request + '((data (team (members (nodes . [((id . "u1") (name . "Craig"))]))))) calls + (pearl--team-collection 'members "team-1") + (pearl--team-collection 'members "team-2") + (should (= 2 calls)))))) + +;;; --resolve-team-id + +(ert-deftest test-pearl-resolve-unique-name () + "A name with one match resolves to that id." + (test-pearl--with-clean-caches + (cl-letf (((symbol-function 'pearl--team-collection) + (lambda (&rest _) '(((id . "p1") (name . "Foo")) + ((id . "p2") (name . "Bar")))))) + (should (string= "p1" (pearl--resolve-team-id 'projects "Foo" "team-1"))) + ;; case-insensitive + (should (string= "p2" (pearl--resolve-team-id 'projects "bar" "team-1")))))) + +(ert-deftest test-pearl-resolve-no-match-is-nil () + "A name with no match resolves to nil." + (test-pearl--with-clean-caches + (cl-letf (((symbol-function 'pearl--team-collection) + (lambda (&rest _) '(((id . "p1") (name . "Foo")))))) + (should-not (pearl--resolve-team-id 'projects "Missing" "team-1"))))) + +(ert-deftest test-pearl-resolve-member-by-display-name-or-email () + "Members match on name, displayName, or email." + (test-pearl--with-clean-caches + (cl-letf (((symbol-function 'pearl--team-collection) + (lambda (&rest _) + '(((id . "u1") (name . "Craig Jennings") (displayName . "cj") + (email . "c@x.com")))))) + (should (string= "u1" (pearl--resolve-team-id 'members "cj" "team-1"))) + (should (string= "u1" (pearl--resolve-team-id 'members "c@x.com" "team-1")))))) + +(ert-deftest test-pearl-resolve-ambiguous-prompts () + "When several nodes share a name, the resolver prompts and returns the choice." + (test-pearl--with-clean-caches + (cl-letf (((symbol-function 'pearl--team-collection) + (lambda (&rest _) '(((id . "u1") (name . "Alex") (displayName . "alex-a")) + ((id . "u2") (name . "Alex") (displayName . "alex-b"))))) + ((symbol-function 'completing-read) + (lambda (_prompt collection &rest _) + ;; pick the entry whose id is u2 + (car (rassoc "u2" collection))))) + (should (string= "u2" (pearl--resolve-team-id 'members "Alex" "team-1")))))) + +;;; clear-cache + +(ert-deftest test-pearl-clear-cache-resets () + "Clearing the cache empties the collection and per-team caches." + (let ((pearl--cache-team-collections '(((projects . "t") . x))) + (pearl--cache-states '(("t" . y))) + (pearl--cache-teams '(z))) + (pearl-clear-cache) + (should-not pearl--cache-team-collections) + (should-not pearl--cache-states) + (should-not pearl--cache-teams))) + +(provide 'test-pearl-resolve) +;;; test-pearl-resolve.el ends here diff --git a/tests/test-pearl-result.el b/tests/test-pearl-result.el new file mode 100644 index 0000000..606c3b0 --- /dev/null +++ b/tests/test-pearl-result.el @@ -0,0 +1,98 @@ +;;; test-pearl-result.el --- Tests for the query result shape -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the tagged query-result shape and `--classify-response': the five +;; statuses (ok / empty / invalid-filter / request-failed / graphql-failed), +;; the ok/error predicates, the GraphQL error-message extraction (vector and +;; list forms), and the truncated flag. All pure -- no network. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;;; classify-response + +(ert-deftest test-pearl-result-classify-nil-is-request-failed () + "A nil response is a transport failure." + (let ((r (pearl--classify-response nil))) + (should (eq 'request-failed (pearl--query-result-status r))) + (should (pearl--query-result-error-p r)) + (should (stringp (pearl--query-result-message r))))) + +(ert-deftest test-pearl-result-classify-errors-is-graphql-failed () + "A response carrying errors is a GraphQL failure with the message extracted." + (let ((r (pearl--classify-response '((errors . (((message . "bad filter")))))))) + (should (eq 'graphql-failed (pearl--query-result-status r))) + (should (string= "bad filter" (pearl--query-result-message r))))) + +(ert-deftest test-pearl-result-classify-errors-vector-form () + "Errors as a vector (the live API shape) still yield the first message." + (let ((r (pearl--classify-response '((errors . [((message . "nope"))]))))) + (should (eq 'graphql-failed (pearl--query-result-status r))) + (should (string= "nope" (pearl--query-result-message r))))) + +(ert-deftest test-pearl-result-classify-data-with-issues-is-ok () + "A data response with issues is ok and carries the issues." + (let ((r (pearl--classify-response '((data (issues))) '(i1 i2)))) + (should (eq 'ok (pearl--query-result-status r))) + (should (pearl--query-result-ok-p r)) + (should (equal '(i1 i2) (pearl--query-result-issues r))))) + +(ert-deftest test-pearl-result-classify-data-without-issues-is-empty () + "A data response with no issues is empty, not a failure." + (let ((r (pearl--classify-response '((data (issues))) '()))) + (should (eq 'empty (pearl--query-result-status r))) + (should (pearl--query-result-ok-p r)) + (should-not (pearl--query-result-error-p r)))) + +(ert-deftest test-pearl-result-classify-no-data-no-errors-is-request-failed () + "A response with neither data nor errors is treated as malformed/transport." + (let ((r (pearl--classify-response '((extensions . nil))))) + (should (eq 'request-failed (pearl--query-result-status r))))) + +(ert-deftest test-pearl-result-classify-carries-truncated-flag () + "The truncated flag is carried through on a successful result." + (let ((r (pearl--classify-response '((data (issues))) '(i1) t))) + (should (pearl--query-result-truncated-p r)))) + +(ert-deftest test-pearl-result-classify-ok-not-truncated-by-default () + "Without the truncated argument the flag is nil." + (let ((r (pearl--classify-response '((data (issues))) '(i1)))) + (should-not (pearl--query-result-truncated-p r)))) + +;;; invalid-filter + +(ert-deftest test-pearl-result-invalid-filter () + "An invalid-filter result is an error carrying its message." + (let ((r (pearl--invalid-filter-result "bad :priority"))) + (should (eq 'invalid-filter (pearl--query-result-status r))) + (should (pearl--query-result-error-p r)) + (should-not (pearl--query-result-ok-p r)) + (should (string= "bad :priority" (pearl--query-result-message r))))) + +;;; error-message extraction + +(ert-deftest test-pearl-result-graphql-error-message-nil-when-absent () + "With no errors key, the error-message extractor returns nil." + (should (null (pearl--graphql-error-message '((data (issues))))))) + +(provide 'test-pearl-result) +;;; test-pearl-result.el ends here diff --git a/tests/test-pearl-saved.el b/tests/test-pearl-saved.el new file mode 100644 index 0000000..63a3f8c --- /dev/null +++ b/tests/test-pearl-saved.el @@ -0,0 +1,112 @@ +;;; test-pearl-saved.el --- Tests for saved queries + sort -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for local saved queries and the sort layer: the client-side +;; `--sort-issues', the sort->orderBy mapping, and `pearl-run-saved-query' +;; threading the filter, source, and order through. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +;;; --sort-issues + +(defconst test-pearl--sort-sample + '((:title "banana" :priority 2 :updated-at "2026-05-23T10:00:00.000Z") + (:title "apple" :priority 1 :updated-at "2026-05-23T12:00:00.000Z") + (:title "cherry" :priority 3 :updated-at "2026-05-23T08:00:00.000Z")) + "Three issues for exercising the client-side sort.") + +(ert-deftest test-pearl-sort-issues-nil-sort-unchanged () + "With no sort key, the issues are returned in their original order." + (should (equal test-pearl--sort-sample + (pearl--sort-issues test-pearl--sort-sample nil nil)))) + +(ert-deftest test-pearl-sort-issues-title-asc () + "Sorting by title ascending orders alphabetically." + (let ((out (pearl--sort-issues test-pearl--sort-sample 'title 'asc))) + (should (equal '("apple" "banana" "cherry") + (mapcar (lambda (i) (plist-get i :title)) out))))) + +(ert-deftest test-pearl-sort-issues-updated-desc-default () + "Sorting by updated, descending, puts the most recent first." + (let ((out (pearl--sort-issues test-pearl--sort-sample 'updated 'desc))) + (should (string= "apple" (plist-get (car out) :title))) + (should (string= "cherry" (plist-get (car (last out)) :title))))) + +(ert-deftest test-pearl-sort-issues-priority-asc () + "Sorting by priority ascending orders by the numeric value." + (let ((out (pearl--sort-issues test-pearl--sort-sample 'priority 'asc))) + (should (equal '(1 2 3) (mapcar (lambda (i) (plist-get i :priority)) out))))) + +;;; --sort->order-by + +(ert-deftest test-pearl-sort-to-order-by () + "Updated/created map to the server orderBy; everything else defaults to updatedAt." + (should (eq 'updatedAt (pearl--sort->order-by 'updated))) + (should (eq 'createdAt (pearl--sort->order-by 'created))) + (should (eq 'updatedAt (pearl--sort->order-by 'title)))) + +;;; run-saved-query + +(ert-deftest test-pearl-run-saved-query-threads-filter-and-source () + "Running a saved query compiles its filter and renders with a sorted source." + (let ((pearl-saved-queries + '(("My bugs" :filter (:labels ("bug") :open t) :sort priority :order asc))) + (built nil) (rendered-source nil) (order nil)) + (cl-letf (((symbol-function 'pearl--build-issue-filter) + (lambda (plist) (setq built plist) '((compiled . t)))) + ((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional ord) (setq order ord) + (funcall cb (pearl--make-query-result 'ok :issues nil)))) + ((symbol-function 'pearl--render-query-result) + (lambda (_result source) (setq rendered-source source)))) + (pearl-run-saved-query "My bugs") + (should (equal '(:labels ("bug") :open t) built)) + (should (eq 'priority (plist-get rendered-source :sort))) + (should (eq 'asc (plist-get rendered-source :order))) + (should (eq 'filter (plist-get rendered-source :type))) + (should (eq 'updatedAt order))))) + +(ert-deftest test-pearl-run-saved-query-unknown-errors () + "An unknown saved-query name signals a user error." + (let ((pearl-saved-queries '(("Known" :filter (:open t))))) + (should-error (pearl-run-saved-query "Missing") :type 'user-error))) + +;;; render applies the source sort + +(ert-deftest test-pearl-render-query-result-sorts-by-source () + "The render boundary sorts issues by the source's sort/order before writing." + (let ((written nil) + (source '(:type filter :name "By title" :filter nil :sort title :order asc))) + (cl-letf (((symbol-function 'pearl--normalize-issue) #'identity) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (issues &optional _s _t) (setq written issues)))) + (pearl--render-query-result + (pearl--make-query-result + 'ok :issues '((:title "banana") (:title "apple"))) + source) + (should (equal '("apple" "banana") + (mapcar (lambda (i) (plist-get i :title)) written)))))) + +(provide 'test-pearl-saved) +;;; test-pearl-saved.el ends here diff --git a/tests/test-pearl-smoke.el b/tests/test-pearl-smoke.el new file mode 100644 index 0000000..53c4d06 --- /dev/null +++ b/tests/test-pearl-smoke.el @@ -0,0 +1,37 @@ +;;; test-pearl-smoke.el --- Harness smoke test for pearl -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Plumbing-proof smoke test: confirms the harness loads the package and +;; defines its public commands. Behavior coverage lives in the per-area +;; test files (test-pearl-mapping.el, -format.el, ...). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +(ert-deftest test-pearl-smoke-feature-loaded () + "The package source loads and defines its public commands." + (should (featurep 'pearl)) + (should (fboundp 'pearl-list-issues)) + (should (fboundp 'pearl-new-issue))) + +(provide 'test-pearl-smoke) +;;; test-pearl-smoke.el ends here diff --git a/tests/test-pearl-states.el b/tests/test-pearl-states.el new file mode 100644 index 0000000..713cb78 --- /dev/null +++ b/tests/test-pearl-states.el @@ -0,0 +1,134 @@ +;;; test-pearl-states.el --- Tests for pearl state management -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for workflow-state fetching, state name -> id resolution, and the +;; two state-update entry points. Covers the guard that skips the mutation +;; when the state name doesn't resolve, so no request fires with a null id. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +;;; pearl-get-states-async + +(ert-deftest test-pearl-get-states-async-parses-nodes () + "Workflow states are unwrapped and passed to the callback." + (let ((got nil)) + (testutil-linear-with-response + '((data (team (states (nodes . (((id . "s1") (name . "Todo")) + ((id . "s2") (name . "Done")))))))) + (pearl-get-states-async "team-1" (lambda (states) (setq got states)))) + (should (= 2 (length got))) + (should (string-equal "s1" (cdr (assoc 'id (car got))))))) + +;;; pearl--get-state-id-by-name + +(ert-deftest test-pearl-get-state-id-by-name-found () + "A state whose name matches (case-insensitively) resolves to its id." + (let ((pearl--cache-states nil)) + (testutil-linear-with-response + '((data (team (states (nodes . (((id . "s1") (name . "Todo")) + ((id . "s2") (name . "Done")))))))) + (should (string-equal "s2" (pearl--get-state-id-by-name "done" "team-1")))))) + +(ert-deftest test-pearl-get-state-id-by-name-not-found () + "A state name absent from the team resolves to nil." + (let ((pearl--cache-states nil)) + (testutil-linear-with-response + '((data (team (states (nodes . (((id . "s1") (name . "Todo")))))))) + (should (null (pearl--get-state-id-by-name "Archived" "team-1")))))) + +(ert-deftest test-pearl-state-lookup-caches-per-team () + "A second lookup for the same team is served from cache, no new request." + (let ((pearl-api-key "test-key") + (pearl--cache-states nil) + (calls 0)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (setq calls (1+ calls)) + (funcall (plist-get args :success) + :data '((data (team (states (nodes . (((id . "s1") (name . "Todo")) + ((id . "s2") (name . "Done")))))))))))) + (should (string-equal "s2" (pearl--get-state-id-by-name "Done" "team-1"))) + (should (string-equal "s1" (pearl--get-state-id-by-name "Todo" "team-1"))) + (should (= 1 calls))))) + +;;; pearl-update-issue-state (sync) -- nil-state-id guard + +(ert-deftest test-pearl-update-issue-state-nil-state-id-skips-request () + "When the state name doesn't resolve, no mutation request is fired." + (let ((requested nil) + (pearl-api-key "test-key")) + (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) nil)) + ((symbol-function 'request) (lambda (&rest _) (setq requested t)))) + (pearl-update-issue-state "i-1" "Nonexistent" "team-1") + (should-not requested)))) + +(ert-deftest test-pearl-update-issue-state-resolved-fires-request () + "When the state resolves, the mutation request is fired." + (let ((requested nil) + (pearl-api-key "test-key")) + (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) + ((symbol-function 'request) + (lambda (_url &rest args) + (setq requested t) + (let ((cb (plist-get args :success))) + (when cb (funcall cb :data '((data (issueUpdate (success . t)))))))))) + (pearl-update-issue-state "i-1" "Done" "team-1") + (should requested)))) + +;;; pearl--update-issue-state-async -- nil-state-id guard + +(ert-deftest test-pearl-update-issue-state-async-nil-state-id-skips-request () + "The async update also short-circuits when the state name doesn't resolve." + (let ((requested nil) + (pearl-api-key "test-key")) + (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) nil)) + ((symbol-function 'request) (lambda (&rest _) (setq requested t)))) + (pearl--update-issue-state-async "i-1" "Nonexistent" "team-1") + (should-not requested)))) + +(ert-deftest test-pearl-update-issue-state-async-success-runs () + "The async success handler runs on a successful update." + (let ((pearl-api-key "test-key")) + (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) + ((symbol-function 'request) + (lambda (_url &rest args) + (funcall (plist-get args :success) + :data '((data (issueUpdate (success . t)))))))) + (should (progn (pearl--update-issue-state-async "i-1" "Done" "team-1") t))))) + +(ert-deftest test-pearl-update-issue-state-async-error-runs () + "The async error handler runs on a transport error." + (let ((pearl-api-key "test-key")) + (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) + ((symbol-function 'request) + (lambda (_url &rest args) + (funcall (plist-get args :error) + :error-thrown "boom" + :response (make-request-response :status-code 500) + :data nil)))) + (should (progn (pearl--update-issue-state-async "i-1" "Done" "team-1") t))))) + +(provide 'test-pearl-states) +;;; test-pearl-states.el ends here diff --git a/tests/test-pearl-surface.el b/tests/test-pearl-surface.el new file mode 100644 index 0000000..4c2b7e5 --- /dev/null +++ b/tests/test-pearl-surface.el @@ -0,0 +1,81 @@ +;;; test-pearl-surface.el --- Tests for surfacing the active buffer -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for `pearl--surface-buffer': bring the active org buffer to a window +;; after a command updates it, gated on `pearl-surface-buffer', focus-following +;; gated on `pearl-surface-select-window', and skipped when the buffer is dead +;; or already visible. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(ert-deftest test-pearl-surface-buffer-disabled-is-noop () + "With `pearl-surface-buffer' nil, nothing is displayed." + (let ((pearl-surface-buffer nil) (shown nil)) + (cl-letf (((symbol-function 'display-buffer) (lambda (&rest _) (setq shown t))) + ((symbol-function 'pop-to-buffer) (lambda (&rest _) (setq shown t)))) + (with-temp-buffer + (pearl--surface-buffer (current-buffer)) + (should-not shown))))) + +(ert-deftest test-pearl-surface-buffer-shows-when-buried () + "A live, un-displayed buffer is shown via `display-buffer' by default." + (let ((pearl-surface-buffer t) (pearl-surface-select-window nil) (shown nil)) + (cl-letf (((symbol-function 'get-buffer-window) (lambda (&rest _) nil)) + ((symbol-function 'display-buffer) (lambda (b &rest _) (setq shown b))) + ((symbol-function 'pop-to-buffer) (lambda (&rest _) (setq shown 'pop)))) + (with-temp-buffer + (pearl--surface-buffer (current-buffer)) + (should (eq shown (current-buffer))))))) + +(ert-deftest test-pearl-surface-buffer-skips-when-already-shown () + "A buffer already visible in some window is left alone." + (let ((pearl-surface-buffer t) (shown nil)) + (cl-letf (((symbol-function 'get-buffer-window) (lambda (&rest _) 'a-window)) + ((symbol-function 'display-buffer) (lambda (&rest _) (setq shown t))) + ((symbol-function 'pop-to-buffer) (lambda (&rest _) (setq shown t)))) + (with-temp-buffer + (pearl--surface-buffer (current-buffer)) + (should-not shown))))) + +(ert-deftest test-pearl-surface-buffer-select-window-uses-pop-to-buffer () + "With `pearl-surface-select-window' non-nil, focus follows via `pop-to-buffer'." + (let ((pearl-surface-buffer t) (pearl-surface-select-window t) (how nil)) + (cl-letf (((symbol-function 'get-buffer-window) (lambda (&rest _) nil)) + ((symbol-function 'display-buffer) (lambda (&rest _) (setq how 'display))) + ((symbol-function 'pop-to-buffer) (lambda (&rest _) (setq how 'pop)))) + (with-temp-buffer + (pearl--surface-buffer (current-buffer)) + (should (eq how 'pop)))))) + +(ert-deftest test-pearl-surface-buffer-dead-buffer-is-noop () + "A killed buffer is never surfaced." + (let ((pearl-surface-buffer t) (shown nil) (buf (generate-new-buffer "x"))) + (kill-buffer buf) + (cl-letf (((symbol-function 'display-buffer) (lambda (&rest _) (setq shown t))) + ((symbol-function 'pop-to-buffer) (lambda (&rest _) (setq shown t)))) + (pearl--surface-buffer buf) + (should-not shown)))) + +(provide 'test-pearl-surface) +;;; test-pearl-surface.el ends here diff --git a/tests/test-pearl-sync-hooks.el b/tests/test-pearl-sync-hooks.el new file mode 100644 index 0000000..05864e7 --- /dev/null +++ b/tests/test-pearl-sync-hooks.el @@ -0,0 +1,175 @@ +;;; test-pearl-sync-hooks.el --- Tests for pearl org sync hooks -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the org sync hook wiring: enable/disable add and remove +;; buffer-local hooks; the after-save hook only fires for linear.org buffers; +;; and per-heading sync degrades gracefully when point is before any heading. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +;;; enable / disable + +(ert-deftest test-pearl-enable-org-sync-adds-buffer-local-hooks () + "Enabling sync adds both hook functions buffer-locally." + (with-temp-buffer + (pearl-enable-org-sync) + (should (memq 'pearl-org-hook-function after-save-hook)) + (should (memq 'pearl-sync-org-to-linear org-after-todo-state-change-hook)))) + +(ert-deftest test-pearl-disable-org-sync-removes-hooks () + "Disabling sync removes both hook functions." + (with-temp-buffer + (pearl-enable-org-sync) + (pearl-disable-org-sync) + (should-not (memq 'pearl-org-hook-function after-save-hook)) + (should-not (memq 'pearl-sync-org-to-linear org-after-todo-state-change-hook)))) + +;;; org-hook-function buffer guard + +(ert-deftest test-pearl-org-hook-function-skips-other-buffer () + "The after-save hook does nothing in a buffer that isn't the configured file." + (let ((called nil) + (pearl-org-file-path "/tmp/linear.org")) + (cl-letf (((symbol-function 'pearl-sync-org-to-linear) (lambda () (setq called t)))) + (with-temp-buffer + (setq buffer-file-name "/tmp/scratch.org") + (pearl-org-hook-function) + (should-not called))))) + +(ert-deftest test-pearl-org-hook-function-syncs-configured-buffer () + "The after-save hook syncs when the buffer visits `pearl-org-file-path'." + (let ((called nil) + (pearl-org-file-path "/tmp/linear.org")) + (cl-letf (((symbol-function 'pearl-sync-org-to-linear) (lambda () (setq called t)))) + (with-temp-buffer + (setq buffer-file-name "/tmp/linear.org") + (pearl-org-hook-function) + (should called))))) + +(ert-deftest test-pearl-org-hook-function-honors-custom-path () + "A non-default `pearl-org-file-path' is what the hook matches on. +Regression: the hook used to hardcode a \"linear.org$\" regex, so a buffer +named linear.org fired even when the configured file was elsewhere, and a +custom-named configured file never fired." + (let ((called nil) + (pearl-org-file-path "/tmp/my-linear-issues.org")) + (cl-letf (((symbol-function 'pearl-sync-org-to-linear) (lambda () (setq called t)))) + ;; A buffer literally named linear.org must NOT fire when the configured + ;; file is something else. + (with-temp-buffer + (setq buffer-file-name "/tmp/linear.org") + (pearl-org-hook-function) + (should-not called)) + ;; The configured custom-named file DOES fire. + (with-temp-buffer + (setq buffer-file-name "/tmp/my-linear-issues.org") + (pearl-org-hook-function) + (should called))))) + +(ert-deftest test-pearl-org-hook-function-matches-through-symlink () + "A configured path and a visited symlink to the same file match via truename. +The hook resolves both sides with `file-truename', so a symlink to the +configured file still syncs -- this guards the choice of truename over a raw +string compare." + (let ((real (make-temp-file "linear-real-" nil ".org")) + (link (make-temp-file "linear-link-" nil ".org")) + (called nil)) + (unwind-protect + (progn + (delete-file link) + (make-symbolic-link real link) + (let ((pearl-org-file-path real)) + (cl-letf (((symbol-function 'pearl-sync-org-to-linear) + (lambda () (setq called t)))) + (with-temp-buffer + (setq buffer-file-name link) + (pearl-org-hook-function) + (should called))))) + (when (file-exists-p link) (delete-file link)) + (when (file-exists-p real) (delete-file real))))) + +(ert-deftest test-pearl-org-hook-function-nil-path-no-op () + "With `pearl-org-file-path' nil, the hook is a no-op and does not error." + (let ((called nil) + (pearl-org-file-path nil)) + (cl-letf (((symbol-function 'pearl-sync-org-to-linear) (lambda () (setq called t)))) + (with-temp-buffer + (setq buffer-file-name "/tmp/linear.org") + (should (progn (pearl-org-hook-function) t)) + (should-not called))))) + +;;; sync-current-heading-to-linear + +(ert-deftest test-pearl-sync-current-heading-before-first-heading-no-error () + "Syncing with point before the first heading degrades gracefully. + +Regression: `org-back-to-heading' signals \"before first heading\" in the +preamble, which must not propagate out of the sync entry point." + (cl-letf (((symbol-function 'pearl--process-heading-at-point) (lambda () nil))) + (with-temp-buffer + (insert "#+TITLE: x\n\npreamble line\n") + (org-mode) + (goto-char (point-min)) + (should (progn (pearl-sync-current-heading-to-linear) t))))) + +(ert-deftest test-pearl-sync-current-heading-processes-on-heading () + "Syncing from within an entry processes that heading." + (let ((called nil)) + (cl-letf (((symbol-function 'pearl--process-heading-at-point) + (lambda () (setq called t)))) + (with-temp-buffer + (insert "* Top\n*** TODO x\n") + (org-mode) + (goto-char (point-max)) + (pearl-sync-current-heading-to-linear) + (should called))))) + +;;; sync-org-to-linear dispatcher + +(ert-deftest test-pearl-sync-org-to-linear-org-todo-syncs-current-heading () + "When invoked from `org-todo', only the current heading is synced." + (let ((called nil) + (this-command 'org-todo)) + (cl-letf (((symbol-function 'pearl-sync-current-heading-to-linear) + (lambda () (setq called t)))) + (pearl-sync-org-to-linear) + (should called)))) + +(ert-deftest test-pearl-sync-org-to-linear-otherwise-scans-whole-file () + "Outside `org-todo', every matching heading in the buffer is processed." + (let ((count 0) + (this-command 'some-other-command) + (pearl-state-to-todo-mapping '(("Todo" . "TODO") ("Done" . "DONE"))) + (pearl-todo-states-pattern nil) + (pearl--todo-states-pattern-source nil)) + (cl-letf (((symbol-function 'pearl--process-heading-at-point) + (lambda () (setq count (1+ count))))) + (with-temp-buffer + (insert "*** TODO a\n*** DONE b\n") + (org-mode) + (pearl-sync-org-to-linear) + (should (= 2 count)))))) + +(provide 'test-pearl-sync-hooks) +;;; test-pearl-sync-hooks.el ends here diff --git a/tests/test-pearl-sync-wrappers.el b/tests/test-pearl-sync-wrappers.el new file mode 100644 index 0000000..a5c9c70 --- /dev/null +++ b/tests/test-pearl-sync-wrappers.el @@ -0,0 +1,83 @@ +;;; test-pearl-sync-wrappers.el --- Tests for sync wrappers + pagination -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the synchronous busy-wait wrappers (teams, states, create) and +;; the completing-read-driven selectors. The HTTP boundary is stubbed; +;; `completing-read' is stubbed for the selectors. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +;;; Synchronous wrappers + +(ert-deftest test-pearl-get-teams-sync-returns-teams () + "The sync teams wrapper returns the async result." + (testutil-linear-with-response + '((data (teams (nodes . (((id . "t1") (name . "Eng"))))))) + (should (= 1 (length (pearl-get-teams)))))) + +(ert-deftest test-pearl-get-states-sync-returns-states () + "The sync states wrapper returns the async result." + (testutil-linear-with-response + '((data (team (states (nodes . (((id . "s1") (name . "Todo")))))) )) + (should (= 1 (length (pearl-get-states "team-1")))))) + +(ert-deftest test-pearl-create-issue-sync-returns-issue () + "The sync create wrapper returns the created issue node." + (testutil-linear-with-response + '((data (issueCreate (success . t) (issue (id . "i1") (identifier . "ENG-1") (title . "T"))))) + (should (string-equal "ENG-1" (cdr (assoc 'identifier (pearl-create-issue "T" "" "team"))))))) + +(ert-deftest test-pearl-sync-wrapper-times-out-without-callback () + "A sync wrapper returns nil instead of hanging when no callback fires." + (let ((pearl-request-timeout 0.3) + (pearl-api-key "test-key")) + (cl-letf (((symbol-function 'request) (lambda (&rest _) nil))) + (should (null (pearl-get-teams)))))) + +;;; Selectors (completing-read stubbed) + +(ert-deftest test-pearl-select-team-returns-chosen-team () + "Selecting a team returns the matching team alist." + (let ((pearl--cache-teams '(((id . "t1") (name . "Eng")) + ((id . "t2") (name . "Ops"))))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Ops"))) + (should (string-equal "t2" (cdr (assoc 'id (pearl-select-team)))))))) + +(ert-deftest test-pearl-select-project-returns-chosen-project () + "Selecting a project returns the matching project alist." + (cl-letf (((symbol-function 'pearl-get-projects) + (lambda (_tid) '(((id . "p1") (name . "Platform"))))) + ((symbol-function 'completing-read) (lambda (&rest _) "Platform"))) + (should (string-equal "p1" (cdr (assoc 'id (pearl-select-project "team-1"))))))) + +(ert-deftest test-pearl-select-project-none-returns-nil () + "Choosing None returns nil." + (cl-letf (((symbol-function 'pearl-get-projects) + (lambda (_tid) '(((id . "p1") (name . "Platform"))))) + ((symbol-function 'completing-read) (lambda (&rest _) "None"))) + (should (null (pearl-select-project "team-1"))))) + +(provide 'test-pearl-sync-wrappers) +;;; test-pearl-sync-wrappers.el ends here diff --git a/tests/test-pearl-sync.el b/tests/test-pearl-sync.el new file mode 100644 index 0000000..6127914 --- /dev/null +++ b/tests/test-pearl-sync.el @@ -0,0 +1,206 @@ +;;; test-pearl-sync.el --- Tests for description sync-back -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the explicit description sync-back: the pure conflict gate +;; (`pearl--sync-decision'), the org body extractor +;; (`pearl--issue-body-at-point'), the two network helpers (fetch the +;; remote description, push an updated description -- both stubbed at the HTTP +;; boundary), and the orchestrating command `pearl-sync-current-issue' +;; across its no-op / clean-push / conflict branches. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT at point-min." + (declare (indent 1)) + `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; --sync-decision (pure conflict gate) + +(ert-deftest test-pearl-sync-decision-noop-no-local-edit () + "Local matches the stored baseline: no local edit, no push." + (let ((md "the description")) + (should (eq :noop (pearl--sync-decision + md (secure-hash 'sha256 md) "remote moved on"))))) + +(ert-deftest test-pearl-sync-decision-push-remote-unchanged () + "Local edited and remote still equals the baseline: clean push." + (should (eq :push (pearl--sync-decision + "edited locally" (secure-hash 'sha256 "baseline") "baseline")))) + +(ert-deftest test-pearl-sync-decision-conflict-both-changed () + "Local and remote both moved away from the baseline, differently: conflict." + (should (eq :conflict (pearl--sync-decision + "edited local" (secure-hash 'sha256 "baseline") "edited remote")))) + +(ert-deftest test-pearl-sync-decision-noop-converged () + "Local and remote ended up identical though both differ from baseline: no push." + (should (eq :noop (pearl--sync-decision + "same new text" (secure-hash 'sha256 "baseline") "same new text")))) + +;;; --issue-body-at-point (org body extractor) + +(ert-deftest test-pearl-issue-body-after-drawer () + "The body is the text after the drawer, trimmed." + (test-pearl--in-org + "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nThe body line.\nSecond line.\n" + (re-search-forward "Title") + (should (string= "The body line.\nSecond line." + (pearl--issue-body-at-point))))) + +(ert-deftest test-pearl-issue-body-empty () + "An entry with no body yields the empty string." + (test-pearl--in-org + "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (should (string= "" (pearl--issue-body-at-point))))) + +(ert-deftest test-pearl-issue-body-stops-before-comments () + "The description body stops before a child Comments subtree." + (test-pearl--in-org + "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nDesc body.\n**** Comments\n***** bob -- ts\nhi\n" + (should (string= "Desc body." (pearl--issue-body-at-point))))) + +(ert-deftest test-pearl-issue-body-from-inside-body () + "Extraction works with point already inside the body." + (test-pearl--in-org + "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nDesc body.\nmore.\n" + (goto-char (point-max)) + (should (string= "Desc body.\nmore." (pearl--issue-body-at-point))))) + +;;; network helpers (stubbed at the HTTP boundary) + +(ert-deftest test-pearl-fetch-issue-description-parses-payload () + "The fetch helper returns the remote description and timestamp as a plist." + (testutil-linear-with-response + '((data (issue (description . "remote markdown") + (updatedAt . "2026-05-23T00:00:00.000Z")))) + (let (result) + (pearl--fetch-issue-description-async + "id-1" (lambda (r) (setq result r))) + (should (string= "remote markdown" (plist-get result :description))) + (should (string= "2026-05-23T00:00:00.000Z" (plist-get result :updated-at)))))) + +(ert-deftest test-pearl-update-issue-description-success () + "A successful issueUpdate reports success and carries the new timestamp." + (testutil-linear-with-response + '((data (issueUpdate (success . t) + (issue (id . "id-1") + (updatedAt . "2026-05-23T01:00:00.000Z"))))) + (let (result) + (pearl--update-issue-description-async + "id-1" "new body" (lambda (r) (setq result r))) + (should (eq t (plist-get result :success))) + (should (string= "2026-05-23T01:00:00.000Z" (plist-get result :updated-at)))))) + +(ert-deftest test-pearl-update-issue-description-soft-fail () + "A non-success issueUpdate reports failure rather than erroring." + (testutil-linear-with-response + '((data (issueUpdate (success . :json-false) (issue . nil)))) + (let ((called nil) result) + (pearl--update-issue-description-async + "id-1" "new body" (lambda (r) (setq called t result r))) + (should called) + (should-not (plist-get result :success))))) + +;;; pearl-sync-current-issue (orchestration branches) + +(defmacro test-pearl--with-sync-stubs (fetch-remote update-spy &rest body) + "Run BODY with the two network helpers stubbed. +FETCH-REMOTE is the plist the fetch helper hands its callback. UPDATE-SPY is +a symbol bound to a list that captures the markdown passed to the update +helper (nil when never called); the update helper reports success." + (declare (indent 2)) + `(cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb ,fetch-remote))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (_id md cb) + (push md ,update-spy) + (funcall cb '(:success t :updated-at "2026-05-23T02:00:00.000Z"))))) + ,@body)) + +(ert-deftest test-pearl-sync-current-issue-noop-skips-network () + "No local edit: neither the fetch nor the update helper is called." + (let ((md "Hello **world** and `code`.") + (fetched nil) (updates nil)) + (test-pearl--in-org + (format "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: %s\n:END:\n%s\n" + (secure-hash 'sha256 "Hello **world** and `code`.") + (pearl--md-to-org "Hello **world** and `code`.")) + (ignore md) + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (&rest _) (setq fetched t))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (&rest _) (push 'called updates)))) + (pearl-sync-current-issue) + (should-not fetched) + (should-not updates))))) + +(ert-deftest test-pearl-sync-current-issue-push-updates-provenance () + "Local edit + remote unchanged: push the rendered markdown, update the hash." + (let ((updates nil)) + (test-pearl--in-org + (format "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: %s\n:LINEAR-DESC-UPDATED-AT: old\n:END:\nEdited body now.\n" + (secure-hash 'sha256 "baseline remote")) + (test-pearl--with-sync-stubs '(:description "baseline remote" :updated-at "t0") updates + (pearl-sync-current-issue) + ;; the pushed markdown is the org body rendered back to md + (should (equal (list (pearl--org-to-md "Edited body now.")) + updates)) + ;; provenance advanced to the pushed content + the push timestamp + (should (string= (secure-hash 'sha256 (pearl--org-to-md "Edited body now.")) + (org-entry-get nil "LINEAR-DESC-SHA256"))) + (should (string= "2026-05-23T02:00:00.000Z" + (org-entry-get nil "LINEAR-DESC-UPDATED-AT"))))))) + +(ert-deftest test-pearl-sync-current-issue-conflict-refuses () + "Local edit + remote also changed: refuse, do not push, keep provenance." + (let ((updates nil) + (stored (secure-hash 'sha256 "baseline remote"))) + (test-pearl--in-org + (format "*** TODO ENG-1 Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: %s\n:END:\nEdited body now.\n" + stored) + (test-pearl--with-sync-stubs '(:description "remote changed too" :updated-at "t1") updates + ;; On conflict the command now prompts; cancel preserves the old + ;; refuse-and-keep-provenance behavior. + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (pearl-sync-current-issue) + (should-not updates) + ;; provenance untouched when the conflict is cancelled + (should (string= stored (org-entry-get nil "LINEAR-DESC-SHA256")))))))) + +(ert-deftest test-pearl-sync-current-issue-not-on-issue-errors () + "Running the command outside a Linear issue heading signals a user error." + (test-pearl--in-org + "* Just a plain heading\nno linear id here\n" + (should-error (pearl-sync-current-issue) :type 'user-error))) + +(provide 'test-pearl-sync) +;;; test-pearl-sync.el ends here diff --git a/tests/test-pearl-teams.el b/tests/test-pearl-teams.el new file mode 100644 index 0000000..dc7e41c --- /dev/null +++ b/tests/test-pearl-teams.el @@ -0,0 +1,109 @@ +;;; test-pearl-teams.el --- Tests for pearl team/project lookups -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for team, project, member, and label lookups with `request' stubbed. +;; These exercise the response-unwrapping (assoc nesting) and the +;; name-to-id resolution used when syncing org headings back to Linear. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) + +;;; pearl-get-teams-async + +(ert-deftest test-pearl-get-teams-async-parses-nodes () + "Teams are unwrapped from data.teams.nodes and passed to the callback." + (let ((got nil) + (pearl--cache-teams nil)) + (testutil-linear-with-response + '((data (teams (nodes . (((id . "t1") (name . "Eng")) + ((id . "t2") (name . "Ops"))))))) + (pearl-get-teams-async (lambda (teams) (setq got teams)))) + (should (= 2 (length got))) + (should (string-equal "Eng" (cdr (assoc 'name (car got))))))) + +;;; pearl--get-team-id-by-name + +(ert-deftest test-pearl-get-team-id-by-name-found () + "A team whose name matches resolves to its id." + (let ((pearl--cache-teams nil)) + (testutil-linear-with-response + '((data (teams (nodes . (((id . "t1") (name . "Eng"))))))) + (should (string-equal "t1" (pearl--get-team-id-by-name "Eng")))))) + +(ert-deftest test-pearl-get-team-id-by-name-not-found () + "A name with no matching team resolves to nil." + (let ((pearl--cache-teams nil)) + (testutil-linear-with-response + '((data (teams (nodes . (((id . "t1") (name . "Eng"))))))) + (should (null (pearl--get-team-id-by-name "Marketing")))))) + +(ert-deftest test-pearl-team-id-lookup-caches-teams () + "A second team-id lookup reuses the cached team list, no new request." + (let ((pearl-api-key "test-key") + (pearl--cache-teams nil) + (calls 0)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (setq calls (1+ calls)) + (funcall (plist-get args :success) + :data '((data (teams (nodes . (((id . "t1") (name . "Eng")) + ((id . "t2") (name . "Ops"))))))))) )) + (should (string-equal "t1" (pearl--get-team-id-by-name "Eng"))) + (should (string-equal "t2" (pearl--get-team-id-by-name "Ops"))) + (should (= 1 calls))))) + +;;; pearl-get-projects + +(ert-deftest test-pearl-get-projects-converts-vector-to-list () + "Projects come back as a vector from json-read and are returned as a list." + (testutil-linear-with-response + '((data (team (projects (nodes . [((id . "p1") (name . "Platform"))]))))) + (let ((projects (pearl-get-projects "team-1"))) + (should (listp projects)) + (should (= 1 (length projects))) + (should (string-equal "Platform" (cdr (assoc 'name (car projects)))))))) + +;;; pearl-get-issue-types + +(ert-deftest test-pearl-get-issue-types-maps-name-to-id () + "Issue-type labels are returned as a name -> id alist." + (testutil-linear-with-response + '((data (team (labels (nodes . (((id . "l1") (name . "bug")) + ((id . "l2") (name . "feature")))))))) + (let ((types (pearl-get-issue-types "team-1"))) + (should (string-equal "l1" (cdr (assoc "bug" types)))) + (should (string-equal "l2" (cdr (assoc "feature" types))))))) + +;;; pearl-get-team-members + +(ert-deftest test-pearl-get-team-members-prefers-display-name () + "Members map their display name (falling back to name) to their id." + (testutil-linear-with-response + '((data (team (members (nodes . (((id . "m1") (name . "Ada Lovelace") (displayName . "Ada")) + ((id . "m2") (name . "Alan Turing")))))))) + (let ((members (pearl-get-team-members "team-1"))) + (should (string-equal "m1" (cdr (assoc "Ada" members)))) + (should (string-equal "m2" (cdr (assoc "Alan Turing" members))))))) + +(provide 'test-pearl-teams) +;;; test-pearl-teams.el ends here diff --git a/tests/test-pearl-title-sync.el b/tests/test-pearl-title-sync.el new file mode 100644 index 0000000..6fbd284 --- /dev/null +++ b/tests/test-pearl-title-sync.el @@ -0,0 +1,165 @@ +;;; test-pearl-title-sync.el --- Tests for title sync-back -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for explicit title sync-back, a separate path from the description +;; sync that shares the `pearl--sync-decision' gate. Covers the title +;; extractor, the title fetch and update helpers (stubbed at the HTTP +;; boundary), the command's no-op / push / conflict branches, and the +;; deliberate bracket-stripping lossiness: a bracketed remote title renders +;; with its stored hash matching the stripped heading, so a no-op sync makes +;; no API call and never clobbers the brackets on Linear. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; --issue-title-at-point + +(ert-deftest test-pearl-issue-title-strips-keyword-and-cookie () + "The title extractor returns the heading text without TODO, priority, tags." + (test-pearl--in-org + "*** TODO [#B] My issue title :tag:\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (should (string= "My issue title" (pearl--issue-title-at-point))))) + +;;; network helpers + +(ert-deftest test-pearl-fetch-issue-title-parses-payload () + "The title fetch returns the remote title and timestamp." + (testutil-linear-with-response + '((data (issue (title . "Remote title") (updatedAt . "2026-05-23T00:00:00.000Z")))) + (let (result) + (pearl--fetch-issue-title-async "a" (lambda (r) (setq result r))) + (should (string= "Remote title" (plist-get result :title))) + (should (string= "2026-05-23T00:00:00.000Z" (plist-get result :updated-at)))))) + +(ert-deftest test-pearl-update-issue-title-success () + "A successful title issueUpdate reports success." + (testutil-linear-with-response + '((data (issueUpdate (success . t) + (issue (id . "a") (updatedAt . "2026-05-23T01:00:00.000Z"))))) + (let (result) + (pearl--update-issue-title-async "a" "New" (lambda (r) (setq result r))) + (should (eq t (plist-get result :success)))))) + +(ert-deftest test-pearl-update-issue-title-soft-fail () + "A non-success title issueUpdate reports failure rather than erroring." + (testutil-linear-with-response + '((data (issueUpdate (success . :json-false) (issue . nil)))) + (let ((called nil) result) + (pearl--update-issue-title-async "a" "New" (lambda (r) (setq called t result r))) + (should called) + (should-not (plist-get result :success))))) + +;;; command branches + +(defmacro test-pearl--with-title-stubs (remote-title update-spy &rest body) + "Run BODY with the title fetch/update helpers stubbed. +REMOTE-TITLE is the plist the fetch hands its callback. UPDATE-SPY collects +the titles pushed to the update helper, which reports success." + (declare (indent 2)) + `(cl-letf (((symbol-function 'pearl--fetch-issue-title-async) + (lambda (_id cb) (funcall cb ,remote-title))) + ((symbol-function 'pearl--update-issue-title-async) + (lambda (_id title cb) + (push title ,update-spy) + (funcall cb '(:success t :updated-at "2026-05-23T02:00:00.000Z"))))) + ,@body)) + +(ert-deftest test-pearl-sync-title-noop-skips-network () + "No title edit: neither the fetch nor the update helper is called." + (let ((fetched nil) (updates nil)) + (test-pearl--in-org + (format "*** TODO [#B] Same Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TITLE-SHA256: %s\n:END:\n" + (secure-hash 'sha256 "Same Title")) + (cl-letf (((symbol-function 'pearl--fetch-issue-title-async) + (lambda (&rest _) (setq fetched t))) + ((symbol-function 'pearl--update-issue-title-async) + (lambda (&rest _) (push 'called updates)))) + (pearl-sync-current-issue-title) + (should-not fetched) + (should-not updates))))) + +(ert-deftest test-pearl-sync-title-push-advances-provenance () + "An edited title against an unchanged remote pushes and advances the hash." + (let ((updates nil)) + (test-pearl--in-org + (format "*** TODO [#B] Edited Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TITLE-SHA256: %s\n:END:\n" + (secure-hash 'sha256 "Old Title")) + (test-pearl--with-title-stubs '(:title "Old Title" :updated-at "t0") updates + (pearl-sync-current-issue-title) + (should (equal '("Edited Title") updates)) + (should (string= (secure-hash 'sha256 "Edited Title") + (org-entry-get nil "LINEAR-TITLE-SHA256"))))))) + +(ert-deftest test-pearl-sync-title-conflict-refuses () + "Title edited locally and changed on the remote too: refuse, do not push." + (let ((updates nil) + (stored (secure-hash 'sha256 "Old Title"))) + (test-pearl--in-org + (format "*** TODO [#B] Edited Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TITLE-SHA256: %s\n:END:\n" + stored) + (test-pearl--with-title-stubs '(:title "Remote Changed Title" :updated-at "t1") updates + ;; On conflict the command now prompts; cancel keeps the old behavior. + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (pearl-sync-current-issue-title) + (should-not updates) + (should (string= stored (org-entry-get nil "LINEAR-TITLE-SHA256")))))))) + +(ert-deftest test-pearl-sync-title-bracketed-remote-is-noop () + "A bracketed remote title renders stripped; a no-op sync makes no API call. +This is the deliberate bracket-stripping lossiness: the stored hash is of the +stripped heading, so an unedited bracketed title is never clobbered on Linear." + (let ((fetched nil) (updates nil)) + (test-pearl--in-org + ;; remote title "Fix [URGENT] bug" renders to heading "Fix URGENT bug"; + ;; the stored hash is of the stripped form. + (format "*** TODO [#B] Fix URGENT bug\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TITLE-SHA256: %s\n:END:\n" + (secure-hash 'sha256 "Fix URGENT bug")) + (cl-letf (((symbol-function 'pearl--fetch-issue-title-async) + (lambda (&rest _) (setq fetched t))) + ((symbol-function 'pearl--update-issue-title-async) + (lambda (&rest _) (push 'called updates)))) + (pearl-sync-current-issue-title) + (should-not fetched) + (should-not updates))))) + +(ert-deftest test-pearl-sync-title-not-on-issue-errors () + "Running the command outside a Linear issue heading signals a user error." + (test-pearl--in-org "* Plain heading\nno id\n" + (should-error (pearl-sync-current-issue-title) :type 'user-error))) + +(provide 'test-pearl-title-sync) +;;; test-pearl-title-sync.el ends here diff --git a/tests/test-pearl-views.el b/tests/test-pearl-views.el new file mode 100644 index 0000000..2a5d6bd --- /dev/null +++ b/tests/test-pearl-views.el @@ -0,0 +1,130 @@ +;;; test-pearl-views.el --- Tests for Linear Custom Views -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for reading and running Linear Custom Views: the cached views list, +;; the server-side `--query-view-async' run, `pearl-run-view', the view +;; branch of refresh, and opening the active view in the browser. HTTP is +;; stubbed. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +;;; --query-view-async + +(ert-deftest test-pearl-query-view-async-extracts-issues () + "Running a view extracts the server-side issue nodes into an ok result." + (testutil-linear-with-response + '((data (customView + (issues (nodes . [((id . "i1") (identifier . "ENG-1") (title . "A"))]) + (pageInfo (hasNextPage . :json-false) (endCursor . nil)))))) + (let (result) + (pearl--query-view-async "view-1" (lambda (r) (setq result r))) + (should (eq 'ok (pearl--query-result-status result))) + (should (= 1 (length (pearl--query-result-issues result))))))) + +;;; --custom-views (cached) + +(ert-deftest test-pearl-custom-views-caches () + "The views list is fetched once and served from cache." + (let ((pearl-api-key "test-key") + (pearl--cache-views nil) + (calls 0)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (cl-incf calls) + (funcall (plist-get args :success) :data + '((data (customViews + (nodes . [((id . "v1") (name . "My View") (url . "https://x"))]) + (pageInfo (hasNextPage . :json-false))))))))) + (let ((views (pearl--custom-views))) + (should (= 1 (length views))) + (pearl--custom-views) + (should (= 1 calls)))))) + +;;; run-view + +(ert-deftest test-pearl-run-view-renders-with-view-source () + "Running a view resolves its id and renders with a view-typed source." + (let ((ran-id nil) (rendered-source nil)) + (cl-letf (((symbol-function 'pearl--custom-views) + (lambda (&optional _force) + '(((id . "v1") (name . "My View") (url . "https://linear.app/view/v1"))))) + ((symbol-function 'pearl--query-view-async) + (lambda (id cb) (setq ran-id id) + (funcall cb (pearl--make-query-result 'ok :issues nil)))) + ((symbol-function 'pearl--render-query-result) + (lambda (_result source) (setq rendered-source source)))) + (pearl-run-view "My View") + (should (string= "v1" ran-id)) + (should (eq 'view (plist-get rendered-source :type))) + (should (string= "v1" (plist-get rendered-source :id))) + (should (string= "https://linear.app/view/v1" (plist-get rendered-source :url)))))) + +;;; refresh-current-view, view branch + +(ert-deftest test-pearl-refresh-current-view-runs-view-source () + "Refresh on a view source calls the view query, not the filter query." + (let ((view-ran nil) + (source '(:type view :name "My View" :id "v1" :url "https://x"))) + (with-temp-buffer + (insert (format "#+title: Linear — My View\n#+LINEAR-SOURCE: %s\n\n" + (prin1-to-string source))) + (org-mode) + (cl-letf (((symbol-function 'pearl--query-view-async) + (lambda (id cb) (setq view-ran id) + (funcall cb (pearl--make-query-result 'ok :issues nil)))) + ((symbol-function 'pearl--merge-query-result) + (lambda (&rest _) nil))) + (pearl-refresh-current-view) + (should (string= "v1" view-ran)))))) + +;;; open-current-view-in-linear + +(ert-deftest test-pearl-open-current-view-visits-url () + "Opening the active view visits the source's url." + (let ((visited nil) + (source '(:type view :name "My View" :id "v1" :url "https://linear.app/view/v1"))) + (with-temp-buffer + (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string source))) + (org-mode) + (cl-letf (((symbol-function 'browse-url) (lambda (u &rest _) (setq visited u)))) + (pearl-open-current-view-in-linear) + (should (string= "https://linear.app/view/v1" visited)))))) + +(ert-deftest test-pearl-open-current-view-no-url-errors () + "Opening a non-view or url-less source signals a user error." + (let ((source '(:type filter :name "My open issues" :filter (:assignee :me)))) + (with-temp-buffer + (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string source))) + (org-mode) + (should-error (pearl-open-current-view-in-linear) :type 'user-error)))) + +;;; the view query fetches comments too + +(ert-deftest test-pearl-view-issues-query-requests-comments () + "The Custom View query selects comments, so a view-populated list shows them." + (should (string-match-p "comments[[:space:]]*{[[:space:]]*nodes" pearl--view-issues-query))) + +(provide 'test-pearl-views) +;;; test-pearl-views.el ends here diff --git a/tests/testutil-fixtures.el b/tests/testutil-fixtures.el new file mode 100644 index 0000000..5c55c7b --- /dev/null +++ b/tests/testutil-fixtures.el @@ -0,0 +1,105 @@ +;;; testutil-fixtures.el --- representative Linear API response fixtures -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;;; Commentary: + +;; Small, representative response fixtures for the issue-query and +;; representation build. They cover an assignedIssues page, a top-level +;; issues(filter:) page, custom views, a custom view's issues, an issue with +;; comments, and an issue with null/missing optional fields. +;; +;; Shapes mirror what `json-read' returns from the live API: symbol-keyed +;; alists, `t' / `:json-false' for JSON booleans, and a missing key (rather +;; than an explicit value) for absent optional fields. Not a test file (no +;; `test-' prefix), so the suite runner ignores it; tests `require' it. +;; +;; These let normalization, query, and render tests run against stable +;; inputs without a live workspace. Captured from the documented schema +;; shapes; replace with real recorded responses once a live key is wired in. + +;;; Code: + +(defun testutil-linear-fixture-issue-full () + "A fully-populated issue node, every optional field present." + '((id . "uuid-1") + (identifier . "ENG-42") + (title . "Fix the thing") + (description . "Line one\nLine two") + (priority . 2) + (updatedAt . "2026-05-20T12:00:00.000Z") + (state . ((id . "state-1") (name . "In Progress") (type . "started") (color . "#fff"))) + (assignee . ((id . "user-1") (name . "Craig") (email . "c@example.com"))) + (team . ((id . "team-1") (key . "ENG") (name . "Engineering"))) + (project . ((id . "proj-1") (name . "Platform"))) + (cycle . ((id . "cycle-1") (number . 12) (name . "Cycle 12"))) + (labels . ((nodes . (((id . "lbl-1") (name . "bug")) + ((id . "lbl-2") (name . "backend")))))))) + +(defun testutil-linear-fixture-issue-null-fields () + "An issue with optional fields absent or null (project/labels/assignee/cycle). +Description is JSON null; labels is an empty connection." + '((id . "uuid-2") + (identifier . "ENG-7") + (title . "Bare issue") + (description) + (priority . 0) + (updatedAt . "2026-05-19T08:30:00.000Z") + (state . ((id . "state-2") (name . "Todo") (type . "unstarted"))) + (assignee) + (team . ((id . "team-1") (key . "ENG") (name . "Engineering"))) + (project) + (cycle) + (labels . ((nodes . ()))))) + +(defun testutil-linear-fixture-assigned-issues-page () + "A viewer.assignedIssues page: two issues, no next page." + `((data (viewer (assignedIssues + (nodes . (,(testutil-linear-fixture-issue-full) + ,(testutil-linear-fixture-issue-null-fields))) + (pageInfo (hasNextPage . :json-false) (endCursor . "cursor-1"))))))) + +(defun testutil-linear-fixture-issues-filter-page () + "A top-level issues(filter:) page: one issue, has a next page." + `((data (issues + (nodes . (,(testutil-linear-fixture-issue-full))) + (pageInfo (hasNextPage . t) (endCursor . "cursor-2")))))) + +(defun testutil-linear-fixture-custom-views () + "A customViews connection: one shared workspace view, one personal team view." + '((data (customViews + (nodes . (((id . "cv-1") (name . "My open work") (description . "Everything open assigned to me") + (shared . :json-false) (team) (icon . "Inbox") (color . "#aabbcc") + (owner . ((id . "user-1") (name . "Craig")))) + ((id . "cv-2") (name . "Eng in progress") (description) + (shared . t) (team . ((id . "team-1") (key . "ENG") (name . "Engineering"))) + (icon) (color) + (owner . ((id . "user-1") (name . "Craig")))))) + (pageInfo (hasNextPage . :json-false) (endCursor . "cv-cursor")))))) + +(defun testutil-linear-fixture-custom-view-issues () + "A customView(id).issues page: the view's filter resolved server-side." + `((data (customView + (id . "cv-1") + (name . "My open work") + (issues + (nodes . (,(testutil-linear-fixture-issue-full))) + (pageInfo (hasNextPage . :json-false) (endCursor . "cvi-cursor"))))))) + +(defun testutil-linear-fixture-issue-with-comments () + "An issue carrying a comments connection, oldest first." + `((id . "uuid-1") + (identifier . "ENG-42") + (title . "Fix the thing") + (description . "Body text") + (comments (nodes . (((id . "cm-1") (body . "First comment") + (createdAt . "2026-05-18T09:00:00.000Z") + (user . ((id . "user-2") (name . "Alice")))) + ((id . "cm-2") (body . "Second comment, **bold**") + (createdAt . "2026-05-19T10:30:00.000Z") + (user . ((id . "user-1") (name . "Craig"))))))))) + +(provide 'testutil-fixtures) +;;; testutil-fixtures.el ends here diff --git a/tests/testutil-request.el b/tests/testutil-request.el new file mode 100644 index 0000000..a517bb6 --- /dev/null +++ b/tests/testutil-request.el @@ -0,0 +1,49 @@ +;;; testutil-request.el --- request mocking helpers for pearl tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Shared helpers for stubbing the `request' library at the HTTP boundary. +;; A stub invokes the package's own :success or :error callback synchronously +;; with canned, json-read-shaped data, so the response-parsing and callback +;; logic runs for real without any network. Not a test file itself (no +;; test- prefix), so the suite runner ignores it; test files `require' it. + +;;; Code: + +(require 'cl-lib) + +(defun testutil-linear-request-success (data) + "Return a `request' replacement that invokes its :success callback with DATA." + (lambda (_url &rest args) + (let ((cb (plist-get args :success))) + (when cb (funcall cb :data data))))) + +(defun testutil-linear-request-error (msg) + "Return a `request' replacement that invokes its :error callback with MSG. +The :response carries a real `request-response' struct, matching what the +live library passes, so the package's status-code logging doesn't choke." + (lambda (_url &rest args) + (let ((cb (plist-get args :error))) + (when cb + (funcall cb :error-thrown msg + :response (make-request-response :status-code 500) + :data nil))))) + +(defmacro testutil-linear-with-response (data &rest body) + "Run BODY with `request' stubbed to succeed with DATA and an API key set." + (declare (indent 1)) + `(let ((pearl-api-key "test-key")) + (cl-letf (((symbol-function 'request) (testutil-linear-request-success ,data))) + ,@body))) + +(defmacro testutil-linear-with-error (msg &rest body) + "Run BODY with `request' stubbed to fail with MSG and an API key set." + (declare (indent 1)) + `(let ((pearl-api-key "test-key")) + (cl-letf (((symbol-function 'request) (testutil-linear-request-error ,msg))) + ,@body))) + +(provide 'testutil-request) +;;; testutil-request.el ends here |