├── .gitignore ├── LICENSE ├── README.md ├── cabal.project ├── circle.yml ├── docs ├── Building-An-Extension.md ├── README.md └── rasa.png ├── rasa-example-config ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── Main.hs └── rasa-example-config.cabal ├── rasa-ext-cmd ├── LICENSE ├── Setup.hs ├── rasa-ext-cmd.cabal └── src │ └── Rasa │ └── Ext │ └── Cmd.hs ├── rasa-ext-cursors ├── LICENSE ├── Setup.hs ├── rasa-ext-cursors.cabal ├── src │ └── Rasa │ │ └── Ext │ │ ├── Cursors.hs │ │ └── Cursors │ │ └── Internal │ │ ├── Actions.hs │ │ └── Base.hs └── test │ ├── Rasa │ └── Ext │ │ └── CursorsSpec.hs │ └── Spec.hs ├── rasa-ext-files ├── LICENSE ├── Setup.hs ├── rasa-ext-files.cabal └── src │ └── Rasa │ └── Ext │ └── Files.hs ├── rasa-ext-logger ├── LICENSE ├── README.md ├── Setup.hs ├── rasa-ext-logger.cabal └── src │ └── Rasa │ └── Ext │ └── Logger.hs ├── rasa-ext-slate ├── LICENSE ├── README.md ├── Setup.hs ├── rasa-ext-slate.cabal └── src │ └── Rasa │ └── Ext │ ├── Slate.hs │ └── Slate │ └── Internal │ ├── Attributes.hs │ ├── Event.hs │ ├── Render.hs │ └── State.hs ├── rasa-ext-views ├── LICENSE ├── Setup.hs ├── rasa-ext-views.cabal └── src │ └── Rasa │ └── Ext │ ├── Views.hs │ └── Views │ └── Internal │ ├── Actions.hs │ ├── ActiveBar.hs │ ├── AnyRenderable.hs │ ├── BiTree.hs │ ├── LineNumbers.hs │ ├── StatusBar.hs │ ├── Views.hs │ └── Widgets.hs ├── rasa-ext-vim ├── LICENSE ├── README.md ├── Setup.hs ├── rasa-ext-vim.cabal ├── src │ └── Rasa │ │ └── Ext │ │ └── Vim.hs └── test │ ├── Rasa │ └── Ext │ │ └── VimSpec.hs │ └── Spec.hs ├── rasa ├── LICENSE ├── README.md ├── Setup.hs ├── rasa.cabal ├── src │ ├── Rasa.hs │ └── Rasa │ │ ├── Ext.hs │ │ └── Internal │ │ ├── BufActions.hs │ │ ├── Buffer.hs │ │ ├── Events.hs │ │ ├── Listeners.hs │ │ ├── Range.hs │ │ ├── Styles.hs │ │ ├── Text.hs │ │ └── Utility.hs └── test │ ├── ArbitraryInstances.hs │ ├── Rasa │ └── Internal │ │ ├── ActionSpec.hs │ │ ├── ActionsSpec.hs │ │ ├── AsyncSpec.hs │ │ ├── BufActionsSpec.hs │ │ ├── BufferSpec.hs │ │ ├── EventsSpec.hs │ │ ├── ListenersSpec.hs │ │ ├── RangeSpec.hs │ │ └── TextSpec.hs │ ├── RasaSpec.hs │ └── Spec.hs ├── stack.yaml ├── stack.yaml.lock └── text-lens ├── LICENSE ├── Setup.hs ├── src └── Control │ └── Lens │ └── Text.hs ├── test └── Spec.hs └── text-lens.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | .HTF/ 21 | *.log 22 | .imdone/ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Rasa (Rah-zah) 2 | ============== 3 | 4 | [![Join the chat at https://gitter.im/rasa-editor/Lobby](https://badges.gitter.im/rasa-editor/Lobby.svg)](https://gitter.im/rasa-editor/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 5 | [![Hackage](https://img.shields.io/badge/hackage-latest-green.svg)](https://hackage.haskell.org/package/rasa) 6 | 7 | Embarrassingly modular customizable text editor built in Haskell. 8 | 9 | ![Rasa Editor](https://github.com/ChrisPenner/rasa/blob/master/docs/rasa.png "Rasa Editor") 10 | 11 | A Rasa editing session with multiple cursors & viewports. 12 | 13 | Documentation 14 | ------------- 15 | You can find hackage documentation for rasa and some extensions here: 16 | 17 | - [rasa](https://hackage.haskell.org/package/rasa) 18 | - [rasa-ext-slate](https://hackage.haskell.org/package/rasa-ext-slate) 19 | - [rasa-ext-views](https://hackage.haskell.org/package/rasa-ext-views) 20 | - [rasa-ext-vim](https://hackage.haskell.org/package/rasa-ext-vim) 21 | - [rasa-ext-cmd](https://hackage.haskell.org/package/rasa-ext-cmd) 22 | - [rasa-ext-cursors](https://hackage.haskell.org/package/rasa-ext-cursors) 23 | - [rasa-ext-files](https://hackage.haskell.org/package/rasa-ext-files) 24 | - [rasa-ext-logger](https://hackage.haskell.org/package/rasa-ext-logger) 25 | 26 | What people are saying 27 | ---------------------- 28 | 29 | > Excessively Modular! - some bald guy 30 | 31 | > I'm glad I'm unemployed so I have time to configure it! - my mate Steve 32 | 33 | > You should go outside one of these days. - Mother 34 | 35 | Getting started 36 | --------------- 37 | 38 | ### Configuring Rasa 39 | 40 | Rasa is designed to be easy to configure and script, both when adding extensions provided 41 | by the community, and when writing your own user-scripts. 42 | 43 | Rasa is written in Haskell, and the configuration is done in the Haskell 44 | language, don't let that scare you though, you can script Rasa and add 45 | extensions without knowing much haskell! 46 | 47 | ### [Building Your First Extension](https://github.com/ChrisPenner/rasa/blob/master/docs/Building-An-Extension.md) 48 | 49 | \^ That guide will walk you through installation and getting running! Once 50 | you're running rasa you can experiment with creating your own adaptations. You 51 | should customize your keymap to add a few mappings you like. It's a short step 52 | from here to developing your own extensions. `Action`s like you'd use in an 53 | extension can be registered to listeners in your `Main.hs`. You can build and 54 | experiment with entire extensions in your config file and extract them as a 55 | package when you're ready, kind of like a vimrc file. Again, just read the 56 | extension guide, it covers what you need to know! 57 | 58 | If you have any issues (and I'm sure there'll be a few; it's a new project!) 59 | please report them [here](https://github.com/ChrisPenner/rasa/issues). 60 | 61 | 62 | Core Principles 63 | --------------- 64 | 65 | Rasa is meant to be about as modular as an editor can be. The goal is for as 66 | much code as possible to be extracted into composable extensions. If the core 67 | editing facilities can't be implemented as extensions, then the extension 68 | interface isn't powerful enough. I've taken this to its extreme, for instance 69 | the following features are implemented as rasa extensions that anyone in the 70 | community could have written. 71 | 72 | - Loading and saving files 73 | - Key bindings 74 | - Listening for keyboard events 75 | - Multiple cursors 76 | - Rendering the editor to the terminal 77 | 78 | This approach has some unique pros and cons: 79 | 80 | ### Pros 81 | 82 | - Implementing most core functionality as extensions ensures a powerful and 83 | elegant extension interface. 84 | - Flexibility; don't like the default cursor implementation? Write your own! 85 | - Adaptability; the core of Rasa is miniscule, you can mix and match 86 | extensions to build any editor you want. 87 | 88 | 89 | ### Cons 90 | 91 | - Module cross-dependencies makes the community infrastructure more fragile; 92 | We'll likely develop a solution to this as a community as time goes on. 93 | - Fragmentation; Not having a single implementation for a given feature means 94 | extensions that depend on a feature have to pick a specific implementation 95 | to augment. Over time data-structures and types will be standardized into 96 | Rasa's core to help alleviate this. 97 | 98 | Core Features 99 | ------------- 100 | 101 | As stated above, the editor itself focuses primarily on easy extensibility, so it doesn't have a lot of editing 102 | features built in, instead it focuses on standardizing a good extension API. 103 | We focus on creating a simple system so people can pick it up quickly. 104 | 105 | Here are some features of that API: 106 | 107 | ### Event Listener System 108 | 109 | All actions in the editor are triggered via an event/listener system. 110 | Extensions may subscribe to events from the editor, or from another extension 111 | and perform an action in response. The Event which triggered the listener is 112 | available as an argument). Extensions may also dispatch any kind of event at 113 | any time which other extensions may listen for. 114 | 115 | ### Actions/BufActions 116 | 117 | Extensions define things that they'd like to do using a powerful set of 118 | functions which they can embed in an `Action`. Within an action an extension 119 | may perform IO, access the available buffers, store and access extension state, 120 | and edit text. 121 | 122 | Running Tests 123 | ------------- 124 | 125 | Run all tests: 126 | 127 | - `stack test` 128 | 129 | Run only tests for core editor: 130 | 131 | - `stack test rasa` 132 | 133 | 134 | Installation 135 | ------------ 136 | 137 | At the moment you must build Rasa from source; 138 | 139 | To provide reproducible builds, Rasa uses Stack & Nix. 140 | 141 | 1. Install [stack](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html) 142 | 2. Install [nix](https://nixos.org/nix/) 143 | 3. Clone this repo and `cd` into the directory 144 | 4. Run `stack build && stack exec rasa` (you may want to alias this to `rasa`) 145 | 146 | Installation without nix (not-recommended) 147 | ------------------------------------------ 148 | 149 | 1. Install [stack](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html) 150 | 2. Clone this repo and `cd` into the directory 151 | 3. Run `stack build --no-nix && stack exec rasa --no-nix` (you may want to alias this to `rasa`) 152 | 153 | ### Troubleshooting 154 | 155 | If you have issues with nix; you may try running rasa without it with `stack build --no-nix && stack exec rasa`; 156 | You'll likely have to consider the following: 157 | 158 | - You may need to install icu4c (`brew install icu4c`), it's a dependency of the rope library rasa uses. 159 | - On linux, when the error message `Missing C libraries: icuuc, icui18n, icudata` appears, install `libicu-dev` (e.g. with `sudo apt install libicu-dev`). 160 | - You'll need to point to the icu4c lib in your stack.yaml wherever it's stored on your system. If you install 161 | using brew on your Mac, then you can add the following to your stack.yaml: 162 | 163 | ```yaml 164 | extra-lib-dirs: 165 | - /usr/local/opt/icu4c/lib 166 | extra-include-dirs: 167 | - /usr/local/opt/icu4c/include 168 | ``` 169 | 170 | - Depending on which LTS you're on, you'll likely also have to add each rasa package you use to your stack.yaml as 171 | extra-deps, here's an example: 172 | 173 | ```yaml 174 | # in stack.yaml 175 | extra-deps: 176 | - rasa-0.1.0.0 177 | - rasa-ext-cursors-0.1.0.0 178 | - rasa-ext-logger-0.1.0.0 179 | - rasa-ext-vim-0.1.0.0 180 | - text-lens-0.1.0.0 181 | - rasa-ext-files-0.1.0.0 182 | - rasa-ext-cmd-0.1.0.0 183 | - rasa-ext-slate-0.1.0.0 184 | - vty-5.14 185 | ``` 186 | 187 | Contributing 188 | ------------ 189 | 190 | Things are moving quickly, but I'd love a hand! You can get a rough idea of 191 | where you can help out at the 192 | [Roadmap](https://github.com/ChrisPenner/rasa/issues/2), feel free to leave a 193 | comment there asking any questions. 194 | 195 | Chatting about features is a key part of Rasa's development; come join us in 196 | the [Chat Room](https://gitter.im/rasa-editor/Lobby)! 197 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | -- For more details, see 2 | -- http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html 3 | 4 | packages: 5 | ./rasa 6 | ./rasa-ext-cmd 7 | ./rasa-ext-cursors 8 | ./rasa-ext-files 9 | ./rasa-ext-logger 10 | ./rasa-ext-slate 11 | ./rasa-ext-vim 12 | ./rasa-example-config 13 | ./text-lens 14 | 15 | -- uncomment the fragment below if you installed icu4c manually or see 16 | -- https://github.com/haskell/hackage-server#installing-icu 17 | -- on how to install icu4c so that the text-icu package can find it automatically 18 | -- 19 | -- package text-icu 20 | -- extra-lib-dirs: /usr/local/opt/icu4c/lib 21 | -- extra-include-dirs: /usr/local/opt/icu4c/include 22 | -------------------------------------------------------------------------------- /circle.yml: -------------------------------------------------------------------------------- 1 | machine: 2 | ghc: 3 | version: 7.10.1 4 | 5 | dependencies: 6 | pre: 7 | - wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add - 8 | - echo 'deb http://download.fpcomplete.com/ubuntu/precise stable main'|sudo tee /etc/apt/sources.list.d/fpco.list 9 | - stack upgrade 10 | - stack setup --no-nix --no-terminal 11 | 12 | override: 13 | # - stack --version 14 | - stack --no-nix --no-terminal build --only-snapshot -j 1 15 | 16 | cache_directories: 17 | - ~/.stack 18 | - .stack-work 19 | 20 | test: 21 | pre: 22 | - stack build --no-nix 23 | 24 | override: 25 | - stack test --no-nix 26 | -------------------------------------------------------------------------------- /docs/Building-An-Extension.md: -------------------------------------------------------------------------------- 1 | Building Your First Rasa Extension 2 | ================================== 3 | 4 | Glad you could join us! This will be a quick walkthrough of the steps involved 5 | in building a simple extension. After completing this tutorial you should feel 6 | comfortable building something of your own! Rasa is moving fast, so it's likely 7 | this will go out of date from time to time, if you notice that something seems 8 | a bit off; feel free to open an issue 9 | [here](https://github.com/ChrisPenner/rasa/issues), or hop into our [gitter 10 | chat](https://gitter.im/rasa-editor/Lobby)! 11 | 12 | Downloading and Setting up Rasa 13 | ------------------------------- 14 | 15 | Rasa is a Haskell project, configured in Haskell; so we're going to need a 16 | basic Haskell working environment if we're going to get anywhere. This guide 17 | assumes at least a basic familiarity with both Haskell & 18 | [Stack](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html). 19 | Go ahead and install Stack now, I'll wait! (Psst! I'd recommend 20 | `brew update && brew install haskell-stack`). Make sure you run `stack setup` 21 | before we get started. 22 | 23 | You'll also want to install 'nix' which is a tool which stack uses to guarantee 24 | reproducible builds. You can find installation instructions for nix 25 | [here](https://nixos.org/nix/). 26 | 27 | Okay, so first clone the Rasa repository; go to your favourite project's 28 | directory and run `git clone https://github.com/ChrisPenner/rasa`; this will 29 | create a new `rasa` directory, go ahead and `cd rasa` into there. 30 | 31 | Instead of going through the trouble of making a new package for our extension, 32 | we'll just build the new functionality into our user-config. You can extract it 33 | later if you like! 34 | 35 | Let's just edit the existing configuration for now, you can find it in 36 | `rasa-example-config/app/Main.hs`. It should look something like this: 37 | 38 | ```haskell 39 | module Main where 40 | 41 | import Rasa (rasa) 42 | import Rasa.Ext 43 | -- ... some other imports 44 | main :: IO () 45 | main = rasa $ do 46 | viewports 47 | vim 48 | files 49 | cursors 50 | logger 51 | slate 52 | -- some more plugins... 53 | ``` 54 | 55 | To get a feel for the different things we can do we'll be building 56 | a simple copy-paste extension. 57 | 58 | Hello World 59 | ----------- 60 | 61 | To get started let's add a simple action and see if we can even get it running. 62 | Let's make a new action to write "Hello world" to a logging file so we can see 63 | if it runs! 64 | 65 | ```haskell 66 | helloWorld :: Action () 67 | helloWorld = writeFile "hello-world.txt" "Hello, World!" 68 | 69 | main :: IO () 70 | main = rasa $ do 71 | -- some plugins... 72 | -- Add the new action here! 73 | helloWorld 74 | ``` 75 | 76 | Okay let's try again! `stack build && stack exec rasa` (you may want to alias 77 | that to something, we'll be running it a lot!) 78 | 79 | ```haskell 80 | rasa/rasa-example-config/app/Main.hs:28:14: error: 81 | - Couldn't match expected type ‘Action ()’ with actual type ‘IO ()’ 82 | - In the expression: writeFile "hello-world.txt" "Hello, World!" 83 | In an equation for ‘helloWorld’: 84 | helloWorld = writeFile "hello-world.txt" "Hello, World!" 85 | ``` 86 | 87 | Oh of course! We've declared `helloWorld` to be type `Action ()`, which can only 88 | contain statements of type `Action`. Luckily `Action` implements MonadIO so we can 89 | embed IO actions in it by using the function `liftIO`. Don't worry too much if you don't 90 | fully understand what's going on here, you can just follow along for now! 91 | 92 | ```haskell 93 | -- new import at the top! 94 | import Control.Monad.Trans 95 | 96 | -- Let's lift the writeFile call into an `Action` 97 | helloWorld :: Action () 98 | helloWorld = liftIO $ writeFile "hello-world.txt" "Hello, World!" 99 | ``` 100 | 101 | If we've done this right, then when we rebuild the editor should compile and 102 | start up! If you get an error stating that Haskell couldn't find the 103 | `Control.Monad.Trans` module then you may need to add 'mtl' to the list of 104 | build-depends in `rasa-example-config.cabal`. Okay, so how can we see whether 105 | it worked? If you're using the Vim key-bindings then you can quit using 106 | `Ctrl-C` and check your directory to see if you've got any new files! 107 | 108 | ```sh 109 | $ cat hello-world.txt 110 | Hello, World! 111 | ``` 112 | 113 | Awesome! It's working! Okay, we can run an action! what's next? I suppose it 114 | would be nice to run an action in response to some keypress right? 115 | 116 | Listening for Keypresses 117 | ------------------------ 118 | 119 | Let's change `helloWorld` into a function which 120 | takes a `Keypress` and writes the pressed key to a file! 121 | 122 | ```haskell 123 | helloWorld :: Keypress -> Action () 124 | -- Print out the characters we type! 125 | helloWorld (Keypress char _) = liftIO $ appendFile "keylog.txt" ("You pressed: " ++ [char] ++ "\n") 126 | -- Ignore other types of keypresses (arrows, escape sequences, etc.) 127 | helloWorld _ = return () 128 | ``` 129 | 130 | Okay cool! Now it should record each keypress to the `keylog.txt` file! 131 | Let's run it! 132 | 133 | ``` 134 | rasa/rasa-example-config/app/Main.hs:28:10: error: 135 | - Couldn't match expected type ‘Action ()’ 136 | with actual type ‘Keypress -> Action ()’ 137 | ``` 138 | 139 | Hrmm, right! Now that we're listening for keypress events we need to set up an 140 | event-listener! Rasa provides a way to register listeners for different events; 141 | we'll learn how to listen for any arbitrary event later; but for now it's time 142 | for `onKeypress`! 143 | 144 | ```haskell 145 | onKeypress :: (Keypress -> Action ()) -> Action ListenerId 146 | ``` 147 | 148 | So we've got our function from our event type (Keypress), so let's try 149 | registering it using `onKeypress`; The onKeypress function returns a reference 150 | to the newly created listener so that we could cancel the listener using 151 | `removeListener` later if we wanted to; but since we don't need to do that; 152 | we'll just ignore it by using `void` from `Control.Monad`. 153 | 154 | ```haskell 155 | import Control.Monad 156 | main = rasa $ do 157 | -- other extensions 158 | void $ onKeypress helloWorld 159 | ``` 160 | 161 | Okay, let's build that and run it, now in a separate terminal we'll run 162 | `tail -f keylog.txt` to watch the key events come in! Go back to the editor and 163 | hit a few keys and you should see them come streaming in! See how easy it is 164 | to get things working? 165 | 166 | Interacting With Other Extensions 167 | --------------------------------- 168 | 169 | A key part of extensions in rasa is that they can interact with other 170 | extensions! This means we can take advantage of the work that others have done 171 | before us! The main way that we interact with other extensions is to use 172 | `Action`s that they expose for us. 173 | 174 | We're doing a copy-paste sort of thing so we'll want to look at what the 175 | cursors extension provides for us to use. If we take a look at the 176 | documentation for `rasa-ext-cursors` we'll see a few things that we can do. 177 | 178 | Out of the actions they've exposed for us to use one thing that looks promising 179 | is `rangeDo`, it lets us run a function over each range that the `cursors` 180 | extension has selected. `cursors` handles many selections at the same time, 181 | which makes things a bit more complicated, but let's just pretend for now that 182 | it only handles one at a time. `rangeDo` has the following signature: 183 | 184 | ```haskell 185 | rangeDo :: (CrdRange -> BufAction a) -> BufAction [a] 186 | ``` 187 | 188 | A `CrdRange` is a construct that's part of Rasa, it represents a range of text 189 | within a buffer from a starting 'coordinate' to an ending 'coordinate'. In Rasa 190 | file positions are usually represented using the type `Coord Row Column` where 191 | Row and Column are integers representing the row and column of the position in 192 | the text. 193 | 194 | We can see that `rangeDo` takes a function which accepts a range and returns 195 | a `BufAction`, and runs it on each range, returning a list of the results 196 | inside a `BufAction`. We can use this for our copy-paste extension to go 197 | through and copy the text in each range so we can paste it later! To see if we 198 | can get it working, first let's write a basic version that just writes out the 199 | contents of each range to a file! Things get a bit tougher here, but we're 200 | going to power through it! 201 | 202 | We need a few other packages soon, so we'll have to tell stack that we want 203 | to include them in the build! We can do this by going to the 204 | `rasa-example-config.cabal` file and we'll add `data-default` and `yi-rope` to 205 | the `build-depends` list there. 206 | 207 | ```haskell 208 | -- Make sure we have these imports 209 | import Rasa.Ext.Cursors 210 | import Rasa.Ext.Views 211 | import qualified Yi.Rope as Y 212 | 213 | main = rasa $ do 214 | -- other extensions 215 | cursors 216 | void $ onKeypress copyPasta 217 | 218 | copyPasta :: Keypress -> Action () 219 | copyPasta (Keypress 'y' _) = focusDo_ $ rangeDo_ copier 220 | where 221 | copier :: CrdRange -> BufAction () 222 | copier r = do 223 | txt <- getRange r 224 | liftIO $ appendFile "copy-pasta.txt" ("You copied: " ++ Y.toString txt ++ "\n") 225 | copyPasta _ = return () 226 | ``` 227 | 228 | Okay let's unpack it a bit! We're now listening specifically for the 'y' 229 | character to be pressed, if anything else is pressed we'll just do a simple 230 | `return ()` which does nothing. When someone presses 'y' then we we run 231 | `focusDo` which lifts a `BufAction` into an `Action` which operates over only 232 | the focused buffer(s). The `BufAction` that we're running is handled by 233 | `rangeDo_`. You'll notice we're using `rangeDo_`, which is a version of 234 | `rangeDo` which discards return values resulting in just `BufAction ()`. 235 | 236 | As we discovered earlier `rangeDo` takes a function over a range, which we've 237 | defined as `copier`. The next line `txt <- getRange r` uses a rasa command 238 | `getRange` which just gets the text of a specific range from the buffer. 239 | There's a trick though, the text which comes out is actually a `YiString` which 240 | comes from the `Yi.Rope` library, we need to convert it to a string from the 241 | rope so we'll use `Y.toString` from the rope library so we can write it to 242 | file. We then append the text to the `copy-pasta.txt` file. 243 | 244 | Let's try it out. Hopefully it builds for you and you can test it out by moving 245 | the cursor around and pressing 'y' to write out the current character to the 246 | `copy-pasta.txt` file (you can watch it with `tail -f copy-pasta.txt`). 247 | 248 | If you're new to Vim bindings (these are a bit different after all) you can 249 | move the cursor around the screen by using the `hjkl` keys. 250 | 251 | Storing Extension State for Later 252 | --------------------------------- 253 | 254 | We've got a good start at this point! If you like you can add multiple cursors 255 | using the cursors extension (for example `J` will add a new cursor on the line 256 | below) and should see that each cursor's contents is copied to the file! The 257 | next thing we'll need to do is to store the last thing we've copied so that we 258 | can paste it back later, we could just store it in a file, but this gets tricky 259 | and inefficient for more complicated data-structures, so we'll do it another 260 | way. Rasa provides a way for each extension to store state, in fact you can 261 | store either state global to the entire editor, or we can store state local to 262 | each buffer. In this case we want the latter, that way we can keep a different 263 | copy-paste register for each buffer. 264 | 265 | Let's see how we can store some persistent state in the Buffer that we can 266 | access later. We need to define a custom data-type for this so that Rasa can 267 | tell it apart from all the other extension's states. Make sure that you don't 268 | directly store basic data-types like Strings or Ints or they might conflict 269 | with other extensions! Always either wrap your type with a `newtype` for your 270 | extension, or define a new `data` type. 271 | 272 | In this case we really only need to store a String which we'll paste later, so 273 | we'll just wrap `String` in a newtype called `CopyPasta` 274 | 275 | ```haskell 276 | newtype CopyPasta = CopyPasta String 277 | deriving Show 278 | ``` 279 | 280 | That was easy, note that we're deriving a `Show` instance here, Rasa requires a 281 | `Show` instance for extension states because it makes debugging them much 282 | easier! There's one more typeclass we need to implement in order to store this, 283 | it's the `Data.Default` typeclass. Basically it just states that our 284 | Extension's state has a default value which it can be initialized to. Though 285 | it's not always easy to come up with a Default state for your extension, Rasa 286 | requires it because it simplifies initializing the extensions by a great deal. 287 | 288 | Okay, let's write the Default instance! 289 | 290 | ```haskell 291 | -- New import at the top of your file! 292 | import Data.Default 293 | 294 | instance Default CopyPasta where 295 | def = CopyPasta "" 296 | ``` 297 | 298 | For now we'll just define the default to be an empty string. 299 | 300 | With that, we've got everything set up to store custom state! Let's change our 301 | copyPasta code so it copies text into the extension state rather than into a file. 302 | 303 | ```haskell 304 | copyPasta :: Keypress -> Action () 305 | copyPasta (Keypress 'y' _) = focusDo_ $ rangeDo_ copier 306 | where 307 | copier :: CrdRange -> BufAction () 308 | copier r = do 309 | txt <- getRange r 310 | setBufExt $ CopyPasta (Y.toString txt) 311 | copyPasta _ = return () 312 | ``` 313 | 314 | `setBufExt` is a special function of the following type: 315 | 316 | ```haskell 317 | setBufExt :: (Typeable ext, Show ext, Default ext) => ext -> BufAction () 318 | ``` 319 | 320 | This shows us that for a value of ANY type `ext`; so long as it can be shown, typed, 321 | and has a default, then we can store that information for later. This is also why 322 | we must wrap our types up into something unique to our extension; if we used setBufExt 323 | on an unwrapped Int it would be overwritten any time another extension stored an Int! 324 | Using a custom type ensures that no-one else can alter our state unless 325 | they have access to the `CopyPasta` type, so if we don't expose it, then we're 326 | the only ones who can make changes! 327 | 328 | So even if this builds, how can we tell if it's actually working? Well if you 329 | like you can include the `logger` extension (it should be included in 330 | the config already). This extension will print out the state of the editor after 331 | every event that it processes, so it's great for debugging! It prints them out 332 | to a file called 'logs.log' (original I know...). If `logger` is in the config 333 | then we can `tail -f logs.log` to see how our editor state changes as we perform 334 | events. Give it a try now! 335 | 336 | If you hit 'y' when a character is selected in the editor, then look at the 337 | logs in `logs.log` and squint a little, you might be able to see that one of 338 | the buffers has a `CopyPasta` object stored in with its extensions! Since we 339 | derived a `Show` instance for `CopyPasta` we should also be able to see the 340 | string that was copied! 341 | 342 | Good stuff! If you've gotten stuck on anything, please make an [issue](https://github.com/ChrisPenner/rasa/issues) for it!. 343 | 344 | Accessing Stored State 345 | ---------------------- 346 | 347 | Now for the fun part! Let's make it paste! We'll add another case to the 348 | copyPasta function that listens for the user to press the 'p' key instead, if 349 | they press 'p', then we'll paste whatever we have stored! 350 | 351 | ```haskell 352 | copyPasta :: Keypress -> Action () 353 | copyPasta (Keypress 'y' _) = focusDo_ $ rangeDo_ copier 354 | where 355 | copier :: CrdRange -> BufAction () 356 | copier r = do 357 | txt <- getRange r 358 | setBufExt $ CopyPasta (Y.toString txt) 359 | copyPasta (Keypress 'p' _) = focusDo_ paster 360 | where 361 | paster :: BufAction () 362 | paster = do 363 | CopyPasta str <- getBufExt 364 | insertText (Y.fromString str) 365 | copyPasta _ = return () 366 | ``` 367 | 368 | Firstly; notice that `getBufExt` lets us get back any state we've set with 369 | `setBufExt`. If we've never set a value of that type it will return the default 370 | instead. `getBufExt` is also able to return a value of any type; luckily by 371 | pattern matching on the left hand side `CopyPasta str <- getBufExt` the 372 | compiler infers which state to retrieve for us! Pretty cool eh? 373 | 374 | You'll see that this time we don't have to run something over every range 375 | because there's actually a useful `insertText` function exposed by the 376 | `cursors` extension! Here's the signature: 377 | 378 | ```haskell 379 | insertText :: YiString -> BufAction () 380 | ``` 381 | 382 | It takes a YiString and inserts it at the beginning of every range! How 383 | convenient! That means we can just a write a single `BufAction` that does what 384 | we need and embed it using `focusDo_`. 385 | 386 | We'll do a simple pattern match on the left of the arrow 387 | `CopyPasta str <- getbufExt` to get the string we stored earlier. Now we can 388 | use the nifty `insertText` function! It returns a `BufAction ()`, so we can 389 | just us it in-line with the other `BufAction` where we extract the state. Like 390 | most parts of Rasa `insertText` accepts a YiString; so we'll need to convert 391 | our string. At this point we'd usually just change our extension to store a 392 | `YiString` rather than a string since it's more efficient anyways; but we've 393 | come this far so let's just convert it using `Y.fromString` to turn it into 394 | the YiString we need. 395 | 396 | At this point we have a working (albeit simple) copy-pasting extension which 397 | has a separate copy-register for each buffer! We've learned how to listen for 398 | and respond to events, and store state to use later! We've also learned how to use 399 | utilities that are exported from other extensions! 400 | 401 | Dispatching Custom Events 402 | ------------------------- 403 | 404 | Let's add just one last feature, other extensions may want to know when the 405 | user copies something. Let's expose an event so that they can 'listen' for when 406 | something gets copied and do something in response! This is actually really easy 407 | to do since it's a core part of how rasa operates! 408 | 409 | First we'll define a new type that represents the behaviour. Each unique action 410 | that someone may want to listen for should have its own `newtype` or `data` type. 411 | 412 | ```haskell 413 | newtype Copied = Copied String 414 | ``` 415 | 416 | Okay! So there's a type that not only specifies what happened, but also 417 | includes the necessary data for someone to do something useful (we'll include 418 | the string that the user copied as part of the event)! 419 | 420 | If we were writing this as an extension in a separate package we'd expose the 421 | type (and probably the constructor so that people can pattern match on it). Then 422 | other folks could use the functions we expose to listen for the event just like we 423 | did with `Keypress` events! 424 | 425 | Now that we've defined the type, we need to dispatch an event each time 426 | the user copies something! Say hello to `dispatchBufEvent`! 427 | 428 | ```haskell 429 | dispatchBufEvent :: forall result eventType. (Monoid result, Typeable eventType, Typeable result) => (eventType -> BufAction result) 430 | ``` 431 | 432 | Whoah! What's going on there!? 433 | 434 | Well; because Rasa is built to be extensible; the event system is polymorphic; 435 | which means it can accept arguments of any type. The important part of the type 436 | is: `eventType -> BufAction result`. This tells us that we can use the function 437 | to dispatch any event and get a `BufAction` of the result. The first part of 438 | the signature tells us that it works for any such event or result (`forall`) 439 | where the result is a Monoid, and both can are Typeable. We won't be using the 440 | `result` of the dispatch; so we'll mostly ignore it from now. Just know that 441 | it's possible to use events to 'ask' extensions to provide you with a value in 442 | response to an event; it turns out that `()` is a Monoid; so we'll 443 | just use that when we don't want a response. 444 | 445 | Note that we're using `dispatchBufEvent` here; there's also a `dispatchEvent`; 446 | the difference is that `dispatchBufEvent` will only trigger listeners registered on 447 | the buffer where it's dispatched; and `dispatchEvent` only triggers global listeners. 448 | 449 | ```haskell 450 | newtype Copied = Copied String 451 | 452 | copyPasta :: Keypress -> Action () 453 | copyPasta (Keypress 'y' _) = focusDo_ $ rangeDo_ copier 454 | where 455 | copier :: CrdRange -> BufAction () 456 | copier r = do 457 | txt <- getRange r 458 | setBufExt $ CopyPasta (Y.toString txt) 459 | -- We'll dispatch the copied event with the text we copied! 460 | dispatchBufEvent $ Copied (Y.toString txt) 461 | copyPasta (Keypress 'p' _) = focusDo_ paster 462 | where 463 | paster :: BufAction () 464 | paster = do 465 | CopyPasta str <- getBufExt 466 | insertText (Y.fromString str) 467 | copyPasta _ = return () 468 | ``` 469 | 470 | This is what we'd expect to do, but uh-oh! We build this and we get an error! 471 | 472 | Here's a version that works! 473 | 474 | Now we're alerting any listeners each time we copy something! Don't believe me? 475 | Okay fine! Let's listen for the events so we can see them coming through! 476 | 477 | At this stage will create a utility function for other extensions to listen for 478 | our `Copied` event. We do this with the provided `addListener` or 479 | `addBufListener` functions. These are a bit confusing like `dispatchEvent`; but 480 | we'll get through it! 481 | 482 | ```haskell 483 | addBufListener :: forall result eventType. (Typeable eventType) => (eventType -> BufAction result) -> BufAction ListenerId 484 | ``` 485 | 486 | Similar to the dispatch functions this is a polymorphic function; except notice 487 | that this time the first argument is a function! `addBufListener` takes a 488 | function which accepts some event and builds a `BufAction` which ends in some 489 | result. We need to make sure that the results and event types that people use 490 | when adding listeners matches the types that we expect when we dispatch 491 | otherwise listeners won't trigger properly; so the best idea is to constrain 492 | the types and re-export the function with the proper signature. We can do that 493 | just like this: 494 | 495 | ```haskell 496 | addCopyListener :: (Copied -> BufAction ()) -> BufAction ListenerId 497 | addCopyListener = addBufListener 498 | 499 | copyListener :: Copied -> BufAction () 500 | copyListener (Copied str) = liftIO $ appendFile "copied.txt" ("Copied: " ++ str ++ "\n") 501 | 502 | newBuf :: BufAdded -> Action () 503 | newBuf (BufAdded bufRef) = bufDo_ bufRef (addCopyListener copyListener) 504 | 505 | main = rasa $ do 506 | -- other extensions 507 | onBufAdded_ $ newBuf 508 | ``` 509 | 510 | Okay so this works; but there was a bit of boiler-plate to get it going! 511 | The biggest problem is that the `Copied` event is dispatched to the Buffer where 512 | it occured; so we'll need to listen for it on that buffer. But how do we register 513 | a listener not only for all buffers; but all FUTURE buffers too? We can use 514 | the `onBufAdded` function to register an event listener which triggers each 515 | time a new buffer is added; the BufRef of the new buffer will be passed into 516 | the function via the `BufAdded` event; which we can then use with `bufDo` to 517 | run BufActions against. This is probably pretty confusing right now; that's fine. 518 | As you read the docs and use other extensions it will hopefully become more clear! 519 | 520 | So we wrote a function `newBuf` which will be run each time a new buffer is 521 | added; inside we use the BufRef we get from the event and call `bufDo_` which 522 | runs a BufAction against the buffer referred to by the given `BufRef`. The `_` 523 | means we want to ignore the result (in this case it's a ListenerId). The 524 | BufAction we pass to `bufDo` is `addCopyListener copyListener` which registers 525 | our listener for the copied event in the given buffer. 526 | 527 | ### Extracting the Extension to its own Package 528 | 529 | Now that we've built an extension we should share it with the community! 530 | 531 | If we extract it into its own package then other extensions and users can 532 | depend on it and use it in their own extensions and configurations. To do this 533 | we can use stack to create a new project for us. `cd` into the top-level rasa 534 | directory where the rest of the `rasa-ext` folders are and run 535 | `stack new rasa-ext-copy-pasta simple-library`. 536 | 537 | It's good practice to prefix your rasa extension package name with `rasa-ext` 538 | just so people can search for them easily. Running that stack command should 539 | have made a new package folder for you with a simple library package template 540 | inside. Go ahead and `cd rasa-ext-copy-pasta`. 541 | 542 | Inside here you'll see some config files and a `src` folder. You'll want to 543 | open up the `rasa-ext-copy-pasta.cabal` and make sure the info in there is 544 | correct and has the libraries we need, You'll need to move over the things from 545 | 'build-depends:' of `rasa-example-config.cabal` into this cabal file. You'll 546 | also see a `stack.yaml` inside the folder, we won't need that since the entire 547 | rasa git repository is a single stack project with its own `stack.yaml`, so go 548 | ahead and `rm stack.yaml`. 549 | 550 | At this point we can move our code over, you can delete the `Lib.hs` that's in 551 | `src` and instead make some folders inside `src`: `Rasa/Ext`. Add a new file inside 552 | `Ext` called `CopyPasta.hs`. Your structure should look something like this: 553 | 554 | ``` 555 | rasa-ext-copy-pasta 556 | ├── src 557 | │   └── Rasa 558 | │   └── Ext 559 | │   └── CopyPasta.hs 560 | ├── rasa-ext-copy-pasta.cabal 561 | ├── Setup.hs 562 | └── LICENSE 563 | ``` 564 | 565 | All extensions should be stored as a new module inside `Rasa.Ext`. Now we can 566 | go ahead and copy those functions we wrote inside `Main.hs` into our new 567 | `CopyPasta.hs` and add a module definition at the top. We'll want to only 568 | export things we're okay with other people using, so how about we export the 569 | `addCopyListener` function which sets up a custom listener, and also the 570 | `Copied` type so that users can write their own event listeners and unpack the 571 | string inside. We'll also pack up all of the setup for the key-listeners into a single 572 | Action which the user can put into their config. 573 | 574 | We'll end up with something like this: 575 | 576 | ```haskell 577 | -- CopyPasta.hs 578 | 579 | module Rasa.Ext.CopyPasta ( 580 | copyPasta 581 | , Copied(..) 582 | ) where 583 | 584 | import Rasa.Ext 585 | import Rasa.Ext.Cursors 586 | 587 | import Control.Monad.Trans 588 | import Data.Default 589 | import qualified Yi.Rope as Y 590 | 591 | newtype CopyPasta = CopyPasta String 592 | deriving Show 593 | 594 | instance Default CopyPasta where 595 | def = CopyPasta "" 596 | 597 | newtype Copied = Copied String 598 | 599 | -- We've renamed things so we can export a single 'Action' 600 | -- that the user can embed in their config. 601 | copyPasta :: Action () 602 | copyPasta = void $ onKeypress keyListener 603 | 604 | keyListener :: Keypress -> Action () 605 | keyListener (Keypress 'y' _) = do 606 | focusDo_ $ rangeDo copier 607 | where 608 | copier :: CrdRange -> BufAction String 609 | copier r = do 610 | txt <- getRange r 611 | setBufExt $ CopyPasta (Y.toString txt) 612 | dispatchBufEvent $ Copied (Y.toString txt) 613 | keyListener (Keypress 'p' _) = focusDo_ paster 614 | where 615 | paster :: BufAction () 616 | paster = do 617 | CopyPasta str <- getBufExt 618 | insertText (Y.fromString str) 619 | keyListener _ = return () 620 | ``` 621 | 622 | Lastly we need to tell cabal which modules we want to export, so we'll add 623 | `Rasa.Ext.CopyPasta` to the list in rasa-ext-copy-pasta.cabal: 624 | 625 | ```yaml 626 | exposed-modules: Rasa.Ext.CopyPasta 627 | ``` 628 | 629 | Aaaaaaand since we're doing this inside one big stack project we'll need 630 | to tell stack about it in the `stack.yaml`; add your new package to the `packages` 631 | list: 632 | 633 | ```yaml 634 | packages: 635 | # ... other packages 636 | - ./rasa-ext-copy-pasta 637 | ``` 638 | 639 | If you really wanted to do this right, you'd make a new package outside of the 640 | rasa repo; this requires setting up your own stack.yaml dependencies, which can 641 | be a bit tricky, so if you run into any trouble come make an issue and we'll 642 | see if we can sort it out! But conceptually, we've made our own package that 643 | anyone could use! All that would be left is to 644 | `stack upload rasa-ext-copy-pasta` to upload it to hackage (but please don't do 645 | that or we'll have a ton of copies of this tutorial uploaded). 646 | 647 | That's all for this episode! Go and make some of your own extensions! 648 | I'm excited to see what you come up with! 649 | 650 | There are a few other extensions included in this repo, so go ahead and take a 651 | look at how they're doing things to get a few more ideas on how to do the 652 | tricky stuff! 653 | 654 | Cheers! 655 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | ../README.md -------------------------------------------------------------------------------- /docs/rasa.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/rasa/a2680324849088ee92f063fab091de21c4c2c086/docs/rasa.png -------------------------------------------------------------------------------- /rasa-example-config/LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2016 Chris Penner 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /rasa-example-config/README.md: -------------------------------------------------------------------------------- 1 | Configuring Rasa 2 | ================ 3 | 4 | This package represents a template for a working rasa configuration. 5 | 6 | Rasa is designed to be easy to configure, both when adding extensions provided 7 | by the community, and when writing your own user-scripts. 8 | 9 | Rasa is written in Haskell, and the configuration is done in the Haskell 10 | language, don't let that scare you though, you can script Rasa and add 11 | extensions without knowing much haskell! 12 | 13 | The basic configuration will look something like this: 14 | 15 | ```haskell 16 | import Rasa 17 | import Rasa.Ext.Vim 18 | import Rasa.Ext.Cursors 19 | import Rasa.Ext.Slate 20 | import Rasa.Ext.Style 21 | 22 | main :: IO () 23 | main = rasa $ do 24 | vim 25 | cursors 26 | slate 27 | style 28 | ``` 29 | 30 | You can see that we import a few extensions at the top, then just tell rasa 31 | which ones we want to use. Easy peasy! Any extensions you add to this list 32 | can dispatch or listen for events! 33 | 34 | Now for the fun part, adding your own scripts and customizations! 35 | 36 | It turns out that extensions are just organized groups of user-scripts, so if 37 | you learn one you learn the other and there's a great [Rasa Extension 38 | Guide](https://github.com/ChrisPenner/rasa/blob/master/docs/Building-An-Extension.md) 39 | to bring you through the process! Give it a go! 40 | -------------------------------------------------------------------------------- /rasa-example-config/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-example-config/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings, RankNTypes #-} 2 | module Main where 3 | 4 | import Rasa (rasa) 5 | import Rasa.Ext 6 | import Rasa.Ext.Views 7 | import Rasa.Ext.Vim 8 | import Rasa.Ext.Files 9 | import Rasa.Ext.Logger 10 | import Rasa.Ext.Cursors 11 | import Rasa.Ext.Slate 12 | 13 | -- import Control.Monad 14 | -- import Control.Monad.Trans 15 | 16 | -- | This is the main of an executable that runs rasa with any extensions the 17 | -- user wants 18 | -- 19 | -- The @do@ block is just a normal 'Action' () 20 | 21 | main :: IO () 22 | main = rasa $ do 23 | viewports 24 | vim 25 | files 26 | cursors 27 | logger 28 | slate 29 | afterInit $ addBuffer "This is a buffer to get you started!\nYou can also pass command line args to rasa" 30 | -------------------------------------------------------------------------------- /rasa-example-config/rasa-example-config.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-example-config 2 | version: 0.1.4 3 | synopsis: Example user config for Rasa 4 | description: Example user config for Rasa 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Config 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | executable rasa 17 | hs-source-dirs: app 18 | main-is: Main.hs 19 | build-depends: base >= 4.8 && < 5 20 | , rasa 21 | , rasa-ext-views 22 | , rasa-ext-vim 23 | , rasa-ext-cursors 24 | , rasa-ext-logger 25 | , rasa-ext-files 26 | , rasa-ext-slate 27 | , lens 28 | , data-default 29 | , yi-rope 30 | , mtl 31 | , eve 32 | default-language: Haskell2010 33 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/ChrisPenner/rasa 38 | -------------------------------------------------------------------------------- /rasa-ext-cmd/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-cmd/rasa-ext-cmd.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-cmd 2 | version: 0.1.3 3 | synopsis: Rasa Ext for running commands 4 | description: Rasa Ext for running commands 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | Rasa.Ext.Cmd 20 | 21 | build-depends: base >= 4.8 && < 5 22 | , rasa 23 | , data-default 24 | , lens 25 | , text 26 | , containers 27 | default-language: Haskell2010 28 | 29 | ghc-options: -Wall 30 | 31 | source-repository head 32 | type: git 33 | location: https://github.com/ChrisPenner/rasa 34 | -------------------------------------------------------------------------------- /rasa-ext-cmd/src/Rasa/Ext/Cmd.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Cmd 2 | ( addCmd 3 | , runCmd 4 | ) where 5 | 6 | import Rasa.Ext 7 | 8 | import Control.Lens 9 | import Data.Map 10 | import Data.Default 11 | import Data.Typeable 12 | 13 | data Cmd = 14 | Cmd (Map String (String -> App ())) 15 | deriving (Typeable) 16 | 17 | instance Show Cmd where 18 | show (Cmd cmds) = show (keys cmds) 19 | 20 | instance Default Cmd where 21 | def = Cmd empty 22 | 23 | -- It would be nice to make this a little more generic, but I'm not sure how right now. 24 | -- TODO try switching to T.Text -> (T.Text -> a) -> App () 25 | addCmd :: String -> (String -> App ()) -> App () 26 | addCmd alias mkEvent = 27 | stateLens %= add 28 | where add (Cmd commands) = Cmd $ commands & at alias ?~ mkEvent 29 | 30 | runCmd :: String -> String -> App () 31 | runCmd alias args = do 32 | Cmd commands <- use stateLens 33 | let mCmd = commands^.at alias 34 | case mCmd of 35 | Just cmd -> cmd args 36 | Nothing -> return () 37 | -------------------------------------------------------------------------------- /rasa-ext-cursors/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-cursors/rasa-ext-cursors.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-cursors 2 | version: 0.1.7 3 | synopsis: Rasa Ext adding cursor(s) 4 | description: Rasa Ext adding cursor(s) 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Rasa.Ext.Cursors 19 | Rasa.Ext.Cursors.Internal.Actions 20 | Rasa.Ext.Cursors.Internal.Base 21 | build-depends: base >= 4.8 && < 5 22 | , rasa 23 | , text-lens 24 | , lens 25 | , mtl 26 | , text 27 | , yi-rope 28 | , data-default 29 | default-language: Haskell2010 30 | 31 | default-extensions: 32 | 33 | ghc-options: -Wall 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/ChrisPenner/rasa 38 | -------------------------------------------------------------------------------- /rasa-ext-cursors/src/Rasa/Ext/Cursors.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Cursors 2 | ( 3 | -- * Main 4 | cursors 5 | -- * Actions 6 | , delete 7 | , insertText 8 | , findNext 9 | , findNextFrom 10 | , findPrev 11 | , findPrevFrom 12 | 13 | -- * Working with Cursor Ranges 14 | , addRange 15 | , getRanges 16 | , setRanges 17 | , rangeDo 18 | , rangeDo_ 19 | , overRanges 20 | , moveRangesByN 21 | , moveRangesByC 22 | ) where 23 | 24 | import Rasa.Ext 25 | import Rasa.Ext.Cursors.Internal.Base 26 | import Rasa.Ext.Cursors.Internal.Actions 27 | 28 | -- | Registers listeners for the extension. The user should add this to their config. 29 | cursors :: App () 30 | cursors = onBufAdded_ $ 31 | \(BufAdded bufRef) -> bufDo_ bufRef setStyleProvider 32 | -------------------------------------------------------------------------------- /rasa-ext-cursors/src/Rasa/Ext/Cursors/Internal/Actions.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Cursors.Internal.Actions 2 | ( delete 3 | , insertText 4 | , findNext 5 | , findPrev 6 | , findNextFrom 7 | , findPrevFrom 8 | , moveRangesByN 9 | , moveRangesByC 10 | ) where 11 | 12 | import qualified Yi.Rope as Y 13 | 14 | import Control.Lens 15 | import Control.Lens.Text 16 | import Rasa.Ext 17 | import Rasa.Ext.Cursors.Internal.Base 18 | 19 | -- | Moves all Ranges that are on the same END row as the given range by the coord's row and column 20 | -- This is used to adjust cursors when things have been inserted/deleted before them in the row. 21 | moveSameLineRangesBy :: CrdRange -> Coord -> BufAction () 22 | moveSameLineRangesBy (Range _ (Coord endRow endCol)) amt = do 23 | let moveInLine r@(Range (Coord startRow startCol) _) = return $ 24 | if endRow == startRow && startCol > endCol 25 | then moveRange amt r 26 | else r 27 | rangeDo moveInLine >>= setRanges 28 | 29 | -- | Delete the text of all ranges in a buffer 30 | delete :: BufAction () 31 | delete = rangeDo_ $ \r -> do 32 | deleteRange r 33 | moveSameLineRangesBy r (negate $ sizeOfR r) 34 | 35 | -- | Insert text at the beginning of all ranges in the buffer. 36 | insertText :: Y.YiString -> BufAction () 37 | insertText txt = rangeDo_ $ \r@(Range s _) -> do 38 | insertAt s txt 39 | moveSameLineRangesBy r (Coord 0 (Y.length txt)) 40 | 41 | -- | Move all ranges to the location of the next occurence of the given text. 42 | findNext :: Y.YiString -> BufAction () 43 | findNext pat = do 44 | res <- rangeDo $ \(Range _ e) -> do 45 | off <- findNextFrom pat e 46 | let end = moveCursorByN 1 off 47 | return $ Range off end 48 | setRanges res 49 | 50 | -- | Get the 'Coord' of the next occurence of the given text after the given 'Coord' 51 | findNextFrom :: Y.YiString -> Coord -> BufAction Coord 52 | findNextFrom pat c = do 53 | txt <- getText 54 | let distance = txt ^. afterC c . asText . tillNext (Y.toText pat) . from asText . to sizeOf 55 | return (distance + c) 56 | 57 | -- | Move all ranges to the location of the previous occurence of the given text. 58 | findPrev :: Y.YiString -> BufAction () 59 | findPrev pat = do 60 | res <- rangeDo $ \(Range s _) -> do 61 | off <- findPrevFrom pat s 62 | let end = moveCursorByN 1 off 63 | return $ Range off end 64 | setRanges res 65 | 66 | -- | Get the 'Coord' of the previous occurence of the given text before the given 'Coord' 67 | findPrevFrom :: Y.YiString -> Coord -> BufAction Coord 68 | findPrevFrom pat c = do 69 | txt <- getText 70 | let distance = txt ^. beforeC c . asText . tillPrev (Y.toText pat) . from asText . to sizeOf 71 | return (c - distance) 72 | 73 | -- | Move all ranges by the given number of columns 74 | moveRangesByN :: Int -> BufAction () 75 | moveRangesByN = overRanges . fmap . moveRangeByN 76 | 77 | -- | Move all ranges by the given number of rows and columns 78 | moveRangesByC :: Coord -> BufAction () 79 | moveRangesByC = overRanges . fmap . moveRange 80 | -------------------------------------------------------------------------------- /rasa-ext-cursors/src/Rasa/Ext/Cursors/Internal/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, OverloadedStrings, Rank2Types #-} 2 | 3 | module Rasa.Ext.Cursors.Internal.Base 4 | ( rangeDo 5 | , rangeDo_ 6 | , overRanges 7 | , getRanges 8 | , setRanges 9 | , overEachRange 10 | , addRange 11 | , setStyleProvider 12 | ) where 13 | 14 | 15 | import Rasa.Ext 16 | 17 | import Control.Monad.State 18 | import Control.Lens 19 | import Data.Typeable 20 | import Data.List 21 | import Data.Default 22 | import qualified Yi.Rope as Y 23 | 24 | -- | Stores the cursor ranges in each buffer. 25 | data Cursors = 26 | Cursors [CrdRange] 27 | deriving (Typeable, Show) 28 | 29 | instance Default Cursors where 30 | def = Cursors [Range (Coord 0 0) (Coord 0 1)] 31 | 32 | -- | Adjusts input ranges to contain at least one character. 33 | ensureSize :: CrdRange -> CrdRange 34 | ensureSize r@(Range start end) 35 | | start == end = 36 | if start^.coordCol == 0 then r & rEnd %~ moveCursorByN 1 37 | else r & rStart %~ moveCursorByN (-1) 38 | | otherwise = r 39 | 40 | -- | Sorts Ranges, removes duplicates, ensures they contain at least one character 41 | -- and restricts them to fit within the given text. 42 | cleanRanges :: Y.YiString -> [CrdRange] -> [CrdRange] 43 | cleanRanges txt = fmap (ensureSize . clampRange txt) . reverse . nub . sort 44 | 45 | -- | Get the list of ranges 46 | getRanges :: BufAction [CrdRange] 47 | getRanges = do 48 | Cursors ranges <- getBufExt 49 | return ranges 50 | 51 | setRanges :: [CrdRange] -> BufAction () 52 | setRanges new = do 53 | txt <- getText 54 | setBufExt . Cursors $ cleanRanges txt new 55 | 56 | overRanges :: ([CrdRange] -> [CrdRange]) -> BufAction () 57 | overRanges f = getRanges >>= setRanges . f 58 | 59 | -- | Sequences actions over each range as a 'BufAction' 60 | rangeDo :: (CrdRange -> BufAction a) -> BufAction [a] 61 | rangeDo f = getRanges >>= mapM f 62 | 63 | -- | 'rangeDo' with void return. 64 | rangeDo_ :: (CrdRange -> BufAction a) -> BufAction () 65 | rangeDo_ = void . rangeDo 66 | 67 | -- | Sequences actions over each range and replaces each range with its result. 68 | overEachRange :: (CrdRange -> BufAction CrdRange) -> BufAction () 69 | overEachRange f = rangeDo f >>= setRanges 70 | 71 | -- | Adds a new range to the list of ranges. 72 | addRange :: CrdRange -> BufAction () 73 | addRange r = overRanges (r:) 74 | 75 | -- | Adds cursor specific styles 76 | setStyleProvider :: BufAction () 77 | setStyleProvider = void . addStyleProvider $ rangeDo setStyle 78 | where 79 | setStyle :: CrdRange -> BufAction (Span CrdRange Style) 80 | setStyle r = return $ Span r (flair ReverseVideo) 81 | -------------------------------------------------------------------------------- /rasa-ext-cursors/test/Rasa/Ext/CursorsSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.VimSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = do 7 | describe "Rasa.Ext.Vim" $ do 8 | context "Normal Mode" $ do 9 | it "moveRangesByC" $ 10 | bufferTextTest "" "" $ do 11 | -------------------------------------------------------------------------------- /rasa-ext-cursors/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /rasa-ext-files/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-files/rasa-ext-files.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-files 2 | version: 0.1.5 3 | synopsis: Rasa Ext for filesystem actions 4 | description: Rasa Ext for filesystem actions 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | Rasa.Ext.Files 20 | 21 | build-depends: base >= 4.8 && < 5 22 | , rasa 23 | , rasa-ext-views 24 | , rasa-ext-cmd 25 | , data-default 26 | , lens 27 | , text 28 | , mtl 29 | , yi-rope 30 | default-language: Haskell2010 31 | 32 | default-extensions: 33 | 34 | ghc-options: -Wall 35 | 36 | source-repository head 37 | type: git 38 | location: https://github.com/ChrisPenner/rasa 39 | -------------------------------------------------------------------------------- /rasa-ext-files/src/Rasa/Ext/Files.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | OverloadedStrings 3 | #-} 4 | 5 | module Rasa.Ext.Files 6 | ( files 7 | , save 8 | ) where 9 | 10 | import qualified Data.Text.IO as TIO 11 | import System.Environment 12 | 13 | import Data.Typeable 14 | import Data.Default 15 | import Data.Maybe 16 | 17 | import Control.Monad 18 | import Control.Monad.Trans 19 | import qualified Yi.Rope as Y 20 | 21 | import Rasa.Ext 22 | import Rasa.Ext.Views 23 | import Rasa.Ext.Cmd 24 | 25 | -- | Stores filename 26 | data FileInfo = 27 | FileInfo (Maybe String) 28 | deriving (Typeable, Show, Eq) 29 | 30 | instance Default FileInfo where 31 | def = FileInfo Nothing 32 | 33 | type Filename = String 34 | 35 | -- | Stores File status; Clean means all changes are saved 36 | data FileStatus = 37 | Dirty 38 | | Clean 39 | deriving Show 40 | 41 | instance Default FileStatus where 42 | def = Clean 43 | 44 | -- | Returns 'FileStatus' of current buffer 45 | getFileStatus :: BufAction FileStatus 46 | getFileStatus = getBufExt 47 | 48 | -- | Sets 'FileStatus' of current buffer 49 | setFileStatus :: FileStatus -> BufAction () 50 | setFileStatus = setBufExt 51 | 52 | -- | Gets filename of current buffer 53 | getFilename :: BufAction (Maybe Filename) 54 | getFilename = do 55 | FileInfo filename <- getBufExt 56 | return filename 57 | 58 | -- | Main export, use this in your Rasa config 59 | files :: App () 60 | files = do 61 | onEveryNewBuffer_ $ do 62 | void . onBufTextChanged $ bufferChanged 63 | void . addTopStatus $ fileStatus 64 | void . addTopStatus $ (fmap Y.fromString <$> getFilename) 65 | 66 | afterInit $ do 67 | loadFiles 68 | addCmd "save" $ focusDo_ . saveAs 69 | 70 | -- | Renders the current file status 71 | fileStatus :: BufAction (Maybe RenderInfo) 72 | fileStatus = do 73 | hasFilename <- isJust <$> getFilename 74 | status <- getFileStatus 75 | if hasFilename 76 | then return . Just $ 77 | case status of 78 | Dirty -> styleText "✘" $ fg Red 79 | Clean -> styleText "✓" $ fg Green 80 | else return Nothing 81 | 82 | -- | Keeps track of buffer status 83 | bufferChanged :: BufTextChanged -> BufAction () 84 | bufferChanged _ = setFileStatus Dirty 85 | 86 | saveAs :: String -> BufAction () 87 | saveAs fName = getText >>= liftIO . TIO.writeFile fName . Y.toText 88 | 89 | -- | Save the buffer if we have a filename 90 | save :: BufAction () 91 | save = do 92 | FileInfo mName <- getBufExt 93 | case mName of 94 | Just fName -> saveAs fName 95 | Nothing -> return () 96 | setFileStatus Clean 97 | 98 | -- | Set the filename 99 | setFilename :: String -> BufAction () 100 | setFilename fname = setBufExt $ FileInfo (Just fname) 101 | 102 | -- | Add a buffer for a file 103 | addFile :: String -> Y.YiString -> App () 104 | addFile fname txt = do 105 | newBuf <- addBuffer txt 106 | bufDo_ newBuf (setFilename fname) 107 | 108 | -- | Load files from command line 109 | loadFiles :: App () 110 | loadFiles = do 111 | fileNames <- liftIO getArgs 112 | fileTexts <- liftIO $ traverse TIO.readFile fileNames 113 | mapM_ (uncurry addFile) $ zip fileNames (Y.fromText <$> fileTexts) 114 | -------------------------------------------------------------------------------- /rasa-ext-logger/README.md: -------------------------------------------------------------------------------- 1 | Logger 2 | ====== 3 | See the docs on [Hackage](hackage.haskell.org/package/rasa-ext-logger) 4 | 5 | This is a basic logging extension, it's really quite useful for debugging when 6 | working on extensions. If you add `logger` to your configuration then logger will 7 | record a snapshot of the editor every time an event is fired into the file `logs.log` 8 | in the directory where you run `rasa`. 9 | 10 | It also exports a few Actions which extensions can borrow to simplify their logging. 11 | 12 | - logInfo 13 | - logError 14 | 15 | These functions simply write any strings passed to them to the `info.log` and 16 | `error.log` files respectively. 17 | -------------------------------------------------------------------------------- /rasa-ext-logger/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-logger/rasa-ext-logger.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-logger 2 | version: 0.1.4 3 | synopsis: Rasa Ext for logging state/actions 4 | description: Rasa Ext for logging state/actions 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | Rasa.Ext.Logger 20 | 21 | build-depends: base >= 4.8 && < 5 22 | , rasa 23 | , lens 24 | , mtl 25 | , lens 26 | default-language: Haskell2010 27 | 28 | default-extensions: 29 | 30 | ghc-options: -Wall 31 | 32 | source-repository head 33 | type: git 34 | location: https://github.com/ChrisPenner/rasa 35 | -------------------------------------------------------------------------------- /rasa-ext-logger/src/Rasa/Ext/Logger.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Logger 2 | ( logger 3 | , logInfo 4 | , logError 5 | ) where 6 | 7 | import Rasa.Ext 8 | 9 | import Control.Monad.State 10 | import Control.Monad.IO.Class (MonadIO) 11 | 12 | logger :: App () 13 | logger = do 14 | liftIO $ writeFile "logs.log" "Event Log\n" 15 | onEveryRender_ $ return () 16 | -- ed <- getEditor 17 | -- liftIO $ appendFile "logs.log" (show ed) 18 | 19 | logInfo :: MonadIO m => String -> m () 20 | logInfo msg = liftIO $ appendFile "info.log" ("INFO: " ++ msg ++ "\n") 21 | 22 | logError :: MonadIO m => String -> m () 23 | logError msg = liftIO $ appendFile "error.log" ("ERROR: " ++ msg ++ "\n") 24 | -------------------------------------------------------------------------------- /rasa-ext-slate/README.md: -------------------------------------------------------------------------------- 1 | Slate 2 | ===== 3 | See the docs on [Hackage](hackage.haskell.org/package/rasa-ext-slate) 4 | 5 | **Slate** is a **Renderer** for Rasa, that basically means that it helps you 6 | see and interact with the editor. That all sounds impressive, but behind the 7 | scenes it actually operates just like any other extension; it can listen for 8 | and respond to events, and can dispatch events in response to user actions. 9 | 10 | There's nothing special about the Slate renderer, it just happens to be the first 11 | one. You could write your own renderer or event listener if you like! In fact 12 | you could even write a separate extension to listen for events from the extension 13 | that renders to screen! Or mix and match more than one renderer and event source; 14 | Endless possibilities! 15 | 16 | There are a few things that Renderers do that *most* other extensions don't; 17 | for one they tend to display things to screen (either the terminal, or by 18 | sending data to a GUI app). Renderers also typically listen for user 19 | interactions and fire events as a result. For example Slate listens for user 20 | keypresses and dispatches an event each time a key is pressed. 21 | 22 | Slate itself is implemented using the 23 | [vty](http://hackage.haskell.org/package/vty) terminal library. It uses vty to 24 | listen for keypresses and print text to the terminal. When the `OnRender` event 25 | fires vty takes the current application state and renders it out to the screen. 26 | There's nothing special about the way this happens, it's just regular ol' `IO`. 27 | 28 | Feel free to look around and see how slate does things! 29 | -------------------------------------------------------------------------------- /rasa-ext-slate/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-slate/rasa-ext-slate.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-slate 2 | version: 0.1.8 3 | synopsis: Rasa extension for rendering to terminal with vty 4 | description: Rasa extension for rendering to terminal with vty 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | Rasa.Ext.Slate 20 | Rasa.Ext.Slate.Internal.Render 21 | Rasa.Ext.Slate.Internal.Event 22 | Rasa.Ext.Slate.Internal.State 23 | Rasa.Ext.Slate.Internal.Attributes 24 | 25 | build-depends: base >= 4.8 && < 5 26 | , rasa 27 | , rasa-ext-views 28 | , recursion-schemes 29 | , text 30 | , mtl 31 | , yi-rope 32 | , lens 33 | , vty >= 5.25 34 | , rasa-ext-logger 35 | default-language: Haskell2010 36 | 37 | ghc-options: -Wall 38 | 39 | source-repository head 40 | type: git 41 | location: https://github.com/ChrisPenner/rasa 42 | -------------------------------------------------------------------------------- /rasa-ext-slate/src/Rasa/Ext/Slate.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Slate (slate) where 2 | 3 | import Rasa.Ext 4 | import Rasa.Ext.Slate.Internal.Render 5 | import Rasa.Ext.Slate.Internal.Event 6 | import Rasa.Ext.Slate.Internal.State 7 | 8 | import qualified Graphics.Vty as V 9 | import Control.Monad.IO.Class 10 | 11 | -- | The main export for this extension. Add this to your user config. 12 | -- 13 | -- e.g. 14 | -- 15 | -- > rasa $ do 16 | -- > slate 17 | -- > ... 18 | slate :: App () 19 | slate = do 20 | terminalEvents 21 | onEveryRender_ renderAll 22 | onExit shutdown 23 | 24 | -- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states) 25 | shutdown :: App () 26 | shutdown = do 27 | v <- getVty 28 | liftIO $ V.shutdown v 29 | -------------------------------------------------------------------------------- /rasa-ext-slate/src/Rasa/Ext/Slate/Internal/Attributes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Rasa.Ext.Slate.Internal.Attributes where 3 | 4 | import Rasa.Ext 5 | import qualified Yi.Rope as Y 6 | import qualified Graphics.Vty as V 7 | import Data.Bifunctor 8 | import Data.Text (Text, pack) 9 | 10 | -- | Convert style from "Rasa.Ext.Style" into 'V.Attr's 11 | convertStyle :: Style -> V.Attr 12 | convertStyle (Style (fg', bg', flair')) = V.Attr 13 | (maybe V.KeepCurrent convertFlair flair') 14 | (maybe V.KeepCurrent convertColor fg') 15 | (maybe V.KeepCurrent convertColor bg') 16 | (maybe V.KeepCurrent convertUrl (Just "")) 17 | 18 | -- | Convert flair from "Rasa.Ext.Style" into 'V.Style's 19 | convertFlair :: Flair -> V.MaybeDefault V.Style 20 | convertFlair Standout = V.SetTo V.standout 21 | convertFlair Underline = V.SetTo V.underline 22 | convertFlair ReverseVideo = V.SetTo V.reverseVideo 23 | convertFlair Blink = V.SetTo V.blink 24 | convertFlair Dim = V.SetTo V.dim 25 | convertFlair Bold = V.SetTo V.bold 26 | convertFlair Italic = V.SetTo V.italic 27 | convertFlair DefFlair = V.Default 28 | 29 | -- | Convert colors from "Rasa.Ext.Style" into 'V.Color's 30 | convertColor :: Color -> V.MaybeDefault V.Color 31 | convertColor Black = V.SetTo V.black 32 | convertColor Red = V.SetTo V.red 33 | convertColor Green = V.SetTo V.green 34 | convertColor Yellow = V.SetTo V.yellow 35 | convertColor Blue = V.SetTo V.blue 36 | convertColor Magenta = V.SetTo V.magenta 37 | convertColor Cyan = V.SetTo V.cyan 38 | convertColor White = V.SetTo V.white 39 | convertColor DefColor = V.Default 40 | 41 | convertUrl :: Text -> V.MaybeDefault Text 42 | convertUrl = V.SetTo 43 | 44 | -- | helper to reset to default attributes 45 | reset :: V.Image 46 | reset = V.text' V.defAttr "" 47 | 48 | -- | A newtype to define a (not necessarily law abiding) Monoid for 'V.Attr' which acts as we like. 49 | newtype AttrMonoid = AttrMonoid { 50 | getAttr :: V.Attr 51 | } 52 | 53 | instance Semigroup AttrMonoid where 54 | AttrMonoid v <> AttrMonoid v' = AttrMonoid $ v <> v' 55 | 56 | 57 | -- | We want 'mempty' to be 'V.defAttr' instead of 'V.currentAttr' for use in 'combineSpans'. 58 | instance Monoid AttrMonoid where 59 | mempty = AttrMonoid V.defAttr 60 | 61 | -- | Apply a list of styles to the given text, resulting in a 'V.Image'. 62 | applyAttrs :: RenderInfo -> V.Image 63 | applyAttrs (RenderInfo txt styles) = textAndStylesToImage mergedSpans (padSpaces <$> Y.lines txt) 64 | where mergedSpans = second getAttr <$> combineSpans (fmap AttrMonoid <$> atts) 65 | -- Newlines aren't rendered; so we replace them with spaces so they're selectable 66 | padSpaces = (`Y.append` " ") 67 | atts = second convertStyle <$> styles 68 | 69 | -- | Makes and image from text and styles 70 | textAndStylesToImage :: [(Coord, V.Attr)] -> [Y.YiString] -> V.Image 71 | textAndStylesToImage atts lines' = V.vertCat $ wrapResets . uncurry attrLine <$> pairLines atts lines' 72 | where 73 | wrapResets img = reset V.<|> img V.<|> reset 74 | 75 | -- | Applies the list of attrs to the line and returns a 'V.Image'. It assumes that the list 76 | -- contains only 'Coord's on the same line (i.e. row == 0) 77 | -- 78 | -- Should be able to clean this up and provide better guarantees if I do a scan 79 | -- over attrs and get each successive mappend of them, then do T.splitAt for 80 | -- each offset, then apply the attr for each section at the begining of each 81 | -- of T.lines within each group. Ugly I know. 82 | attrLine :: [(Coord, V.Attr)] -> Y.YiString -> V.Image 83 | attrLine [] txt = plainText txt 84 | attrLine atts "" = V.text' (mconcat (snd <$> atts)) "" 85 | attrLine ((Coord _ 0, attr):atts) txt = V.text' attr "" V.<|> attrLine atts txt 86 | attrLine atts@((Coord _ col, _):_) txt = 87 | let (prefix, suffix) = Y.splitAt col txt 88 | in plainText prefix V.<|> attrLine (decrCol col atts) suffix 89 | 90 | -- | Pairs up lines with their styles. 91 | pairLines :: [(Coord, b)] -> [a] -> [([(Coord, b)], a)] 92 | pairLines _ [] = [] 93 | pairLines [] ls = zip (repeat []) ls 94 | pairLines crds@((Coord 0 _, _):_) (l:ls) = (takeWhile isSameRow crds, l) : pairLines (decrRow $ dropWhile isSameRow crds) ls 95 | where isSameRow (Coord 0 _, _) = True 96 | isSameRow _ = False 97 | pairLines crds (l:ls) = ([], l): pairLines (decrRow crds) ls 98 | 99 | -- | Decrements the row of all future attrs' location 100 | decrRow :: [(Coord, a)] -> [(Coord, a)] 101 | decrRow = fmap (\(Coord r c, a) -> (Coord (r-1) c, a)) 102 | 103 | -- | Decrements the column of all future attrs' location by the given amount 104 | decrCol :: Int -> [(Coord, a)] -> [(Coord, a)] 105 | decrCol n = fmap (\(Coord r c, a) -> (Coord r (c-n), a)) 106 | 107 | -- | Creates a text image without any new attributes. 108 | plainText :: Y.YiString -> V.Image 109 | plainText = V.text' V.currentAttr . Y.toText 110 | -------------------------------------------------------------------------------- /rasa-ext-slate/src/Rasa/Ext/Slate/Internal/Event.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Slate.Internal.Event (terminalEvents) where 2 | 3 | import Rasa.Ext 4 | import Rasa.Ext.Slate.Internal.State 5 | 6 | import Control.Monad 7 | 8 | import qualified Graphics.Vty as V 9 | 10 | -- | Provides keypress events from the terminal, converted from Vty events. 11 | terminalEvents :: App () 12 | terminalEvents = do 13 | v <- getVty 14 | asyncActionProvider $ getEvents v 15 | where 16 | getEvents v dispatch = forever $ V.nextEvent v >>= dispatch . dispatchKeypress . convertEvent 17 | 18 | -- | Converts a 'V.Event' into a keypress if possible. 19 | convertEvent :: V.Event -> Keypress 20 | convertEvent (V.EvKey e mods) = convertKeypress e mods 21 | convertEvent _ = KUnknown 22 | 23 | -- | Converts a 'V.Event' into a keypress if possible. 24 | convertKeypress :: V.Key -> [V.Modifier] -> Keypress 25 | convertKeypress V.KEsc mods = KEsc (fmap convertMod mods) 26 | convertKeypress (V.KChar c) mods = Keypress c (fmap convertMod mods) 27 | convertKeypress V.KBS mods = KBS (fmap convertMod mods) 28 | convertKeypress V.KEnter mods = KEnter (fmap convertMod mods) 29 | convertKeypress V.KLeft mods = KLeft (fmap convertMod mods) 30 | convertKeypress V.KRight mods = KRight (fmap convertMod mods) 31 | convertKeypress V.KUp mods = KUp (fmap convertMod mods) 32 | convertKeypress V.KDown mods = KDown (fmap convertMod mods) 33 | convertKeypress V.KPrtScr mods = KPrtScr (fmap convertMod mods) 34 | convertKeypress V.KHome mods = KHome (fmap convertMod mods) 35 | convertKeypress V.KPageUp mods = KPageUp (fmap convertMod mods) 36 | convertKeypress V.KDel mods = KDel (fmap convertMod mods) 37 | convertKeypress V.KEnd mods = KEnd (fmap convertMod mods) 38 | convertKeypress V.KPageDown mods = KPageDown (fmap convertMod mods) 39 | convertKeypress _ _ = KUnknown 40 | 41 | -- | Converts a 'V.Modifier' into a 'Mod'. 42 | convertMod :: V.Modifier -> Mod 43 | convertMod m = case m of 44 | V.MShift -> Shift 45 | V.MCtrl -> Ctrl 46 | V.MMeta -> Meta 47 | V.MAlt -> Alt 48 | -------------------------------------------------------------------------------- /rasa-ext-slate/src/Rasa/Ext/Slate/Internal/Render.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | FlexibleInstances 3 | , MultiParamTypeClasses 4 | , OverloadedStrings 5 | , ExistentialQuantification 6 | #-} 7 | module Rasa.Ext.Slate.Internal.Render 8 | ( renderAll 9 | , Renderable(..) 10 | ) where 11 | 12 | import Rasa.Ext 13 | import Rasa.Ext.Views 14 | import Rasa.Ext.Slate.Internal.State 15 | import Rasa.Ext.Slate.Internal.Attributes 16 | import Data.Functor.Foldable 17 | 18 | import qualified Graphics.Vty as V 19 | import Control.Lens 20 | import Control.Monad.IO.Class 21 | 22 | -- | Get the current terminal size. 23 | getSize :: App (Width, Height) 24 | getSize = do 25 | v <- getVty 26 | liftIO $ V.displayBounds $ V.outputIface v 27 | 28 | -- | Render the Editor 29 | renderAll :: App () 30 | renderAll = do 31 | (width, height) <- getSize 32 | mViews <- getViews 33 | maybe (return ()) (vtyUpdate width height) mViews 34 | where 35 | vtyUpdate width height win = do 36 | img <- renderWindow win width height 37 | let pic = V.picForImage img 38 | v <- getVty 39 | liftIO $ V.update v pic 40 | 41 | -- | Divides up available space according to the given 'SplitRule'. 42 | splitByRule :: SplitRule -> Int -> (Int, Int) 43 | splitByRule (Ratio p) sz = (start, end) 44 | where 45 | start = ceiling $ fromIntegral sz * p 46 | end = floor $ fromIntegral sz * (1 - p) 47 | 48 | splitByRule (FromStart amt) sz = (start, end) 49 | where 50 | start = min sz amt 51 | end = sz - start 52 | 53 | splitByRule (FromEnd amt) sz = (start, end) 54 | where 55 | start = sz - end 56 | end = min sz amt 57 | 58 | -- | Recursively render components of a Window to a 'V.Image' combining the results in the proper locations. 59 | renderWindow :: BiTree Split View -> Width -> Height -> App V.Image 60 | renderWindow = cata alg 61 | where 62 | mkBorder = V.charFill (V.defAttr `V.withForeColor` V.green) 63 | vertBorder = mkBorder '|' 1 64 | horBorder w = mkBorder '-' w 1 65 | 66 | alg (BranchF (Split Vert spRule) left right) = \width height -> 67 | let availWidth = max 0 $ fromIntegral (width - 1) 68 | (leftWidth, rightWidth) = splitByRule spRule availWidth 69 | in do 70 | leftView <- left leftWidth height 71 | rightView <- right rightWidth height 72 | return $ leftView V.<|> vertBorder height V.<|> rightView 73 | 74 | alg (BranchF (Split Hor spRule) top bottom) = \width height -> 75 | let availHeight = max 0 $ fromIntegral (height - 1) 76 | (topHeight, bottomHeight) = splitByRule spRule availHeight 77 | in do 78 | topView <- top width topHeight 79 | bottomView <- bottom width bottomHeight 80 | return $ topView V.<-> horBorder width V.<-> bottomView 81 | 82 | alg (LeafF vw) = \width height -> renderView width height vw 83 | 84 | 85 | type Top = V.Image 86 | type Bottom = V.Image 87 | type Left = V.Image 88 | type Right = V.Image 89 | 90 | -- | Renders widgets to images 91 | widgetsToImages :: Width -> Height -> ScrollPos -> Widgets -> App (Top, Bottom, Left, Right) 92 | widgetsToImages width height scrollAmt widgets = do 93 | top <- renderHorBar width (widgets^.topBar) 94 | bottom <- renderHorBar width (widgets^.bottomBar) 95 | let remainingHeight = max 0 $ height - (V.imageHeight top+ V.imageHeight bottom) 96 | left <- renderVertBar remainingHeight (widgets^.leftBar) 97 | right <- renderVertBar remainingHeight (widgets^.rightBar) 98 | return (top, bottom, left, right) 99 | where 100 | renderHorBar w rs = V.resizeWidth w . V.vertCat <$> traverse (renderToImage w 1 0) rs 101 | renderVertBar h rs = V.resizeHeight h . V.horizCat <$> traverse (renderToImage 1 h scrollAmt) rs 102 | 103 | -- | Render a given 'View' to a 'V.Image' given the context of the associated buffer and a size to render it in. 104 | renderView :: Width -> Height -> View -> App V.Image 105 | renderView width height vw = do 106 | widgets <- computeWidgets vw 107 | (top, bottom, left, right) <- widgetsToImages width height scrollAmt widgets 108 | let remainingHeight = max 0 $ height - (V.imageHeight top + V.imageHeight bottom) 109 | remainingWidth = max 0 $ width - (V.imageWidth left + V.imageWidth right) 110 | img <- V.resize remainingWidth remainingHeight <$> renderToImage remainingWidth remainingHeight scrollAmt (vw^.viewable) 111 | return $ top V.<-> (left V.<|> img V.<|> right) V.<-> bottom 112 | where 113 | scrollAmt = vw^.scrollPos 114 | 115 | renderToImage :: Renderable r => Width -> Height -> ScrollPos -> r -> App V.Image 116 | renderToImage w h scroll r = maybe V.emptyImage applyAttrs <$> render w h scroll r 117 | -------------------------------------------------------------------------------- /rasa-ext-slate/src/Rasa/Ext/Slate/Internal/State.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Slate.Internal.State (getVty) where 2 | 3 | import Rasa.Ext 4 | 5 | import Control.Lens 6 | import Control.Monad.Trans 7 | import qualified Graphics.Vty as V 8 | 9 | -- | Store 'V.Vty' state globally 10 | newtype Slate = Slate V.Vty 11 | instance Show Slate where 12 | show _ = "Slate" 13 | 14 | -- | V.Vty must be initialized, this takes IO to perform. 15 | initUi :: App V.Vty 16 | initUi = do 17 | cfg <- liftIO V.standardIOConfig 18 | v <- liftIO $ V.mkVty cfg 19 | stateLens .= Just (Slate v) 20 | return v 21 | 22 | -- | Gets vty by checking if it has been initialized yet, if not it runs the initialization. 23 | getVty :: App V.Vty 24 | getVty = do 25 | v <- use stateLens 26 | case v of 27 | Just (Slate v') -> return v' 28 | Nothing -> initUi 29 | -------------------------------------------------------------------------------- /rasa-ext-views/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-views/rasa-ext-views.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-views 2 | version: 0.1.6 3 | synopsis: Rasa Ext managing rendering views 4 | description: Rasa Ext managing rendering views 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | cabal-version: >=1.10 14 | 15 | library 16 | hs-source-dirs: src 17 | exposed-modules: Rasa.Ext.Views 18 | Rasa.Ext.Views.Internal.BiTree 19 | Rasa.Ext.Views.Internal.Views 20 | Rasa.Ext.Views.Internal.Actions 21 | Rasa.Ext.Views.Internal.Widgets 22 | Rasa.Ext.Views.Internal.LineNumbers 23 | Rasa.Ext.Views.Internal.ActiveBar 24 | Rasa.Ext.Views.Internal.AnyRenderable 25 | Rasa.Ext.Views.Internal.StatusBar 26 | 27 | build-depends: base >= 4.8 && < 5 28 | , rasa 29 | , lens 30 | , data-default 31 | , bifunctors 32 | , recursion-schemes 33 | , mtl 34 | , yi-rope 35 | default-language: Haskell2010 36 | 37 | default-extensions: 38 | 39 | ghc-options: -Wall 40 | 41 | source-repository head 42 | type: git 43 | location: https://github.com/ChrisPenner/rasa 44 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Views 2 | ( viewports 3 | -- * Working with Views 4 | , View(..) 5 | , viewable 6 | , splitRule 7 | , active 8 | , scrollPos 9 | , getViews 10 | 11 | -- * View Structure 12 | -- | Views are stored as a Tree, with 'Split's determining 13 | -- the layout of each branch. 14 | , Split(..) 15 | , Dir(..) 16 | , SplitRule(..) 17 | , Window 18 | , BiTree(..) 19 | , BiTreeF(..) 20 | 21 | 22 | -- * ProvidedApps 23 | , A.rotate 24 | , A.closeInactive 25 | , A.focusViewLeft 26 | , A.focusViewRight 27 | , A.focusViewAbove 28 | , A.focusViewBelow 29 | , A.hSplit 30 | , A.vSplit 31 | , A.addSplit 32 | , A.nextBuf 33 | , A.prevBuf 34 | , A.focusDo 35 | , A.focusDo_ 36 | , A.focusedBufs 37 | , A.isFocused 38 | , A.scrollBy 39 | 40 | -- * Creating Widgets 41 | , Widgets 42 | 43 | -- | Lenses for accessing parts of 'Widgets': 44 | , topBar 45 | , bottomBar 46 | , leftBar 47 | , rightBar 48 | , HasWidgets(..) 49 | 50 | -- ** Providing Widgets 51 | -- | The following functions register a BufAction which yields some renderable; 52 | -- On each render that renderable will be used as a top/bottom/left/right bar respectively. 53 | , addTopBar 54 | , addBottomBar 55 | , addLeftBar 56 | , addRightBar 57 | 58 | -- * Provided Widgets 59 | , enableLineNumbers 60 | , disableLineNumbers 61 | , toggleLineNumbers 62 | , checkLineNumbers 63 | 64 | , addTopStatus 65 | , addBottomStatus 66 | ) where 67 | 68 | import Rasa.Ext 69 | import Rasa.Ext.Views.Internal.BiTree 70 | import Rasa.Ext.Views.Internal.Views 71 | import Rasa.Ext.Views.Internal.Widgets 72 | import Rasa.Ext.Views.Internal.LineNumbers 73 | import Rasa.Ext.Views.Internal.StatusBar 74 | import Rasa.Ext.Views.Internal.Actions as A 75 | 76 | -- | Main export from the views extension, add this to your rasa config. 77 | viewports :: App () 78 | viewports = do 79 | onBufAdded_ A.addSplit 80 | lineNumbers 81 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/Actions.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Views.Internal.Actions 2 | ( rotate 3 | , closeInactive 4 | , focusViewLeft 5 | , focusViewRight 6 | , focusViewAbove 7 | , focusViewBelow 8 | , hSplit 9 | , vSplit 10 | , addSplit 11 | , nextBuf 12 | , prevBuf 13 | , focusDo 14 | , focusDo_ 15 | , focusedBufs 16 | , isFocused 17 | , scrollBy 18 | ) where 19 | 20 | import Rasa.Ext 21 | import qualified Rasa.Ext.Views.Internal.Views as V 22 | import Rasa.Ext.Views.Internal.BiTree 23 | 24 | import Control.Lens 25 | import Control.Monad 26 | import Data.Maybe 27 | import Data.List 28 | 29 | -- | Flip all Horizontal splits to Vertical ones and vice versa. 30 | rotate :: App () 31 | rotate = V.overWindows V.rotate 32 | 33 | -- | Move focus from any viewports one viewport to the left 34 | focusViewLeft :: App () 35 | focusViewLeft = V.overWindows V.focusViewLeft 36 | 37 | -- | Move focus from any viewports one viewport to the right 38 | focusViewRight :: App () 39 | focusViewRight = V.overWindows V.focusViewRight 40 | 41 | -- | Move focus from any viewports one viewport above 42 | focusViewAbove :: App () 43 | focusViewAbove = V.overWindows V.focusViewAbove 44 | 45 | -- | Move focus from any viewports one viewport below 46 | focusViewBelow :: App () 47 | focusViewBelow = V.overWindows V.focusViewBelow 48 | 49 | -- | Close all inactive viewports 50 | closeInactive :: App () 51 | closeInactive = do 52 | mWindows <- V.getViews 53 | V.setViews $ mWindows >>= V.closeBy (not . view V.active) 54 | 55 | -- | Split active views horizontally 56 | hSplit :: App () 57 | hSplit = V.overWindows V.hSplit 58 | 59 | -- | Split active views vertically 60 | vSplit :: App () 61 | vSplit = V.overWindows V.vSplit 62 | 63 | -- | Add a new split at the top level in the given direction containing the given buffer. 64 | addSplit :: BufAdded -> App () 65 | addSplit (BufAdded bRef) = do 66 | mWin <- V.getViews 67 | case mWin of 68 | Nothing -> V.setViews . Just $ Leaf (V.View True (V.BufView bRef) 0) 69 | Just win -> V.setViews . Just $ V.addSplit V.Vert (V.BufView bRef) win 70 | 71 | -- | Select the next buffer in any active viewports 72 | nextBuf :: App () 73 | nextBuf = V.traverseViews next 74 | where 75 | next vw 76 | | vw ^. V.active = do 77 | newViewable <- getNextBufRef (vw^. V.viewable) 78 | return (vw & V.viewable .~ newViewable) 79 | | otherwise = return vw 80 | 81 | getNextBufRef (V.BufView br) = V.BufView <$> nextBufRef br 82 | getNextBufRef v = return v 83 | 84 | -- | Select the previous buffer in any active viewports 85 | prevBuf :: App () 86 | prevBuf = V.traverseViews prev 87 | where 88 | prev vw 89 | | vw ^. V.active = do 90 | newViewable <- getPrevBufRef (vw^. V.viewable) 91 | return (vw & V.viewable .~ newViewable) 92 | | otherwise = return vw 93 | 94 | getPrevBufRef (V.BufView br) = V.BufView <$> prevBufRef br 95 | getPrevBufRef v = return v 96 | 97 | -- | Get bufRefs for all buffers that are selected in at least one viewport 98 | focusedBufs :: App [BufRef] 99 | focusedBufs = do 100 | mWindows <- V.getViews 101 | case mWindows of 102 | Nothing -> return [] 103 | Just win -> return . nub . activeBufRefs $ win 104 | where activeBufRefs = toListOf $ traverse . filtered (view V.active) . V.viewable . V._BufViewRef 105 | 106 | -- | Returns whether the current buffer is focused in at least one view. 107 | isFocused :: BufAction Bool 108 | isFocused = do 109 | inFocus <- runApp focusedBufs 110 | br <- getBufRef 111 | return $ br `elem` inFocus 112 | 113 | -- | Run a bufAction over all focused buffers and return any results. 114 | focusDo :: BufAction a -> App [a] 115 | focusDo bufAct = do 116 | bufRefs <- focusedBufs 117 | catMaybes <$> mapM (`bufDo` bufAct) bufRefs 118 | 119 | -- | 'focusDo' with a void return 120 | focusDo_ :: BufAction a -> App () 121 | focusDo_ = void . focusDo 122 | 123 | -- | Scrolls each focused viewport by the given amount. 124 | scrollBy :: Int -> App () 125 | scrollBy amt = V.overWindows $ V.scrollBy amt 126 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/ActiveBar.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | OverloadedStrings 3 | #-} 4 | module Rasa.Ext.Views.Internal.ActiveBar 5 | ( ActiveBar(..) 6 | ) where 7 | 8 | import Rasa.Ext 9 | 10 | import qualified Yi.Rope as Y 11 | 12 | data ActiveBar = ActiveBar 13 | 14 | instance Renderable ActiveBar where 15 | render width _ _ _ = return . Just $ RenderInfo (Y.replicate width "-") [Span (Range (Coord 0 0) (Coord 0 width)) (fg Red)] 16 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/AnyRenderable.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | ExistentialQuantification 3 | #-} 4 | module Rasa.Ext.Views.Internal.AnyRenderable 5 | ( AnyRenderable(..) 6 | ) where 7 | 8 | import Rasa.Ext 9 | 10 | data AnyRenderable = 11 | forall r. Renderable r => AnyRenderable r 12 | 13 | instance Renderable AnyRenderable where 14 | render width height scrollAmt (AnyRenderable r) = render width height scrollAmt r 15 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/BiTree.hs: -------------------------------------------------------------------------------- 1 | {-# language DeriveFunctor, DeriveTraversable, TypeFamilies #-} 2 | module Rasa.Ext.Views.Internal.BiTree where 3 | 4 | import Data.Typeable 5 | import Data.Bifunctor 6 | import Data.Functor.Foldable 7 | 8 | data BiTree b l = 9 | Branch b (BiTree b l) (BiTree b l) 10 | | Leaf l 11 | deriving (Show, Typeable, Functor, Traversable, Foldable) 12 | 13 | instance Bifunctor BiTree where 14 | bimap _ g (Leaf x) = Leaf (g x) 15 | bimap f g (Branch b l r) = Branch (f b) (bimap f g l) (bimap f g r) 16 | 17 | data BiTreeF b l r = 18 | BranchF b r r 19 | | LeafF l 20 | deriving (Show, Functor, Typeable) 21 | 22 | type instance Base (BiTree a b) = BiTreeF a b 23 | instance Recursive (BiTree a b) where 24 | project (Leaf x) = LeafF x 25 | project (Branch s l r) = BranchF s l r 26 | 27 | instance Corecursive (BiTree a b) where 28 | embed (BranchF sp x xs) = Branch sp x xs 29 | embed (LeafF x) = Leaf x 30 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/LineNumbers.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.Views.Internal.LineNumbers 2 | ( lineNumbers 3 | , enableLineNumbers 4 | , disableLineNumbers 5 | , toggleLineNumbers 6 | , checkLineNumbers 7 | ) where 8 | 9 | import Rasa.Ext 10 | 11 | import Rasa.Ext.Views.Internal.Widgets 12 | import Data.Default 13 | import qualified Yi.Rope as Y 14 | 15 | newtype LineNumbers = 16 | LineNumbers Bool 17 | deriving Show 18 | 19 | instance Default LineNumbers where 20 | def = LineNumbers True 21 | 22 | enableLineNumbers :: BufAction () 23 | enableLineNumbers = setBufExt $ LineNumbers True 24 | 25 | disableLineNumbers :: BufAction () 26 | disableLineNumbers = setBufExt $ LineNumbers False 27 | 28 | toggleLineNumbers :: BufAction () 29 | toggleLineNumbers = overBufExt $ 30 | \(LineNumbers b) -> LineNumbers $ not b 31 | 32 | -- | Returns whether line numbers are currently enabled. 33 | checkLineNumbers :: BufAction Bool 34 | checkLineNumbers = do 35 | LineNumbers b <- getBufExt 36 | return b 37 | 38 | lineNumbers :: App () 39 | lineNumbers = onEveryNewBuffer_ . addLeftBar $ do 40 | enabled <- checkLineNumbers 41 | if enabled 42 | then Just <$> getLineNumbers 43 | else return Nothing 44 | where 45 | getLineNumbers = do 46 | numLines <- Y.countNewLines <$> getText 47 | return . Y.unlines $ Y.fromString . show <$> [1.. numLines + 1] 48 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/StatusBar.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | OverloadedStrings 3 | #-} 4 | module Rasa.Ext.Views.Internal.StatusBar 5 | ( getTopStatusBar 6 | , getBottomStatusBar 7 | , addTopStatus 8 | , addBottomStatus 9 | ) where 10 | 11 | import Rasa.Ext 12 | import Rasa.Ext.Views.Internal.AnyRenderable 13 | 14 | import Data.List 15 | import Data.Maybe 16 | 17 | data GetTopStatusBar = GetTopStatusBar 18 | data GetBottomStatusBar = GetBottomStatusBar 19 | data StatusBar = StatusBar [AnyRenderable] 20 | 21 | -- | Returns a Renderable StatusBar for a given buffer 22 | getTopStatusBar :: BufAction StatusBar 23 | getTopStatusBar = StatusBar <$> dispatchBufEvent GetTopStatusBar 24 | 25 | -- | Returns a Renderable StatusBar for a given buffer 26 | getBottomStatusBar :: BufAction StatusBar 27 | getBottomStatusBar = StatusBar <$> dispatchBufEvent GetBottomStatusBar 28 | 29 | -- | This registers a 'BufAction' which results in a renderable and runs it 30 | -- at render time to add the resulting 'Renderable' to the status bar. 31 | addTopStatus :: Renderable r => BufAction r -> BufAction ListenerId 32 | addTopStatus bufAction = addBufListener (const (toRenderList <$> bufAction) :: GetTopStatusBar -> BufAction [AnyRenderable]) 33 | where toRenderList x = [AnyRenderable x] 34 | 35 | addBottomStatus :: Renderable r => BufAction r -> BufAction ListenerId 36 | addBottomStatus bufAction = addBufListener (const (toRenderList <$> bufAction) :: GetBottomStatusBar -> BufAction [AnyRenderable]) 37 | where toRenderList x = [AnyRenderable x] 38 | 39 | instance Renderable StatusBar where 40 | render width _ scrollAmt (StatusBar chunks) = do 41 | parts <- traverse (render eachWidth 1 scrollAmt) chunks 42 | return . Just . mconcat . intersperse (styleText " | " (fg Red)) . catMaybes $ parts 43 | where 44 | num = length chunks 45 | eachWidth = width `div` num 46 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/Views.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | FlexibleInstances 3 | , TemplateHaskell 4 | , DeriveFunctor 5 | , GeneralizedNewtypeDeriving 6 | , ExistentialQuantification 7 | , ScopedTypeVariables 8 | , GADTs 9 | , RankNTypes 10 | #-} 11 | module Rasa.Ext.Views.Internal.Views 12 | ( rotate 13 | , splitRule 14 | , active 15 | , viewable 16 | , scrollPos 17 | , closeBy 18 | , focusViewLeft 19 | , focusViewRight 20 | , focusViewAbove 21 | , focusViewBelow 22 | , getViews 23 | , setViews 24 | , overWindows 25 | , hSplit 26 | , vSplit 27 | , addSplit 28 | , scrollBy 29 | , Dir(..) 30 | , SplitRule(..) 31 | , Window 32 | , Split(..) 33 | , View(..) 34 | , Viewable(..) 35 | , _BufViewRef 36 | , traverseViews 37 | ) where 38 | 39 | import Rasa.Ext 40 | import Rasa.Ext.Views.Internal.BiTree 41 | 42 | import Control.Lens 43 | import Data.Default 44 | import Data.Functor.Foldable 45 | 46 | -- | A 'SplitRule' determines size of each half of the split. 47 | -- 48 | -- - @Ratio Double@ sets the split to the given ratio; the double must be 49 | -- between 0 and 1; for example a value of @0.25@ sets the first portion of the 50 | -- split to 1/4 of the available space; the other portion takes the remaining 51 | -- 3/4 of the space 52 | -- 53 | -- - @FromStart Int@ makes the first half of the split (top/left respectively) 54 | -- the set number of rows or columns respectively, the other half of the split 55 | -- gets the rest. 56 | -- 57 | -- - @FromEnd Int@ makes the first half of the split (top/left respectively) 58 | -- the set number of rows or columns respectively, the other half of the split 59 | -- gets the rest. 60 | 61 | data SplitRule = 62 | Ratio Double 63 | | FromStart Int 64 | | FromEnd Int 65 | deriving (Show) 66 | 67 | instance Default SplitRule where 68 | def = Ratio 0.5 69 | 70 | -- | - 'Hor' denotes a horizontal split. 71 | -- - 'Vert' denotes a vertical split. 72 | data Dir = Hor 73 | | Vert 74 | deriving (Show) 75 | 76 | instance Default Dir where 77 | def = Vert 78 | 79 | -- | A Split contains info about a the direction and allocation of a split branch. 80 | data Split = Split 81 | { _dir :: Dir 82 | , _splitRule :: SplitRule 83 | } deriving (Show) 84 | makeLenses ''Split 85 | 86 | instance Default Split where 87 | def = Split def def 88 | 89 | -- | Represents a renderable entity 90 | data Viewable = 91 | BufView BufRef 92 | | EmptyView 93 | 94 | instance Renderable Viewable where 95 | render _ height scrollPos (BufView br) = bufDo br $ do 96 | txt <- getText 97 | styles <- getStyles 98 | return $ cropToViewport height scrollPos (RenderInfo txt styles) 99 | render _ _ _ EmptyView = return Nothing 100 | 101 | -- | Prism BufView to its bufref 102 | _BufViewRef :: Prism' Viewable BufRef 103 | _BufViewRef = prism' BufView maybeBufRef 104 | where maybeBufRef (BufView br) = Just br 105 | maybeBufRef _ = Nothing 106 | 107 | -- | A 'View' contains info about a viewport; Whether it's selected and which buffer should be displayed. 108 | data View = View 109 | { _active :: Bool 110 | , _viewable :: Viewable 111 | , _scrollPos :: Int 112 | } 113 | makeLenses ''View 114 | 115 | -- | A tree of windows branched with splits. 116 | type Window = BiTree Split View 117 | data Views where 118 | Views :: Maybe Window -> Views 119 | 120 | instance Show Views where 121 | show _ = "Views" 122 | 123 | instance Default Views where 124 | def = Views Nothing 125 | 126 | -- | Gets the stored views 127 | getViews :: App (Maybe Window) 128 | getViews = do 129 | Views mWin <- use stateLens 130 | return mWin 131 | 132 | -- | Sets the stored views 133 | setViews :: Maybe Window -> App () 134 | setViews v = stateLens .= Views v 135 | 136 | -- | Run function over stored windows 137 | overWindows :: (Window -> Window) -> App () 138 | overWindows f = do 139 | Views mWin <- use stateLens 140 | stateLens .= (Views $ fmap f mWin) 141 | 142 | -- | Flip all Horizontal splits to Vertical ones and vice versa. 143 | rotate :: Window -> Window 144 | rotate = cata alg 145 | where alg (LeafF vw) = Leaf vw 146 | alg (BranchF sp s e) = Branch (sp & dir %~ rotDir) s e 147 | rotDir Hor = Vert 148 | rotDir Vert = Hor 149 | 150 | -- | Split active views in the given direction 151 | splitView :: Dir -> Window -> Window 152 | splitView d = cata alg 153 | where alg (LeafF vw) = if vw ^. active 154 | then Branch (Split d def) (Leaf vw) (Leaf (vw & active .~ False)) 155 | else Leaf vw 156 | alg b = embed b 157 | 158 | -- | Split active views horizontally 159 | hSplit :: Window -> Window 160 | hSplit = splitView Hor 161 | 162 | -- | Split active views vertically 163 | vSplit :: Window -> Window 164 | vSplit = splitView Vert 165 | 166 | -- | Add a new split at the top level in the given direction containing the given buffer. 167 | addSplit :: Dir -> Viewable -> Window -> Window 168 | addSplit d vw = Branch (def & dir .~ d) (Leaf View{_active=False, _viewable=vw, _scrollPos=0}) 169 | 170 | -- | Close any views which match a given predicate 171 | closeBy :: (View -> Bool) -> Window -> Maybe Window 172 | closeBy p = zygo par alg 173 | where 174 | par (LeafF vw) = not $ p vw 175 | par (BranchF _ l r) = l || r 176 | alg (LeafF vw) = Just $ Leaf vw 177 | alg (BranchF sp (keepLeft, l) (keepRight, r)) 178 | | keepLeft && keepRight = Branch sp <$> l <*> r 179 | | keepLeft = l 180 | | keepRight = r 181 | | otherwise = Nothing 182 | 183 | -- | Move focus from any viewports one viewport to the left 184 | focusViewLeft :: Window -> Window 185 | focusViewLeft = ensureOneActive . zygo par alg 186 | where 187 | par (LeafF vw) = vw^.active 188 | par (BranchF (Split Hor _) l r) = l || r 189 | par (BranchF (Split Vert _) l _) = l 190 | alg (LeafF vw) = Leaf (vw & active .~ False) 191 | alg (BranchF sp@(Split Hor _) (_, l) (_, r)) = Branch sp l r 192 | alg (BranchF sp@(Split Vert _) (_, l) (fromRight, r)) = 193 | Branch sp left r 194 | where left = if fromRight 195 | then l & taking 1 (backwards traverse) . active .~ True 196 | else l 197 | 198 | -- | Move focus from any viewports one viewport to the right 199 | focusViewRight :: Window -> Window 200 | focusViewRight = ensureOneActive . zygo par alg 201 | where 202 | par (LeafF vw) = vw^.active 203 | par (BranchF (Split Hor _) l r) = l || r 204 | par (BranchF (Split Vert _) _ r) = r 205 | alg (LeafF vw) = Leaf (vw & active .~ False) 206 | alg (BranchF sp@(Split Hor _) (_, l) (_, r)) = Branch sp l r 207 | alg (BranchF sp@(Split Vert _) (fromLeft, l) (_, r)) = 208 | Branch sp l right 209 | where right = if fromLeft 210 | then r & taking 1 traverse . active .~ True 211 | else r 212 | 213 | -- | Move focus from any viewports one viewport above 214 | focusViewAbove :: Window -> Window 215 | focusViewAbove = ensureOneActive . zygo par alg 216 | where 217 | par (LeafF vw) = vw^.active 218 | par (BranchF (Split Vert _) u d) = u || d 219 | par (BranchF (Split Hor _) u _) = u 220 | alg (LeafF vw) = Leaf (vw & active .~ False) 221 | alg (BranchF sp@(Split Vert _) (_, u) (_, d)) = Branch sp u d 222 | alg (BranchF sp@(Split Hor _) (_, u) (fromBottom, d)) = 223 | Branch sp top d 224 | where top = if fromBottom 225 | then u & taking 1 (backwards traverse) . active .~ True 226 | else u 227 | 228 | -- | Move focus from any viewports one viewport below 229 | focusViewBelow :: Window -> Window 230 | focusViewBelow = ensureOneActive . zygo par alg 231 | where 232 | par (LeafF vw) = vw^.active 233 | par (BranchF (Split Vert _) u d) = u || d 234 | par (BranchF (Split Hor _) _ d) = d 235 | alg (LeafF vw) = Leaf (vw & active .~ False) 236 | alg (BranchF sp@(Split Vert _) (_, u) (_, d)) = Branch sp u d 237 | alg (BranchF sp@(Split Hor _) (fromTop, u) (_, d)) = 238 | Branch sp u bottom 239 | where bottom = if fromTop 240 | then d & taking 1 traverse . active .~ True 241 | else d 242 | 243 | -- | Ensure that there is at least one active viewport 244 | ensureOneActive :: Window -> Window 245 | ensureOneActive w = if not $ anyOf traverse _active w 246 | then w & taking 1 traverse . active .~ True 247 | else w 248 | 249 | -- | Scroll all active viewports by the given amount. 250 | scrollBy :: Int -> Window -> Window 251 | scrollBy amt = traverse.filtered (view active).scrollPos %~ scroll 252 | where 253 | scroll = max 0 . (+ amt) 254 | 255 | -- | Alters views by a given function. 256 | traverseViews :: (View -> App View) -> App () 257 | traverseViews f = do 258 | mWin <- getViews 259 | mResult <- sequence $ traverse f <$> mWin 260 | setViews mResult 261 | -------------------------------------------------------------------------------- /rasa-ext-views/src/Rasa/Ext/Views/Internal/Widgets.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | TemplateHaskell 3 | , ExistentialQuantification 4 | , RankNTypes 5 | , OverloadedStrings 6 | #-} 7 | module Rasa.Ext.Views.Internal.Widgets 8 | ( Widgets 9 | , HasWidgets(..) 10 | , addTopBar 11 | , addBottomBar 12 | , addLeftBar 13 | , addRightBar 14 | , topBar 15 | , bottomBar 16 | , leftBar 17 | , rightBar 18 | ) where 19 | 20 | import Rasa.Ext 21 | import Rasa.Ext.Views.Internal.Views 22 | import Rasa.Ext.Views.Internal.AnyRenderable 23 | import Rasa.Ext.Views.Internal.ActiveBar 24 | import Rasa.Ext.Views.Internal.StatusBar 25 | 26 | import Control.Lens 27 | import Data.Maybe 28 | import Data.Monoid 29 | 30 | 31 | -- | Represents all widgets for a given view. Can be added onto using the Monoid instance. 32 | data Widgets = Widgets 33 | { _topBar :: [AnyRenderable] 34 | , _bottomBar :: [AnyRenderable] 35 | , _leftBar :: [AnyRenderable] 36 | , _rightBar :: [AnyRenderable] 37 | } 38 | 39 | makeLenses ''Widgets 40 | 41 | instance Semigroup Widgets where 42 | (Widgets a b c d) <> (Widgets a' b' c' d') = 43 | Widgets (a<>a') (b<>b') (c<>c') (d<>d') 44 | 45 | instance Monoid Widgets where 46 | mempty = Widgets mempty mempty mempty mempty 47 | 48 | class HasWidgets r where 49 | computeWidgets :: r -> App Widgets 50 | 51 | -- | This represents types which can provide a set of widgets 52 | instance HasWidgets View where 53 | computeWidgets vw = do 54 | rest <- case vw^.viewable of 55 | EmptyView -> return mempty 56 | (BufView br) -> getBufWidgets br 57 | return $ activeBar `mappend` rest 58 | where 59 | activeBar = 60 | if vw^.active 61 | then mempty & bottomBar .~ [AnyRenderable ActiveBar] 62 | else mempty 63 | 64 | getBufWidgets br = fmap (fromMaybe mempty) . bufDo br $ do 65 | mainWidgets <- getWidgets 66 | topStatusBar <- getTopStatusBar 67 | bottomStatusBar <- getBottomStatusBar 68 | return $ mainWidgets <> widgetOf bottomBar bottomStatusBar <> widgetOf topBar topStatusBar 69 | 70 | data GetWidgets = GetWidgets 71 | 72 | widgetOf :: Renderable r => Lens' Widgets [AnyRenderable] -> r -> Widgets 73 | widgetOf l r = mempty & l .~ [AnyRenderable r] 74 | 75 | mkListenerFor :: Renderable r => Lens' Widgets [AnyRenderable] -> BufAction r -> BufAction ListenerId 76 | mkListenerFor l bufAction = addBufListener (const (widgetOf l <$> bufAction) :: GetWidgets -> BufAction Widgets) 77 | 78 | -- | Use the computed renderer as a left-bar widget 79 | addLeftBar :: Renderable r => BufAction r -> BufAction ListenerId 80 | addLeftBar = mkListenerFor leftBar 81 | 82 | -- | Use the computed renderer as a right-bar widget 83 | addRightBar :: Renderable r => BufAction r -> BufAction ListenerId 84 | addRightBar = mkListenerFor rightBar 85 | 86 | -- | Use the computed renderer as a top-bar widget 87 | addTopBar :: Renderable r => BufAction r -> BufAction ListenerId 88 | addTopBar = mkListenerFor topBar 89 | 90 | -- | Use the computed renderer as a bottom-bar widget 91 | addBottomBar :: Renderable r => BufAction r -> BufAction ListenerId 92 | addBottomBar = mkListenerFor bottomBar 93 | 94 | getWidgets :: BufAction Widgets 95 | getWidgets = dispatchBufEvent GetWidgets 96 | -------------------------------------------------------------------------------- /rasa-ext-vim/README.md: -------------------------------------------------------------------------------- 1 | Vim 2 | === 3 | See the docs on [Hackage](hackage.haskell.org/package/rasa-ext-vim) 4 | 5 | This extension more-or-less describes a Vim-style keymapping for Rasa. It's 6 | also a good example of how to write your own keymap for Rasa. 7 | 8 | A keymap isn't different from any other extension, it just listens for events 9 | (keypresses in this case) and enacts changes on the editor as a result. To make 10 | these changes a keymap depends on other extensions which export actions for 11 | actually making changes. The cursors extension provides basic editing 12 | capability, so we depend on that to do the dirty-work. It's recommended that 13 | your rasa-config should only have one key-map extension; that prevents them 14 | from stepping on each-other's toes. 15 | 16 | The Vim keymap also stores a bit of state to keep track of which mode the user 17 | is in; so that's an option too! Take a look around to see how it all works! 18 | -------------------------------------------------------------------------------- /rasa-ext-vim/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa-ext-vim/rasa-ext-vim.cabal: -------------------------------------------------------------------------------- 1 | name: rasa-ext-vim 2 | version: 0.1.8 3 | synopsis: Rasa Ext for vim bindings 4 | description: Rasa Ext for vim bindings 5 | homepage: https://github.com/ChrisPenner/rasa/ 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Extension 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Rasa.Ext.Vim 19 | build-depends: base >= 4.8 && < 5 20 | , rasa 21 | , rasa-ext-files 22 | , rasa-ext-views 23 | , rasa-ext-cursors 24 | , text 25 | , yi-rope 26 | , text-lens 27 | , data-default 28 | , lens 29 | , mtl 30 | default-language: Haskell2010 31 | 32 | default-extensions: 33 | 34 | ghc-options: -Wall 35 | 36 | test-suite rasa-test 37 | type: exitcode-stdio-1.0 38 | hs-source-dirs: test 39 | main-is: Spec.hs 40 | build-depends: base 41 | , rasa-ext-vim 42 | , hspec 43 | other-modules: 44 | Rasa.Ext.VimSpec 45 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 46 | default-language: Haskell2010 47 | default-extensions: OverloadedStrings 48 | 49 | source-repository head 50 | type: git 51 | location: https://github.com/ChrisPenner/rasa 52 | -------------------------------------------------------------------------------- /rasa-ext-vim/src/Rasa/Ext/Vim.hs: -------------------------------------------------------------------------------- 1 | {-# Language OverloadedStrings #-} 2 | module Rasa.Ext.Vim 3 | ( vim 4 | ) where 5 | 6 | import Rasa.Ext 7 | import Rasa.Ext.Views 8 | import Rasa.Ext.Files (save) 9 | import Rasa.Ext.Cursors 10 | 11 | import Control.Monad 12 | import Control.Lens 13 | import Data.Default 14 | import Data.Maybe (fromMaybe) 15 | import Data.Typeable 16 | import qualified Yi.Rope as Y 17 | 18 | -- | A type representing the current mode of a buffer 19 | data VimMode 20 | = Normal 21 | | Insert 22 | deriving (Show, Typeable) 23 | 24 | instance Default VimMode where 25 | def = Normal 26 | 27 | getMode :: BufAction VimMode 28 | getMode = getBufExt 29 | 30 | setMode :: VimMode -> BufAction () 31 | setMode = setBufExt 32 | 33 | -- | A history of any keypresses which haven't matched a pattern 34 | newtype VimHist = 35 | VimHist [Keypress] 36 | deriving (Show, Typeable) 37 | 38 | instance Default VimHist where 39 | def = VimHist [] 40 | 41 | addHist :: Keypress -> BufAction () 42 | addHist keypress = overBufExt extend 43 | where extend (VimHist hist) = VimHist $ hist ++ [keypress] 44 | 45 | getHist :: BufAction [Keypress] 46 | getHist = do 47 | VimHist h <- getBufExt 48 | return h 49 | 50 | setHist :: [Keypress] -> BufAction () 51 | setHist = setBufExt . VimHist 52 | 53 | -- | The main export for the vim keybinding extension. Add this to your user config. 54 | -- 55 | -- e.g. 56 | -- 57 | -- > rasa $ do 58 | -- > vim 59 | -- > ... 60 | vim :: App () 61 | vim = do 62 | void $ onKeypress handleKeypress 63 | onEveryNewBuffer_ . addBottomStatus $ do 64 | mode <- getMode 65 | return $ case mode of 66 | Normal -> styleText "NORMAL" $ fg Magenta 67 | Insert -> styleText "INSERT" $ fg Green 68 | 69 | -- | The event listener which listens for keypresses and responds appropriately 70 | handleKeypress :: Keypress -> App () 71 | handleKeypress keypress = focusDo_ $ do 72 | mode <- getMode 73 | preHist <- getHist 74 | case mode of 75 | Normal -> normal $ preHist ++ [keypress] 76 | Insert -> insert $ preHist ++ [keypress] 77 | anyMode $ preHist ++ [keypress] 78 | postHist <- getHist 79 | -- If nothing changed than an action must have happened 80 | unless (preHist /= postHist) (setHist []) 81 | 82 | -- | Listeners for keypresses that run regardless of current mode. 83 | anyMode :: [Keypress] -> BufAction () 84 | anyMode [Keypress 'c' [Ctrl]] = runApp exit 85 | anyMode [KPageDown []] = runApp $ scrollBy 14 -- Page down 86 | anyMode [KPageUp []] = runApp $ scrollBy (-14) -- Page up 87 | anyMode [KHome []] = startOfLine 88 | anyMode [KEnd []] = endOfLine 89 | anyMode _ = return () 90 | 91 | -- | Listeners for keypresses when in 'Insert' mode 92 | insert :: [Keypress] -> BufAction () 93 | insert [KEsc []] = setMode Normal 94 | 95 | insert [KBS []] = moveRangesByN (-1) >> delete 96 | insert [KDel []] = delete 97 | insert [KEnter []] = insertText "\n" >> moveRangesByC (Coord 1 0) >> startOfLine 98 | insert [Keypress c []] = insertText (Y.singleton c) >> moveRangesByN 1 99 | insert _ = return () 100 | 101 | -- | Listeners for keypresses when in 'Normal' mode 102 | normal :: [Keypress] -> BufAction () 103 | normal [Keypress 'i' []] = setMode Insert 104 | normal [Keypress 'I' []] = startOfLine >> setMode Insert 105 | normal [Keypress 'a' []] = moveRangesByN 1 >> setMode Insert 106 | normal [Keypress 'A' []] = endOfLine >> setMode Insert 107 | normal [Keypress '0' []] = startOfLine 108 | normal [Keypress '$' []] = endOfLine 109 | normal [Keypress 'g' []] = addHist $ Keypress 'g' [] 110 | normal [Keypress 'g' [], Keypress 'g' []] = setRanges [Range (Coord 0 0) (Coord 0 1)] 111 | normal [Keypress 's' []] = addHist $ Keypress 's' [] 112 | normal [Keypress 's' [], Keypress 'n' []] = toggleLineNumbers 113 | 114 | normal [Keypress '+' []] = runApp nextBuf 115 | normal [Keypress '-' []] = runApp prevBuf 116 | normal [Keypress 'w' [Ctrl]] = runApp hSplit 117 | normal [Keypress 'v' [Ctrl]] = runApp vSplit 118 | normal [Keypress 'o' [Ctrl]] = runApp closeInactive 119 | normal [Keypress 'r' [Ctrl]] = runApp rotate 120 | 121 | normal [Keypress 'e' [Ctrl]] = runApp $ scrollBy 1 -- Scroll down 122 | normal [Keypress 'd' [Ctrl]] = runApp $ scrollBy 7 -- Half-Page down 123 | normal [Keypress 'y' [Ctrl]] = runApp $ scrollBy (-1) -- Scroll up 124 | normal [Keypress 'u' [Ctrl]] = runApp $ scrollBy (-7) -- Half-Page up 125 | 126 | normal [KLeft []] = runApp focusViewLeft 127 | normal [KRight []] = runApp focusViewRight 128 | normal [KUp []] = runApp focusViewAbove 129 | normal [KDown []] = runApp focusViewBelow 130 | 131 | 132 | normal [Keypress 'G' []] = do 133 | txt <- getText 134 | setRanges [Range ((Offset $ Y.length txt - 1)^.asCoord txt) ((Offset $ Y.length txt)^.asCoord txt)] 135 | 136 | normal [Keypress 'o' []] = endOfLine >> insertText "\n" >> moveRangesByC (Coord 1 0) >> setMode Insert 137 | normal [Keypress 'O' []] = startOfLine >> insertText "\n" >> setMode Insert 138 | normal [Keypress 'h' []] = moveRangesByN (-1) 139 | normal [Keypress 'l' []] = moveRangesByN 1 140 | normal [Keypress 'j' []] = moveRangesByC $ Coord 1 0 141 | normal [Keypress 'k' []] = moveRangesByC $ Coord (-1) 0 142 | normal [Keypress 'J' []] = do 143 | ranges <- getRanges 144 | moveRangesByC (Coord 1 0) 145 | overRanges (ranges ++) 146 | 147 | normal [Keypress 'K' []] = do 148 | ranges <- getRanges 149 | moveRangesByC (Coord (-1) 0) 150 | overRanges (ranges ++) 151 | 152 | normal [Keypress 'w' []] = findNext " " >> moveRangesByC (Coord 0 1) 153 | normal [Keypress 'W' []] = rangeDo_ addCursor 154 | where 155 | addCursor (Range _ end) = do 156 | next <- findNextFrom " " end 157 | let newStart = moveCursorByN 1 next 158 | newEnd = moveCursorByN 1 newStart 159 | addRange $ Range newStart newEnd 160 | 161 | normal [Keypress 'b' []] = moveRangesByN (-1) >> findPrev " " 162 | normal [Keypress 'B' []] = rangeDo_ addCursor 163 | where 164 | addCursor (Range start _) = do 165 | next <- findPrevFrom " " start 166 | let newStart = next 167 | newEnd = moveCursorByN 1 newStart 168 | addRange $ Range newStart newEnd 169 | 170 | normal [Keypress 'f' []] = addHist $ Keypress 'f' [] 171 | normal [Keypress 'f' [],Keypress x []] = findNext $ Y.singleton x 172 | normal [Keypress 't' []] = addHist $ Keypress 't' [] 173 | normal [Keypress 't' [],Keypress x []] = findNext (Y.singleton x) >> moveRangesByN (-1) 174 | normal [Keypress 'T' []] = addHist $ Keypress 'T' [] 175 | normal [Keypress 'T' [],Keypress x []] = findPrev (Y.singleton x) 176 | normal [Keypress 'F' []] = addHist $ Keypress 'F' [] 177 | normal [Keypress 'F' [],Keypress x []] = findPrev (Y.singleton x) >> moveRangesByN (-1) 178 | normal [Keypress 'X' []] = moveRangesByN (-1) >> delete 179 | normal [Keypress 'x' []] = delete 180 | normal [Keypress 's' [Ctrl]] = save 181 | normal [Keypress ';' []] = do 182 | rngs <- getRanges 183 | setRanges (rngs^.reversed.to (take 1)) 184 | normal [Keypress 'r' []] = addHist $ Keypress 'r' [] 185 | normal [Keypress 'r' [],Keypress c []] = delete >> insertText (Y.singleton c) 186 | normal _ = return () 187 | 188 | -- | Move cursors to end of the line 189 | endOfLine :: BufAction () 190 | endOfLine = do 191 | txt <- getText 192 | overRanges . map $ overBoth $ coordEndOfLine txt 193 | where 194 | coordEndOfLine :: Y.YiString -> Coord -> Coord 195 | coordEndOfLine txt (Coord row col) = Coord row maxColumn 196 | where 197 | maxColumn :: Int 198 | maxColumn = fromMaybe col (txt ^? asLines . ix row . to Y.length) 199 | 200 | -- | Move cursors to start of the line 201 | startOfLine :: BufAction () 202 | startOfLine = overRanges . map $ overBoth coordStartOfLine 203 | where 204 | coordStartOfLine :: Coord -> Coord 205 | coordStartOfLine (Coord x _) = Coord x 0 206 | -------------------------------------------------------------------------------- /rasa-ext-vim/test/Rasa/Ext/VimSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Ext.VimSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa-ext-vim/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /rasa/README.md: -------------------------------------------------------------------------------- 1 | ../README.md -------------------------------------------------------------------------------- /rasa/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /rasa/rasa.cabal: -------------------------------------------------------------------------------- 1 | name: rasa 2 | version: 0.1.12 3 | synopsis: A modular text editor 4 | homepage: https://github.com/ChrisPenner/rasa#readme 5 | license: GPL-3 6 | license-file: LICENSE 7 | author: Chris Penner 8 | maintainer: christopher.penner@gmail.com 9 | copyright: 2016 Chris Penner 10 | category: Text Editor, Executable 11 | build-type: Simple 12 | extra-source-files: README.md 13 | cabal-version: >=1.10 14 | description: A modular text editor 15 | This is only a snippet, see the project's . 16 | . 17 | Rasa is a text editor project with a few interesting goals. For better or worse it attempts 18 | to be as modular as possible. This means that most functionality which would typically be considered to be 'core' in other editors 19 | is implemented as extensions in Rasa. 20 | This approach comes with its own share of pros and cons, for instance: 21 | . 22 | /Pros/ 23 | . 24 | * Implementing most core functionality as extensions ensures a powerful and elegant extension interface. 25 | . 26 | * Flexibility; don't like the default cursor implementation? Write your own! 27 | . 28 | * Adaptability; the core of Rasa is miniscule, you can mix and match extensions to build any editor you want. 29 | . 30 | /Cons/ 31 | . 32 | * Module cross-dependencies makes the community infrastructure more fragile; We'll likely have to develop a solution to this as a community as time goes on. 33 | . 34 | * Fragmentation; Not having a single implementation for a given feature means extensions that depend on a feature have to pick a specific implementation to augment. Over time data-structures and types will be standardized into Rasa's core to help alleviate this. 35 | . 36 | While highly experimental, I've found the current API to be quite expressive and adaptable; 37 | for instance I was able to implement the notion of multiple cursors using the extension API in less than a day. I hope to keep the learning curve low as development continues. 38 | . 39 | /Getting Started/ 40 | . 41 | First clone the 42 | and try running the example-config included there. 43 | Once you get it running (see the ) then you 44 | can customize your keymap to add a few mappings you like. 45 | Then I'd check out the 46 | . 47 | It goes in depth into everything you'd want to know! 48 | . 49 | If you have any issues (and I'm sure there'll be a few; it's a new project!) please report them and we'll talk about it! 50 | 51 | library 52 | hs-source-dirs: src 53 | exposed-modules: Rasa 54 | Rasa.Ext 55 | Rasa.Internal.BufActions 56 | Rasa.Internal.Buffer 57 | Rasa.Internal.Events 58 | Rasa.Internal.Listeners 59 | Rasa.Internal.Range 60 | Rasa.Internal.Styles 61 | Rasa.Internal.Text 62 | Rasa.Internal.Utility 63 | 64 | ghc-options: -Wall 65 | build-depends: base >= 4.9 && < 5 66 | , eve >= 0.1.9.0 67 | , async 68 | , bifunctors 69 | , profunctors 70 | , containers 71 | , data-default 72 | , free 73 | , lens 74 | , mtl 75 | , text 76 | , text-lens 77 | , transformers 78 | , yi-rope 79 | , hspec 80 | 81 | default-language: Haskell2010 82 | 83 | test-suite rasa-test 84 | type: exitcode-stdio-1.0 85 | hs-source-dirs: test 86 | main-is: Spec.hs 87 | build-depends: base 88 | , rasa 89 | , eve 90 | , hspec 91 | , lens 92 | , yi-rope 93 | , text 94 | , quickcheck-instances 95 | , QuickCheck 96 | 97 | other-modules: ArbitraryInstances 98 | , RasaSpec 99 | , Rasa.Internal.ActionSpec 100 | , Rasa.Internal.ActionsSpec 101 | , Rasa.Internal.AsyncSpec 102 | , Rasa.Internal.BufActionsSpec 103 | , Rasa.Internal.BufferSpec 104 | , Rasa.Internal.EventsSpec 105 | , Rasa.Internal.ListenersSpec 106 | , Rasa.Internal.RangeSpec 107 | , Rasa.Internal.TextSpec 108 | 109 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans 110 | default-language: Haskell2010 111 | default-extensions: OverloadedStrings 112 | 113 | source-repository head 114 | type: git 115 | location: https://github.com/ChrisPenner/rasa 116 | -------------------------------------------------------------------------------- /rasa/src/Rasa.hs: -------------------------------------------------------------------------------- 1 | {-# language ExistentialQuantification, Rank2Types, ScopedTypeVariables #-} 2 | module Rasa (rasa) where 3 | 4 | import Eve 5 | import Rasa.Internal.Listeners 6 | 7 | import Control.Monad 8 | 9 | -- | The main function to run rasa. 10 | -- 11 | -- @rasa eventProviders extensions@ 12 | -- 13 | -- This should be imported by a user-config with and called with an 'Action' 14 | -- containing any extensions which have event listeners. 15 | -- 16 | -- > rasa $ do 17 | -- > cursor 18 | -- > vim 19 | -- > slate 20 | 21 | rasa :: App () -> IO () 22 | rasa initialization = void $ eve (initialization >> hooks) 23 | where hooks = beforeEvent_ $ do 24 | dispatchBeforeRender 25 | dispatchOnRender 26 | dispatchAfterRender 27 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Ext.hs: -------------------------------------------------------------------------------- 1 | ---------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Rasa.Ext 4 | -- Copyright : (C) 2016 Chris Penner 5 | -- License : MIT 6 | -- Maintainer : Chris Penner 7 | -- 8 | -- This module contains the public API for building an extension for Rasa. It 9 | -- re-exports the parts of rasa that are public API for creating extensions. 10 | -- 11 | -- There are two main things that an extension can do, either react 12 | -- to editor events, or expose useful actions and/or state for other extensions 13 | -- to use. 14 | -- 15 | -- Whether performing its own actions or being used by a different extension 16 | -- an extension will want to define some 'Action's to perform. Actions 17 | -- can operate over buffers or even perform IO and comprise the main way in which 18 | -- extensons do what they need to do. Read more here: 'Action', 'BufAction'. 19 | -- 20 | -- To sum it all up, Here's an example of a simple logging extension that 21 | -- simply writes each keypress to a file. 22 | -- 23 | -- > logKeypress :: Keypress -> Action () 24 | -- > logKeypress (Keypress char _) = liftIO $ appendFile "logs" ("You pressed " ++ [char] ++ "\n") 25 | -- > logKeypress _ = return () 26 | -- > 27 | -- > logger :: Action () 28 | -- > logger = do 29 | -- > liftIO $ writeFile "logs" "==Logs==\n" 30 | -- > onKeypress logKeypress 31 | -- > onExit $ liftIO $ appendFile "logs" "==Done==" 32 | -- 33 | -- Check out this tutorial on building extensions, it's also just a great way to learn 34 | -- how the editor works: . 35 | ---------------------------------------------------------------------------- 36 | 37 | module Rasa.Ext 38 | ( 39 | -- * Editor Actions 40 | getBuffer 41 | 42 | -- * Managing Buffers 43 | , addBuffer 44 | , nextBufRef 45 | , prevBufRef 46 | , getBufRefs 47 | 48 | -- * Working with Buffers 49 | , Buffer 50 | , HasBuffer(..) 51 | , BufRef 52 | , text 53 | , getText 54 | , getRange 55 | , getBufRef 56 | 57 | -- * Actions over Buffers 58 | , BufAction 59 | , bufDo 60 | , bufDo_ 61 | , buffersDo 62 | , buffersDo_ 63 | 64 | -- * Working with Text 65 | , overRange 66 | , replaceRange 67 | , deleteRange 68 | , insertAt 69 | , sizeOf 70 | , getLineRange 71 | 72 | , getBufExt 73 | , setBufExt 74 | , overBufExt 75 | 76 | -- * Events 77 | 78 | , dispatchBufEvent 79 | , addBufListener 80 | , addBufListener_ 81 | , removeBufListener 82 | 83 | -- * Built-in Events 84 | , Keypress(..) 85 | , Mod(..) 86 | , dispatchKeypress 87 | , BufAdded(..) 88 | , BufTextChanged(..) 89 | 90 | -- * Built-in Event Listeners 91 | , beforeEveryRender 92 | , beforeEveryRender_ 93 | , onEveryRender 94 | , onEveryRender_ 95 | , afterEveryRender 96 | , afterEveryRender_ 97 | , onBufAdded 98 | , onBufAdded_ 99 | , onEveryNewBuffer 100 | , onEveryNewBuffer_ 101 | , onBufTextChanged 102 | , onKeypress 103 | 104 | -- * Ranges 105 | , Range(..) 106 | , CrdRange 107 | , Coord 108 | , Coord'(..) 109 | , Offset(..) 110 | , Span(..) 111 | , overRow 112 | , overCol 113 | , coordRow 114 | , coordCol 115 | , overBoth 116 | , combineSpans 117 | , asCoord 118 | , clampCoord 119 | , clampRange 120 | , rStart 121 | , rEnd 122 | , sizeOfR 123 | , afterC 124 | , beforeC 125 | , moveRange 126 | , moveRangeByN 127 | , moveCursorByN 128 | 129 | -- * Styles 130 | -- | A common representation for text styling 131 | , fg 132 | , bg 133 | , flair 134 | , Color(..) 135 | , Flair(..) 136 | , Style(..) 137 | , Styles 138 | , addStyleProvider 139 | , getStyles 140 | , styleText 141 | 142 | -- * Useful Utilities 143 | , asText 144 | , asString 145 | , asLines 146 | , clamp 147 | , cropToViewport 148 | 149 | -- * Common Types/Interfaces 150 | -- | These exist to help unify the interfaces of many different extensions without 151 | -- requiring them to depend upon each other. Use them liberally in your own extensions. 152 | , Width 153 | , Height 154 | , ScrollPos 155 | , RenderInfo(..) 156 | , Renderable(..) 157 | 158 | , module Eve 159 | ) where 160 | 161 | import Eve 162 | import Rasa.Internal.BufActions 163 | import Rasa.Internal.Buffer 164 | import Rasa.Internal.Events 165 | import Rasa.Internal.Listeners 166 | import Rasa.Internal.Range 167 | import Rasa.Internal.Styles 168 | import Rasa.Internal.Text 169 | import Rasa.Internal.Utility 170 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/BufActions.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RankNTypes #-} 3 | module Rasa.Internal.BufActions 4 | ( overRange 5 | , replaceRange 6 | , deleteRange 7 | , insertAt 8 | , sizeOf 9 | , getLineRange 10 | 11 | -- * Performing Apps on Buffers 12 | , bufDo 13 | , bufDo_ 14 | , buffersDo 15 | , buffersDo_ 16 | 17 | -- * Editor Apps 18 | , getBufRefs 19 | , nextBufRef 20 | , prevBufRef 21 | 22 | , getBufExt 23 | , setBufExt 24 | , overBufExt 25 | 26 | , getBufRef 27 | , getRange 28 | , addBuffer 29 | , getBuffer 30 | 31 | 32 | , dispatchBufEvent 33 | , addBufListener 34 | , addBufListener_ 35 | , removeBufListener 36 | 37 | , onBufAdded 38 | , onBufAdded_ 39 | , dispatchBufAdded 40 | , onEveryNewBuffer 41 | , onEveryNewBuffer_ 42 | 43 | , onBufTextChanged 44 | , dispatchBufTextChanged 45 | 46 | , getText 47 | 48 | ) where 49 | 50 | import Eve 51 | 52 | import Rasa.Internal.Buffer 53 | import Rasa.Internal.Range 54 | import Rasa.Internal.Text 55 | import Rasa.Internal.Events 56 | 57 | import Control.Lens 58 | import Control.Monad 59 | import Data.Maybe 60 | import Data.Default 61 | import Data.Typeable 62 | import qualified Yi.Rope as Y 63 | import qualified Data.IntMap as IM 64 | 65 | -- | Returns the text of the current buffer 66 | getText :: BufAction Y.YiString 67 | getText = use text 68 | 69 | -- -- | Sets the text of the current buffer 70 | -- setText :: Y.YiString -> BufAction () 71 | -- setText txt = text .= txt 72 | 73 | -- | Gets the range of text from the buffer 74 | getRange :: CrdRange -> BufAction Y.YiString 75 | getRange rng = view (range rng) <$> getText 76 | 77 | -- | Sets the range of text from the buffer 78 | setRange :: CrdRange -> Y.YiString -> BufAction () 79 | setRange rng txt = do 80 | text.range rng .= txt 81 | dispatchBufTextChanged $ BufTextChanged rng txt 82 | 83 | -- | Gets the current buffer's 'BufRef' 84 | getBufRef :: BufAction BufRef 85 | getBufRef = use ref 86 | 87 | -- | Retrieve some buffer extension state 88 | getBufExt :: (Typeable s, Default s) => BufAction s 89 | getBufExt = use stateLens 90 | 91 | -- | Set some buffer extension state 92 | setBufExt :: (Typeable s, Default s) => s -> BufAction () 93 | setBufExt newExt = stateLens .= newExt 94 | 95 | -- | Set some buffer extension state 96 | overBufExt :: (Typeable s, Default s) => (s -> s) -> BufAction () 97 | overBufExt f = stateLens %= f 98 | 99 | -- -- | This lifts up an 'Action' to be run inside a 'BufAction' 100 | -- liftApp :: App r -> BufAction r 101 | -- liftApp action = liftBufAction $ LiftAction action id 102 | 103 | -- | Runs function over given range of text 104 | overRange :: CrdRange -> (Y.YiString -> Y.YiString) -> BufAction () 105 | overRange r f = getRange r >>= setRange r . f 106 | 107 | -- | Deletes the text in the given range from the buffer. 108 | deleteRange :: CrdRange -> BufAction () 109 | deleteRange r = replaceRange r "" 110 | 111 | -- | Replaces the text in the given range with the given text. 112 | replaceRange :: CrdRange -> Y.YiString -> BufAction () 113 | replaceRange r txt = overRange r (const txt) 114 | 115 | -- | Inserts text into the buffer at the given 'Coord'. 116 | insertAt :: Coord -> Y.YiString -> BufAction () 117 | insertAt c = replaceRange r 118 | where r = Range c c 119 | 120 | -- | Rows can be represented by their line number. 121 | type Row = Int 122 | 123 | -- | Gets the range representing a given row (if that row exists) 124 | getLineRange :: Row -> BufAction (Maybe CrdRange) 125 | getLineRange n = do 126 | txt <- getText 127 | let len = txt ^? asLines . ix n . to Y.length 128 | return $ Range (Coord n 0) . Coord n <$> len 129 | 130 | -- | Adds a new buffer and returns the BufRef 131 | addBuffer :: Y.YiString -> App BufRef 132 | addBuffer txt = do 133 | bufId <- nextBufId <+= 1 134 | let bufRef = BufRef bufId 135 | buffers.at bufId ?= mkBuffer txt bufRef 136 | dispatchBufAdded (BufAdded bufRef) 137 | return bufRef 138 | 139 | -- | Returns an up-to-date list of all 'BufRef's 140 | getBufRefs :: App [BufRef] 141 | getBufRefs = fmap BufRef <$> use (buffers.to IM.keys) 142 | 143 | 144 | -- | Retrieve a buffer. This is read-only for logging/rendering/debugging purposes only. 145 | getBuffer :: BufRef -> App (Maybe Buffer) 146 | getBuffer (BufRef bufInd) = 147 | use (buffers.at bufInd) 148 | 149 | -- | Runs a BufAction over the given BufRefs, returning any results. 150 | -- 151 | -- Result list is not guaranteed to be the same length or positioning as input BufRef list; some buffers may no 152 | -- longer exist. 153 | bufferDo :: [BufRef] -> BufAction r -> App [r] 154 | bufferDo bufRefs bufAct = do 155 | r <- forM bufRefs $ \(BufRef bInd) -> 156 | runActionOver (buffers.at bInd._Just) ((:[]) <$> bufAct) 157 | return $ concat r 158 | 159 | -- | This lifts a 'Rasa.App.BufAction' to an 'Rasa.App.App' which 160 | -- performs the 'Rasa.App.BufAction' on every buffer and collects the return 161 | -- values as a list. 162 | 163 | buffersDo :: BufAction a -> App [a] 164 | buffersDo bufAct = do 165 | bufRefs <- getBufRefs 166 | bufferDo bufRefs bufAct 167 | 168 | buffersDo_ :: BufAction a -> App () 169 | buffersDo_ = void . buffersDo 170 | 171 | -- | This lifts a 'Rasa.Internal.App.BufAction' to an 'Rasa.Internal.App.App' which 172 | -- performs the 'Rasa.Internal.App.BufAction' on the buffer referred to by the 'BufRef' 173 | -- If the buffer referred to no longer exists this returns: @Nothing@. 174 | bufDo :: BufRef -> BufAction a -> App (Maybe a) 175 | bufDo bufRef bufAct = listToMaybe <$> bufferDo [bufRef] bufAct 176 | 177 | bufDo_ :: BufRef -> BufAction a -> App () 178 | bufDo_ bufRef bufAct = void $ bufDo bufRef bufAct 179 | 180 | -- | Gets 'BufRef' that comes after the one provided 181 | nextBufRef :: BufRef -> App BufRef 182 | nextBufRef br = do 183 | bufRefs <- getBufRefs 184 | return $ if null bufRefs 185 | then br 186 | else case dropWhile (<= br) bufRefs of 187 | [] -> head bufRefs 188 | (x:_) -> x 189 | 190 | -- | Gets 'BufRef' that comes before the one provided 191 | prevBufRef :: BufRef -> App BufRef 192 | prevBufRef br = do 193 | bufRefs <- getBufRefs 194 | return $ if null bufRefs 195 | then br 196 | else case dropWhile (>= br) (reverse bufRefs) of 197 | [] -> last bufRefs 198 | (x:_) -> x 199 | 200 | 201 | 202 | -- | Registers an action to be performed after a new buffer is added. 203 | -- 204 | -- The supplied function will be called with a 'BufRef' to the new buffer, and the resulting 'App' will be run. 205 | onBufAdded :: (BufAdded -> App result) -> App ListenerId 206 | onBufAdded actionF = addListener (void . actionF) 207 | 208 | onBufAdded_ :: (BufAdded -> App result) -> App () 209 | onBufAdded_ = void . onBufAdded 210 | 211 | -- | Run the given 'BufAction' over all new buffers 212 | onEveryNewBuffer :: BufAction a -> App ListenerId 213 | onEveryNewBuffer bufApp = onBufAdded $ 214 | \(BufAdded br) -> bufDo_ br bufApp 215 | 216 | onEveryNewBuffer_ :: BufAction a -> App () 217 | onEveryNewBuffer_ = void . onEveryNewBuffer 218 | 219 | -- | Dispatch the 'BufAdded' action. 220 | dispatchBufAdded :: BufAdded -> App () 221 | dispatchBufAdded = dispatchEvent 222 | 223 | -- | This is fired every time text in a buffer changes. 224 | -- 225 | -- The range of text which was altered and the new value of that text are provided inside a 'BufTextChanged' event. 226 | onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId 227 | onBufTextChanged bufAppF = addBufListener (void . bufAppF) 228 | 229 | -- | Dispatch the 'BufBufTextChanged' action. 230 | dispatchBufTextChanged :: BufTextChanged -> BufAction () 231 | dispatchBufTextChanged = dispatchBufEvent 232 | 233 | -- | Dispatches an event of any type to the BufAction's buffer. 234 | -- See 'dispatchLocalEvent' 235 | dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => (eventType -> BufAction result) 236 | dispatchBufEvent = dispatchLocalEvent 237 | 238 | -- | Adds a listener to the BufAction's buffer. 239 | -- See 'addListener' 240 | addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId 241 | addBufListener = addLocalListener 242 | 243 | addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction () 244 | addBufListener_ = void . addBufListener 245 | 246 | -- | Removes a listener from the BufAction's buffer. 247 | -- See 'removeListener' 248 | removeBufListener :: ListenerId -> BufAction () 249 | removeBufListener = removeLocalListener 250 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Buffer.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | Rank2Types 3 | , TemplateHaskell 4 | , OverloadedStrings 5 | , ExistentialQuantification 6 | , ScopedTypeVariables 7 | , GeneralizedNewtypeDeriving 8 | , FlexibleInstances 9 | , StandaloneDeriving 10 | #-} 11 | 12 | module Rasa.Internal.Buffer 13 | ( Buffer 14 | , BufAction 15 | , HasBuffer(..) 16 | , BufRef(..) 17 | , text 18 | , mkBuffer 19 | , ref 20 | 21 | , buffers 22 | , nextBufId 23 | ) where 24 | 25 | 26 | import Eve 27 | 28 | import qualified Yi.Rope as Y 29 | import Control.Lens hiding (matching) 30 | import qualified Data.IntMap as IM 31 | import Data.Default 32 | 33 | -- | An opaque reference to a buffer. 34 | -- When operating over a BufRef Rasa checks if the 'Rasa.Internal.Buffer.Buffer' still 35 | -- exists and simply ignores any operations over non-existent buffers; typically returning 'Nothing' 36 | newtype BufRef = 37 | BufRef Int 38 | deriving (Show, Eq, Ord) 39 | 40 | newtype NextBufId = NextBufId 41 | { _nextBufId' :: Int 42 | } deriving Show 43 | 44 | instance Default NextBufId where 45 | def = NextBufId 0 46 | 47 | makeLenses ''NextBufId 48 | nextBufId :: HasStates s => Lens' s Int 49 | nextBufId = stateLens.nextBufId' 50 | 51 | -- | A buffer, holds the text in the buffer and any extension states that are set on the buffer. 52 | data Buffer = Buffer 53 | { _text' :: Y.YiString 54 | , _bufStates' :: States 55 | , _ref :: BufRef 56 | } 57 | makeLenses ''Buffer 58 | 59 | instance HasStates Buffer where 60 | states = bufStates' 61 | 62 | instance HasEvents Buffer where 63 | 64 | -- | This allows creation of polymorphic lenses over any type which has access to a Buffer 65 | class HasBuffer a where 66 | buffer :: Lens' a Buffer 67 | 68 | instance HasBuffer Buffer where 69 | buffer = lens id (flip const) 70 | 71 | -- | This lens focuses the text of the in-scope buffer. 72 | text :: HasBuffer b => Lens' b Y.YiString 73 | text = buffer.text' 74 | 75 | instance Show Buffer where 76 | show b = "text:" ++ (Y.toString . Y.take 30 $ (b^.text)) ++ "...,\n" 77 | 78 | type BufAction a = Action Buffer a 79 | 80 | newtype Buffers = Buffers 81 | { _buffers' :: IM.IntMap Buffer 82 | } deriving Show 83 | makeLenses '' Buffers 84 | 85 | instance Default Buffers where 86 | def = Buffers mempty 87 | 88 | -- | A lens over the map of available buffers 89 | buffers :: HasStates s => Lens' s (IM.IntMap Buffer) 90 | buffers = stateLens.buffers' 91 | 92 | -- | Creates a new buffer from the given text. 93 | mkBuffer :: Y.YiString -> BufRef -> Buffer 94 | mkBuffer txt bRef = 95 | Buffer 96 | { _text' = txt 97 | , _bufStates' = mempty 98 | , _ref = bRef 99 | } 100 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Events.hs: -------------------------------------------------------------------------------- 1 | {-# language ExistentialQuantification #-} 2 | module Rasa.Internal.Events 3 | ( BeforeRender(..) 4 | , OnRender(..) 5 | , AfterRender(..) 6 | , BufAdded(..) 7 | , Keypress(..) 8 | , Mod(..) 9 | , BufTextChanged(..) 10 | ) where 11 | 12 | import Data.Dynamic 13 | import Rasa.Internal.Range 14 | import Rasa.Internal.Buffer 15 | import qualified Yi.Rope as Y 16 | 17 | -- | This event is dispatched immediately before dispatching 18 | -- the 'OnRender' event. 19 | data BeforeRender = BeforeRender deriving (Show, Eq, Typeable) 20 | 21 | -- | This event is dispatched when it's time for extensions to render to screen. 22 | data OnRender = OnRender deriving (Show, Eq, Typeable) 23 | 24 | -- | This event is dispatched immediately after dispatching 'OnRender'. 25 | data AfterRender = AfterRender deriving (Show, Eq, Typeable) 26 | 27 | -- | This event is dispatched after adding a new buffer. The contained BufRef refers to the new buffer. 28 | data BufAdded = BufAdded BufRef deriving (Show, Eq, Typeable) 29 | 30 | -- | This event is dispatched in response to keyboard key presses. It contains both 31 | -- the char that was pressed and any modifiers ('Mod') that where held when the key was pressed. 32 | data Keypress 33 | = Keypress Char [Mod] 34 | | KEsc [Mod] 35 | | KBS [Mod] 36 | | KEnter [Mod] 37 | | KLeft [Mod] 38 | | KRight [Mod] 39 | | KUp [Mod] 40 | | KDown [Mod] 41 | | KPrtScr [Mod] 42 | | KHome [Mod] 43 | | KPageUp [Mod] 44 | | KDel [Mod] 45 | | KEnd [Mod] 46 | | KPageDown [Mod] 47 | | KUnknown 48 | deriving (Show, Eq, Typeable) 49 | 50 | -- | This represents each modifier key that could be pressed along with a key. 51 | data Mod 52 | = Ctrl 53 | | Alt 54 | | Shift 55 | | Meta 56 | deriving (Show, Eq) 57 | 58 | -- | This is triggered when text in a buffer is changed. The Event data includes the 'CrdRange' that changed and 59 | -- the new text which is now contined in that range. 60 | data BufTextChanged 61 | = BufTextChanged CrdRange Y.YiString 62 | deriving (Show, Eq, Typeable) 63 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Listeners.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | GADTs 3 | , ExistentialQuantification 4 | , ScopedTypeVariables 5 | , RankNTypes 6 | #-} 7 | 8 | module Rasa.Internal.Listeners 9 | ( beforeEveryRender 10 | , beforeEveryRender_ 11 | , dispatchBeforeRender 12 | 13 | , onEveryRender 14 | , onEveryRender_ 15 | , dispatchOnRender 16 | 17 | , afterEveryRender 18 | , afterEveryRender_ 19 | , dispatchAfterRender 20 | 21 | , onExit 22 | 23 | , onKeypress 24 | , dispatchKeypress 25 | ) where 26 | 27 | import Eve 28 | import Rasa.Internal.Events 29 | 30 | import Control.Monad 31 | 32 | -- | Trigger an 'App' on a 'Keypress' 33 | onKeypress :: (Keypress -> App result) -> App ListenerId 34 | onKeypress actionF = addListener (void <$> actionF) 35 | 36 | -- | Dispatch a 'Keypress' event. 37 | dispatchKeypress :: Keypress -> App () 38 | dispatchKeypress = dispatchEvent 39 | 40 | -- | Registers an action to be performed BEFORE each render phase. 41 | -- 42 | -- This is a good spot to add information useful to the renderer 43 | -- since all actions have been performed. Only cosmetic changes should 44 | -- occur during this phase. 45 | beforeEveryRender :: App a -> App ListenerId 46 | beforeEveryRender action = addListener (const (void action) :: BeforeRender -> App ()) 47 | 48 | beforeEveryRender_ :: App a -> App () 49 | beforeEveryRender_ = void . beforeEveryRender 50 | 51 | -- | Dispatch the 'BeforeRender' action. 52 | dispatchBeforeRender :: App () 53 | dispatchBeforeRender = dispatchEvent BeforeRender 54 | 55 | -- | Registers an action to be performed during each render phase. 56 | -- 57 | -- This phase should only be used by extensions which actually render something. 58 | onEveryRender :: App a -> App ListenerId 59 | onEveryRender action = addListener (const $ void action :: OnRender -> App ()) 60 | 61 | onEveryRender_ :: App a -> App () 62 | onEveryRender_ = void . onEveryRender 63 | 64 | -- | Dispatch the 'OnRender' action. 65 | dispatchOnRender :: App () 66 | dispatchOnRender = dispatchEvent OnRender 67 | 68 | -- | Registers an action to be performed AFTER each render phase. 69 | -- 70 | -- This is useful for cleaning up extension state that was registered for the 71 | -- renderer, but needs to be cleared before the next iteration. 72 | afterEveryRender :: App a -> App ListenerId 73 | afterEveryRender action = addListener (const $ void action :: AfterRender -> App ()) 74 | 75 | afterEveryRender_ :: App a -> App () 76 | afterEveryRender_ = void . afterEveryRender 77 | 78 | -- | Dispatch the 'AfterRender' action. 79 | dispatchAfterRender :: App () 80 | dispatchAfterRender = dispatchEvent AfterRender 81 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Range.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | Rank2Types 3 | , OverloadedStrings 4 | , DeriveFunctor 5 | , ScopedTypeVariables 6 | , TemplateHaskell 7 | #-} 8 | module Rasa.Internal.Range 9 | ( Coord 10 | , Coord'(..) 11 | , overRow 12 | , overCol 13 | , overBoth 14 | , coordRow 15 | , coordCol 16 | , Offset(..) 17 | , asCoord 18 | , clampCoord 19 | , clampRange 20 | , Range(..) 21 | , CrdRange 22 | , range 23 | , rStart 24 | , rEnd 25 | , sizeOf 26 | , sizeOfR 27 | , moveRange 28 | , moveRangeByN 29 | , moveCursorByN 30 | , moveCursor 31 | , Span(..) 32 | , combineSpans 33 | , clamp 34 | , beforeC 35 | , afterC 36 | ) where 37 | 38 | import Rasa.Internal.Text 39 | import Control.Lens 40 | 41 | import Data.Monoid 42 | import Data.List 43 | import Data.Bifunctor 44 | import Data.Biapplicative 45 | import Data.Bitraversable 46 | import Data.Bifoldable 47 | 48 | import qualified Yi.Rope as Y 49 | 50 | -- | This represents a range between two coordinates ('Coord') 51 | data Range a b = Range 52 | { _rStart :: a 53 | , _rEnd :: b 54 | } deriving (Eq) 55 | makeLenses ''Range 56 | 57 | instance (Show a, Show b) => Show (Range a b) where 58 | show (Range a b) = "(Range (start " ++ show a ++ ") (end " ++ show b ++ "))" 59 | 60 | instance Bifunctor Range where 61 | bimap f g (Range a b) = Range (f a) (g b) 62 | 63 | instance Bifoldable Range where 64 | bifoldMap f g (Range a b) = f a `mappend` g b 65 | 66 | instance Bitraversable Range where 67 | bitraverse f g (Range a b) = Range <$> f a <*> g b 68 | 69 | instance (Ord a, Ord b) => Ord (Range a b) where 70 | Range start end <= Range start' end' 71 | | end == end' = start <= start' 72 | | otherwise = end <= end' 73 | 74 | -- | (Coord Row Column) represents a char in a block of text. (zero indexed) 75 | -- e.g. Coord 0 0 is the first character in the text, 76 | -- Coord 2 1 is the second character of the third row 77 | data Coord' a b = Coord 78 | { _coordRow::a 79 | , _coordCol::b 80 | } deriving (Eq) 81 | makeLenses ''Coord' 82 | 83 | instance (Show a, Show b) => Show (Coord' a b) where 84 | show (Coord a b) = "(Coord (row " ++ show a ++ ") (col " ++ show b ++ "))" 85 | 86 | -- | A type alias to 'Coord'' which specializes the types to integers. 87 | type Coord = Coord' Int Int 88 | 89 | -- | A type alias to 'Range'' which specializes the types to 'Coord's. 90 | type CrdRange = Range Coord Coord 91 | 92 | instance Bifunctor Coord' where 93 | bimap f g (Coord a b) = Coord (f a) (g b) 94 | 95 | -- | Applies a function over the row of a 'Coord' 96 | overRow :: (Int -> Int) -> Coord -> Coord 97 | overRow = first 98 | 99 | -- | Applies a function over the column of a 'Coord' 100 | overCol :: (Int -> Int) -> Coord -> Coord 101 | overCol = second 102 | 103 | -- | Applies a function over both functors in any 'Bifunctor'. 104 | overBoth :: Bifunctor f => (a -> b) -> f a a -> f b b 105 | overBoth f = bimap f f 106 | 107 | instance Biapplicative Coord' where 108 | bipure = Coord 109 | Coord f g <<*>> Coord a b = Coord (f a) (g b) 110 | 111 | instance (Ord a, Ord b) => Ord (Coord' a b) where 112 | Coord a b <= Coord a' b' 113 | | a < a' = True 114 | | a > a' = False 115 | | otherwise = b <= b' 116 | 117 | -- | An 'Offset' represents an exact position in a file as a number of characters from the start. 118 | newtype Offset = 119 | Offset Int 120 | deriving (Show, Eq) 121 | 122 | -- | A span which maps a piece of Monoidal data over a range. 123 | data Span a b = 124 | Span a b 125 | deriving (Show, Eq, Functor) 126 | 127 | instance Bifunctor Span where 128 | bimap f g (Span a b) = Span (f a) (g b) 129 | 130 | -- | Moves a 'Range' by a given 'Coord' 131 | -- It may be unintuitive, but for (Coord row col) a given range will be moved down by row and to the right by col. 132 | moveRange :: Coord -> CrdRange -> CrdRange 133 | moveRange amt = overBoth (moveCursor amt) 134 | 135 | -- | Moves a range forward by the given amount 136 | moveRangeByN :: Int -> CrdRange -> CrdRange 137 | moveRangeByN amt = overBoth (moveCursorByN amt) 138 | 139 | -- | Moves a 'Coord' forward by the given amount of columns 140 | moveCursorByN :: Int -> Coord -> Coord 141 | moveCursorByN amt = overCol (+amt) 142 | 143 | -- | Adds the rows and columns of the given two 'Coord's. 144 | moveCursor :: Coord -> Coord -> Coord 145 | moveCursor = biliftA2 (+) (+) 146 | 147 | instance (Num a, Num b) => Num (Coord' a b) where 148 | Coord row col + Coord row' col' = Coord (row + row') (col + col') 149 | Coord row col - Coord row' col' = Coord (row - row') (col - col') 150 | Coord row col * Coord row' col' = Coord (row * row') (col * col') 151 | abs (Coord row col) = Coord (abs row) (abs col) 152 | fromInteger i = Coord 0 (fromInteger i) 153 | signum (Coord row col) = Coord (signum row) (signum col) 154 | 155 | -- | Given the text you're operating over, creates an iso from an 'Offset' to a 'Coord'. 156 | asCoord :: Y.YiString -> Iso' Offset Coord 157 | asCoord txt = iso (toCoord txt) (toOffset txt) 158 | 159 | -- | Given the text you're operating over, converts a 'Coord' to an 'Offset'. 160 | toOffset :: Y.YiString -> Coord -> Offset 161 | toOffset txt (Coord row col) = Offset $ lenRows + col 162 | where 163 | lenRows = Y.length . Y.concat . take row . Y.lines' $ txt 164 | 165 | -- | Given the text you're operating over, converts an 'Offset' to a 'Coord'. 166 | toCoord :: Y.YiString -> Offset -> Coord 167 | toCoord txt (Offset offset) = Coord numRows numColumns 168 | where 169 | numRows = Y.countNewLines . Y.take offset $ txt 170 | numColumns = (offset -) . Y.length . Y.concat . take numRows . Y.lines' $ txt 171 | 172 | -- | This will restrict a given 'Coord' to a valid one which lies within the given text. 173 | clampCoord :: Y.YiString -> Coord -> Coord 174 | clampCoord txt (Coord row col) = 175 | Coord (clamp 0 maxRow row) (clamp 0 maxColumn col) 176 | where 177 | maxRow = Y.countNewLines txt 178 | selectedRow = fst . Y.splitAtLine 1 . snd . Y.splitAtLine row $ txt 179 | maxColumn = Y.length selectedRow 180 | 181 | -- | This will restrict a given 'Range' to a valid one which lies within the given text. 182 | clampRange :: Y.YiString -> CrdRange -> CrdRange 183 | clampRange txt = overBoth (clampCoord txt) 184 | 185 | -- | A Helper only used when combining many spans. 186 | data Marker 187 | = Start 188 | | End 189 | deriving (Show, Eq) 190 | 191 | type ID = Int 192 | -- | Combines a list of spans containing some monoidal data into a list of offsets with 193 | -- with the data that applies from each Offset forwards. 194 | combineSpans 195 | :: forall a. 196 | Monoid a 197 | => [Span CrdRange a] -> [(Coord, a)] 198 | combineSpans spans = combiner [] $ sortOn (view _3) (splitStartEnd idSpans) 199 | where 200 | idSpans :: [(ID, Span CrdRange a)] 201 | idSpans = zip [1 ..] spans 202 | 203 | splitStartEnd :: [(ID, Span CrdRange a)] -> [(Marker, ID, Coord, a)] 204 | splitStartEnd [] = [] 205 | splitStartEnd ((i, Span (Range s e) d):rest) = 206 | (Start, i, s, d) : (End, i, e, d) : splitStartEnd rest 207 | 208 | withoutId :: ID -> [(ID, a)] -> [(ID, a)] 209 | withoutId i = filter ((/= i) . fst) 210 | 211 | combiner :: [(ID, a)] -> [(Marker, ID, Coord, a)] -> [(Coord, a)] 212 | combiner _ [] = [] 213 | combiner cur ((Start, i, crd, mData):rest) = 214 | let dataSum = foldMap snd cur <> mData 215 | newData = (i, mData) : cur 216 | in (crd, dataSum) : combiner newData rest 217 | combiner cur ((End, i, crd, _):rest) = 218 | let dataSum = foldMap snd newData 219 | newData = withoutId i cur 220 | in (crd, dataSum) : combiner newData rest 221 | 222 | -- | @clamp min max val@ restricts val to be within min and max (inclusive) 223 | clamp :: Int -> Int -> Int -> Int 224 | clamp mn mx n 225 | | n < mn = mn 226 | | n > mx = mx 227 | | otherwise = n 228 | 229 | -- | Returns the number of rows and columns that a 'Range' spans as a 'Coord' 230 | sizeOfR :: CrdRange -> Coord 231 | sizeOfR (Range start end) = end - start 232 | 233 | -- | Returns the number of rows and columns that a chunk of text spans as a 'Coord' 234 | sizeOf :: Y.YiString -> Coord 235 | sizeOf txt = Coord (Y.countNewLines txt) (Y.length (txt ^. asLines . _last)) 236 | 237 | -- | A lens over text before a given 'Coord' 238 | beforeC :: Coord -> Lens' Y.YiString Y.YiString 239 | beforeC c@(Coord row col) = lens getter setter 240 | where getter txt = let (before, after) = Y.splitAtLine row $ txt 241 | in before <> Y.take col after 242 | setter old new = let suffix = old ^. afterC c 243 | in new <> suffix 244 | 245 | -- | A lens over text after a given 'Coord' 246 | afterC :: Coord -> Lens' Y.YiString Y.YiString 247 | afterC c@(Coord row col) = lens getter setter 248 | where getter txt = Y.drop col . snd . Y.splitAtLine row $ txt 249 | setter old new = let prefix = old ^. beforeC c 250 | in prefix <> new 251 | 252 | -- | A lens over text which is encompassed by a 'Range' 253 | range :: CrdRange -> Lens' Y.YiString Y.YiString 254 | range (Range start end) = lens getter setter 255 | where getter = view (beforeC end . afterC start) 256 | setter old new = result 257 | where 258 | setBefore = old & beforeC end .~ new 259 | result = old & afterC start .~ setBefore 260 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Styles.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | GeneralizedNewtypeDeriving 3 | #-} 4 | module Rasa.Internal.Styles 5 | ( fg 6 | , bg 7 | , flair 8 | , Color(..) 9 | , Flair(..) 10 | , Style(..) 11 | , Styles 12 | , addStyleProvider 13 | , getStyles 14 | ) where 15 | 16 | import Eve 17 | import Rasa.Internal.Range 18 | import Rasa.Internal.Buffer 19 | import Rasa.Internal.BufActions 20 | 21 | import Control.Applicative 22 | import Data.Default 23 | 24 | -- | These represent the possible colors for 'fg' or 'bg'. 25 | -- 'DefColor' represents the renderer's default color. 26 | data Color = 27 | Black 28 | | Red 29 | | Green 30 | | Yellow 31 | | Blue 32 | | Magenta 33 | | Cyan 34 | | White 35 | | DefColor 36 | deriving (Show, Eq) 37 | 38 | -- | These represent the possible extra attributes which may be applied. 39 | -- 'DefFlair' represents the renderer's default text attributes. 40 | data Flair = 41 | Standout 42 | | Underline 43 | | ReverseVideo 44 | | Blink 45 | | Dim 46 | | Bold 47 | | Italic 48 | | DefFlair 49 | deriving (Show, Eq) 50 | 51 | -- | A container which holds a foreground color, background color, and a flair. 52 | -- a 'Nothing' represents that we should not change that attribute. 53 | newtype Style = Style (Maybe Color, Maybe Color, Maybe Flair) 54 | deriving (Show, Eq) 55 | 56 | instance Default Style where 57 | def = Style (Just DefColor, Just DefColor, Just DefFlair) 58 | 59 | instance Semigroup Style where 60 | Style (a, b, c) <> Style (a', b', c') = Style (a' <|> a, b' <|> b, c' <|> c) 61 | 62 | -- | The monoid instance replaces any attributes which have a 'Just' in the new 'Style' 63 | -- and persists any that are 'Nothing' in the new style (using 'Data.Alternative' for 'Data.Maybe') 64 | instance Monoid Style where 65 | 66 | mempty = Style (Nothing, Nothing, Nothing) 67 | 68 | type Styles = [Span CrdRange Style] 69 | newtype StyleMap = 70 | StyleMap Styles 71 | deriving (Show, Eq, Semigroup, Monoid) 72 | 73 | instance Default StyleMap where 74 | def = StyleMap [] 75 | 76 | -- | Create a new 'Style' with the given 'Color' as the foreground. 77 | fg :: Color -> Style 78 | fg a = Style (Just a, Nothing, Nothing) 79 | 80 | -- | Create a new 'Style' with the given 'Color' as the background. 81 | bg :: Color -> Style 82 | bg a = Style (Nothing, Just a, Nothing) 83 | 84 | -- | Create a new 'Style' with the given 'Flair' as its flair. 85 | flair :: Flair -> Style 86 | flair a = Style (Nothing, Nothing, Just a) 87 | 88 | data ComputeStyles = ComputeStyles 89 | 90 | -- | Pass this a 'BufAction' which computes styles based on the current buffer 91 | -- and they'll be collected for the renderer. 92 | addStyleProvider :: BufAction Styles -> BufAction ListenerId 93 | addStyleProvider provider = addBufListener (const provider :: ComputeStyles -> BufAction Styles) 94 | 95 | -- | Collect all provided styles, this is useful for renderers. 96 | getStyles :: BufAction Styles 97 | getStyles = dispatchBufEvent ComputeStyles 98 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Text.hs: -------------------------------------------------------------------------------- 1 | {-# language Rank2Types #-} 2 | module Rasa.Internal.Text 3 | ( asText 4 | , asString 5 | , asLines 6 | ) where 7 | 8 | import Control.Lens 9 | import qualified Yi.Rope as Y 10 | import qualified Data.Text as T 11 | 12 | -- | An iso which converts to/from 'Y.YiString' -> Text 13 | asText :: Iso' Y.YiString T.Text 14 | asText = iso Y.toText Y.fromText 15 | 16 | -- | An iso which converts to/from 'Y.YiString' -> String 17 | asString :: Iso' Y.YiString String 18 | asString = iso Y.toString Y.fromString 19 | 20 | 21 | -- | An iso which converts to/from 'Y.YiString' -> ['Y.YiString'] 22 | asLines :: Iso' Y.YiString [Y.YiString] 23 | asLines = iso Y.lines' Y.concat 24 | -------------------------------------------------------------------------------- /rasa/src/Rasa/Internal/Utility.hs: -------------------------------------------------------------------------------- 1 | {-# language 2 | FlexibleInstances 3 | #-} 4 | module Rasa.Internal.Utility 5 | ( Width 6 | , Height 7 | , Renderable(..) 8 | , RenderInfo(..) 9 | , ScrollPos 10 | , cropToViewport 11 | , styleText 12 | ) where 13 | 14 | import Eve 15 | import Rasa.Internal.Styles 16 | import Rasa.Internal.BufActions 17 | import Rasa.Internal.Buffer 18 | import Rasa.Internal.Range 19 | 20 | import Control.Lens 21 | import Data.Bifunctor 22 | 23 | import qualified Yi.Rope as Y 24 | 25 | type Width = Int 26 | type Height = Int 27 | 28 | -- | RenderInfo is the data necessary to render something; it consists of a block of 29 | -- text with its associated styles. It is a Monoid and can be appended with other 'RenderInfo's. 30 | data RenderInfo = 31 | RenderInfo Y.YiString Styles 32 | 33 | instance Semigroup RenderInfo where 34 | RenderInfo txtA stylesA <> RenderInfo txtB stylesB = 35 | RenderInfo 36 | (txtA <> txtB) 37 | (mappend stylesA $ first (moveRange (sizeOf txtA)) <$> stylesB) 38 | 39 | -- | Appends to RenderInfo by appending the text and styles while preserving 40 | -- proper text/style alignment 41 | instance Monoid RenderInfo where 42 | mempty = RenderInfo mempty mempty 43 | 44 | -- | Represents how to render an entity 45 | class Renderable r where 46 | render :: Width -> Height -> ScrollPos -> r -> App (Maybe RenderInfo) 47 | 48 | instance Renderable r => Renderable (Maybe r) where 49 | render width height scrollPos (Just r) = render width height scrollPos r 50 | render _ _ _ Nothing = return Nothing 51 | 52 | instance Renderable BufRef where 53 | render _ height scrollPos bufRef = bufDo bufRef $ do 54 | txt <- getText 55 | styles <- getStyles 56 | return $ cropToViewport height scrollPos (RenderInfo txt styles) 57 | 58 | instance Renderable Y.YiString where 59 | render _ height scrollPos txt = return . Just $ cropToViewport height scrollPos (RenderInfo txt []) 60 | 61 | instance Renderable RenderInfo where 62 | render _ _ _ r = return (Just r) 63 | 64 | type ScrollPos = Int 65 | 66 | -- | Crop text verticaly to only the visible portion according to viewport height and 67 | -- scroll position. 68 | cropToViewport :: Height -> ScrollPos -> RenderInfo -> RenderInfo 69 | cropToViewport height scrollAmt (RenderInfo txt styles) = RenderInfo trimmedText adjustedStyles 70 | where 71 | adjustedStyles :: Styles 72 | adjustedStyles = first adjustStylePositions <$> styles 73 | adjustStylePositions :: CrdRange -> CrdRange 74 | adjustStylePositions = both.coordRow -~ scrollAmt 75 | trimmedText :: Y.YiString 76 | trimmedText = Y.concat . take height . drop scrollAmt . Y.lines' $ txt 77 | 78 | -- | Add a style to some text resulting in a 'RenderInfo' 79 | styleText :: Y.YiString -> Style -> RenderInfo 80 | styleText txt style = RenderInfo txt [Span (Range (Coord 0 0) (sizeOf txt)) style] 81 | -------------------------------------------------------------------------------- /rasa/test/ArbitraryInstances.hs: -------------------------------------------------------------------------------- 1 | {-# language ScopedTypeVariables, FlexibleInstances #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | module ArbitraryInstances where 4 | 5 | import qualified Data.Text as T 6 | import qualified Yi.Rope as Y 7 | 8 | import Test.QuickCheck 9 | import Test.QuickCheck.Instances () 10 | 11 | import Rasa.Internal.Range 12 | 13 | instance Arbitrary Y.YiString where 14 | arbitrary = do 15 | txt <- arbitrary :: Gen T.Text 16 | return $ Y.fromText txt 17 | 18 | instance Arbitrary (Coord' Int Int) where 19 | arbitrary = do 20 | (r, c) <- arbitrary :: Gen (Int, Int) 21 | return $ Coord (abs r) (abs c) 22 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/ActionSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.ActionSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/ActionsSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.ActionsSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/AsyncSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.AsyncSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/BufActionsSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.BufActionsSpec where 2 | 3 | import Test.Hspec 4 | 5 | import Eve.Testing 6 | import Rasa.Internal.Range 7 | import Rasa.Internal.BufActions 8 | import qualified Yi.Rope as Y 9 | 10 | sampleText :: Y.YiString 11 | sampleText = "Testing line one\nshort line\n a long line " 12 | 13 | spec :: Spec 14 | spec = return () 15 | -- describe "getLineRange" $ 16 | -- it "should get the range of a line" sampleText 17 | -- (Just $ Range (Coord 1 0) (Coord 1 11)) (getLineRange 1) 18 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/BufferSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.BufferSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/EventsSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.EventsSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/ListenersSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.ListenersSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = return () 7 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/RangeSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.RangeSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.QuickCheck 5 | import Test.QuickCheck.Instances () 6 | import ArbitraryInstances () 7 | 8 | import Rasa.Internal.Range 9 | 10 | spec :: Spec 11 | spec = do 12 | describe "overRow" $ 13 | prop "overRow f ~= Coord (f a) b" $ \crd@(Coord r c) -> Coord (r+1) c `shouldBe` overRow (+1) crd 14 | 15 | describe "overCol" $ 16 | prop "overCol f ~= Coord a (f b)" $ \crd@(Coord r c) -> Coord r (c+1) `shouldBe` overCol (+1) crd 17 | 18 | describe "overBoth" $ 19 | prop "overBoth f ~= Coord (f a) (f b)" $ \crd@(Coord r c) -> Coord (r+1) (c+1) `shouldBe` overBoth (+ (1 :: Int)) crd 20 | -------------------------------------------------------------------------------- /rasa/test/Rasa/Internal/TextSpec.hs: -------------------------------------------------------------------------------- 1 | module Rasa.Internal.TextSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.QuickCheck 5 | import Test.QuickCheck.Instances () 6 | import ArbitraryInstances () 7 | 8 | import Rasa.Internal.Text 9 | 10 | import qualified Yi.Rope as Y 11 | import Control.Lens 12 | 13 | spec :: Spec 14 | spec = do 15 | describe "asText" $ do 16 | prop "view asText ~= Y.toText" $ \t -> t^.asText `shouldBe` Y.toText t 17 | prop "view (from asText) ~= Y.fromText" $ \t -> t^. from asText `shouldBe` Y.fromText t 18 | 19 | describe "asString" $ do 20 | prop "view asString ~= Y.toString" $ \t -> t^. asString `shouldBe` Y.toString t 21 | prop "view (from asString) ~= Y.fromString" $ \t -> t^. from asString `shouldBe` Y.fromString t 22 | 23 | describe "asLines" $ do 24 | prop "view asLines ~= Y.concat" $ \t -> t^.asLines `shouldBe` Y.lines' t 25 | prop "view (from asLines) ~= Y.fromLines" $ \t -> t^. from asLines `shouldBe` Y.concat t 26 | -------------------------------------------------------------------------------- /rasa/test/RasaSpec.hs: -------------------------------------------------------------------------------- 1 | module RasaSpec where 2 | 3 | import Test.Hspec 4 | 5 | spec :: Spec 6 | spec = do 7 | describe "Rasa" $ do 8 | it "runs tests" $ 9 | True `shouldBe` True 10 | -------------------------------------------------------------------------------- /rasa/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | resolver: lts-16.17 3 | extra-package-dbs: [] 4 | 5 | # nix: 6 | # enable: true 7 | # packages: 8 | # - libcxx 9 | # - icu 10 | 11 | packages: 12 | - ./rasa 13 | - ./rasa-ext-cmd 14 | - ./rasa-ext-cursors 15 | - ./rasa-ext-files 16 | - ./rasa-ext-logger 17 | - ./rasa-ext-slate 18 | - ./rasa-ext-views 19 | - ./rasa-ext-vim 20 | - ./rasa-example-config 21 | - ./text-lens 22 | # - ../eve 23 | 24 | extra-deps: 25 | - eve-0.1.9.0 26 | 27 | # Uncomment the following if you'd like to use a locally installed version 28 | # of icu4c INSTEAD of relying on nix. 29 | extra-lib-dirs: 30 | - /usr/local/opt/icu4c/lib 31 | extra-include-dirs: 32 | - /usr/local/opt/icu4c/include 33 | 34 | pvp-bounds: both 35 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: eve-0.1.9.0@sha256:1be024288b283f0fa90567387e2054afbda6d21a3f50dbc09ae205361c2b4152,2088 9 | pantry-tree: 10 | size: 1365 11 | sha256: e7964630eb979c30b051346df907ab692dfef9e0fd22b02bee54495f3f91ab02 12 | original: 13 | hackage: eve-0.1.9.0 14 | snapshots: 15 | - completed: 16 | size: 532386 17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/17.yaml 18 | sha256: d3ee1ae797cf63189c95cf27f00700304946c5cb3c1e6a82001cd6584a221e1b 19 | original: lts-16.17 20 | -------------------------------------------------------------------------------- /text-lens/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2016 Christopher Penner 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright 13 | notice, this list of conditions and the following disclaimer in the 14 | documentation and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the author nor the names of his contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR 21 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 28 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 | POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /text-lens/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /text-lens/src/Control/Lens/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, Rank2Types #-} 2 | module Control.Lens.Text where 3 | 4 | import Control.Lens 5 | import qualified Data.Text as T 6 | import Data.Monoid 7 | import Data.List.Extra (takeEnd, dropEnd) 8 | 9 | 10 | before :: Int -> Lens' T.Text T.Text 11 | before n = lens getter setter 12 | where getter = T.take n 13 | setter old new = new <> T.drop n old 14 | 15 | after :: Int -> Lens' T.Text T.Text 16 | after n = lens getter setter 17 | where getter = T.drop n 18 | setter old new = T.take n old <> new 19 | 20 | nWords :: Int -> Lens' T.Text T.Text 21 | nWords n = lens getter setter 22 | where getter = T.unwords . take n . T.words 23 | setter old new = T.unwords . (T.words new ++) . drop n . T.words $ old 24 | 25 | intillNextN :: Int -> T.Text -> Lens' T.Text T.Text 26 | intillNextN n pat = lens getter setter 27 | where focus :: Traversal' T.Text T.Text 28 | focus = splittingByInc pat . moreThanOne . lTake n . joiningByInc pat 29 | getter = view focus 30 | setter old new = old & focus .~ new 31 | 32 | intillPrevN :: Int -> T.Text -> Lens' T.Text T.Text 33 | intillPrevN n pat = lens getter setter 34 | where getter = view $ splittingByInc pat . 35 | moreThanOne . 36 | lTakeEnd n . 37 | to (pat :) . 38 | joiningByInc pat 39 | 40 | setter old new = old 41 | & splittingBy pat . moreThanOne 42 | .~ (T.dropEnd 43 | (getter old ^. to T.length) 44 | old <> new) 45 | ^. splittingBy pat 46 | 47 | tillNextN :: Int -> T.Text -> Lens' T.Text T.Text 48 | tillNextN n pat = lens getter setter 49 | where focus :: Traversal' T.Text T.Text 50 | focus = splittingBy pat . moreThanOne . lTake n . joiningBy pat 51 | getter = view focus 52 | setter old new = old & focus .~ new 53 | 54 | 55 | tillPrevN :: Int -> T.Text -> Lens' T.Text T.Text 56 | tillPrevN n pat = lens getter setter 57 | where focus :: Traversal' T.Text T.Text 58 | focus = 59 | splittingBy pat . 60 | moreThanOne . 61 | lTakeEnd n . 62 | joiningBy pat 63 | 64 | getter = view focus 65 | setter old new = old & focus .~ new 66 | 67 | tillNext :: T.Text -> Lens' T.Text T.Text 68 | tillNext = tillNextN 1 69 | 70 | intillNext :: T.Text -> Lens' T.Text T.Text 71 | intillNext = intillNextN 1 72 | 73 | tillPrev :: T.Text -> Lens' T.Text T.Text 74 | tillPrev = tillPrevN 1 75 | 76 | intillPrev :: T.Text -> Lens' T.Text T.Text 77 | intillPrev = intillPrevN 1 78 | 79 | range :: Int -> Int -> Lens' T.Text T.Text 80 | range start end = lens getter setter 81 | where getter = T.take (end - start) . T.drop start 82 | setter old new 83 | | start > end = old 84 | | otherwise = T.take start old <> new <> T.drop end old 85 | 86 | matching :: T.Text -> Lens' T.Text T.Text 87 | matching pat = lens getter setter 88 | where getter = (`T.replicate` pat) . T.count pat 89 | setter old new = T.replace pat new old 90 | 91 | split' :: T.Text -> T.Text -> [T.Text] 92 | split' pat t = case T.splitOn pat t of 93 | [_] -> [] 94 | xs -> xs 95 | 96 | 97 | moreThanOne :: Prism' [a] [a] 98 | moreThanOne = prism' review' getter 99 | where review' = id 100 | getter :: [a] -> Maybe [a] 101 | getter [] = Nothing 102 | getter [_] = Nothing 103 | getter xs = Just xs 104 | 105 | 106 | splittingBy :: T.Text -> Lens' T.Text [T.Text] 107 | splittingBy pat = lens getter setter 108 | where getter = T.splitOn pat 109 | setter _ = T.intercalate pat 110 | 111 | splittingByInc :: T.Text -> Lens' T.Text [T.Text] 112 | splittingByInc pat = lens getter setter 113 | where getter txt = let lst = T.splitOn pat txt 114 | in lst & reversed . dropping 1 traverse %~ (<> pat) 115 | setter _ = T.concat 116 | 117 | joiningByInc :: T.Text -> Lens' [T.Text] T.Text 118 | joiningByInc pat = lens getter setter 119 | where getter = T.concat 120 | setter _ new = T.splitOn pat new & reversed . dropping 1 traversed %~ (<> pat) 121 | 122 | joiningBy :: T.Text -> Lens' [T.Text] T.Text 123 | joiningBy pat = lens getter setter 124 | where getter = T.intercalate pat 125 | setter _ = T.splitOn pat 126 | 127 | lTake :: Int -> Lens' [a] [a] 128 | lTake n = lens getter setter 129 | where getter = take n 130 | setter old new = new ++ drop n old 131 | 132 | lTakeEnd :: Int -> Lens' [a] [a] 133 | lTakeEnd n = lens getter setter 134 | where getter = takeEnd n 135 | setter old new = dropEnd n old ++ new 136 | 137 | lDropEnd :: Int -> Lens' [a] [a] 138 | lDropEnd n = lens getter setter 139 | where getter = dropEnd n 140 | setter old new = new ++ takeEnd n old 141 | 142 | lDrop :: Int -> Lens' [a] [a] 143 | lDrop n = lens getter setter 144 | where getter = drop n 145 | setter old new = take n old ++ new 146 | -------------------------------------------------------------------------------- /text-lens/test/Spec.hs: -------------------------------------------------------------------------------- 1 | import Test.Hspec 2 | import Control.Lens.Text as TL 3 | import Control.Lens 4 | 5 | main :: IO () 6 | main = hspec $ describe "TextLens" $ do 7 | 8 | describe "before" $ do 9 | it "gets before the offset" $ 10 | "hello" ^. TL.before 3 `shouldBe` "hel" 11 | it "gets full string if before end" $ 12 | "hello" ^. TL.before 5 `shouldBe` "hello" 13 | it "gets \"\" if before 0" $ 14 | "hello" ^. TL.before 0 `shouldBe` "" 15 | it "gets full string if out of bounds" $ 16 | "hello" ^. TL.before 10 `shouldBe` "hello" 17 | 18 | it "sets before the offset" $ 19 | ("hello" & TL.before 3 .~ "zz") `shouldBe` "zzlo" 20 | it "prepends if before 0" $ 21 | ("hello" & TL.before 0 .~ "zz") `shouldBe` "zzhello" 22 | 23 | describe "after" $ do 24 | it "gets after the offset" $ 25 | "hello" ^. TL.after 3 `shouldBe` "lo" 26 | it "gets full string if after 0" $ 27 | "hello" ^. TL.after 0 `shouldBe` "hello" 28 | it "gets \"\" if at end" $ 29 | "hello" ^. TL.after 5 `shouldBe` "" 30 | it "gets \"\" if out of bounds end" $ 31 | "hello" ^. TL.after 10 `shouldBe` "" 32 | 33 | it "sets after the offset" $ 34 | ("hello" & TL.after 3 .~ "zz") `shouldBe` "helzz" 35 | it "appends if before end" $ 36 | ("hello" & TL.after 5 .~ "zz") `shouldBe` "hellozz" 37 | 38 | describe "nWords" $ do 39 | it "handles 0" $ 40 | "hi there you" ^. nWords 0 `shouldBe` "" 41 | 42 | it "gets the first word" $ 43 | "hi there you" ^. nWords 1 `shouldBe` "hi" 44 | 45 | it "gets the first n word" $ 46 | "hi there you" ^. nWords 2 `shouldBe` "hi there" 47 | 48 | it "setting 0 words prepends" $ 49 | ("hi there you" & nWords 0 .~ "new words") `shouldBe` "new words hi there you" 50 | 51 | it "sets the first n words" $ 52 | ("hi there you" & nWords 2 .~ "new words") `shouldBe` "new words you" 53 | 54 | describe "splittingBy" $ do 55 | it "gets the split list" $ 56 | "hi|there|you" ^. splittingBy "|" `shouldBe` ["hi", "there", "you"] 57 | 58 | it "sets splits" $ 59 | ("hi|there|you" & splittingBy "|" .~ ["new", "stuff"]) `shouldBe` "new|stuff" 60 | 61 | describe "joiningBy" $ do 62 | it "gets the joined list" $ 63 | ["hi", "there", "you"] ^. joiningBy "|" `shouldBe` "hi|there|you" 64 | it "gets the joined elem" $ 65 | ["hi"] ^. joiningBy "|" `shouldBe` "hi" 66 | 67 | it "sets the joined list" $ 68 | (["hi", "there"] & joiningBy "|" .~ "new|stuff") `shouldBe` ["new", "stuff"] 69 | 70 | describe "intillNextN" $ do 71 | it "gets text up to and including next pattern" $ 72 | "my test str" ^. TL.intillNextN 1 "te" `shouldBe` "my te" 73 | it "gets text up to and including 2nd pattern" $ 74 | "my test str test end" ^. TL.intillNextN 2 "test" `shouldBe` "my test str test" 75 | it "gets when pattern is first" $ 76 | "my test" ^. TL.intillNextN 1 "my" `shouldBe` "my" 77 | it "gets \"\" when no match" $ 78 | "my test" ^. TL.intillNextN 1 "nope" `shouldBe` "" 79 | 80 | it "sets text up to and including next pattern" $ 81 | ("my test test str" & TL.intillNextN 2 "te" .~ "_") `shouldBe` "_st str" 82 | it "set is null op if no match found" $ 83 | ("my test str" & TL.intillNextN 1 "xx" .~ "_") `shouldBe` "my test str" 84 | 85 | describe "tillNextN" $ do 86 | it "gets text up to but not including next pattern" $ 87 | "my test str" ^. TL.tillNextN 1 "te" `shouldBe` "my " 88 | it "gets text up to but not including 2nd pattern" $ 89 | "my test str test end" ^. TL.tillNextN 2 "test" `shouldBe` "my test str " 90 | it "gets \"\" when pattern is first" $ 91 | "my test" ^. TL.tillNextN 1 "my" `shouldBe` "" 92 | it "gets \"\" when no match" $ 93 | "my test" ^. TL.tillNextN 1 "nope" `shouldBe` "" 94 | 95 | it "sets text up to but not including next pattern" $ 96 | ("my test test str" & TL.tillNextN 2 "te" .~ "_") `shouldBe` "_test str" 97 | it "set is null op if no match found" $ 98 | ("my test str" & TL.tillNextN 1 "xx" .~ "_") `shouldBe` "my test str" 99 | 100 | 101 | describe "intillPrevN" $ do 102 | it "gets text up to and including prev pattern" $ 103 | "my test str" ^. TL.intillPrevN 1 "test" `shouldBe` "test str" 104 | it "gets text up to and including 2nd pattern" $ 105 | "my test str test end" ^. TL.intillPrevN 2 "test" `shouldBe` "test str test end" 106 | it "gets when pattern is first" $ 107 | "my test" ^. TL.intillPrevN 1 "st" `shouldBe` "st" 108 | it "gets \"\" when no match" $ 109 | "my test" ^. TL.intillPrevN 1 "nope" `shouldBe` "" 110 | 111 | it "sets text up to and including prev pattern" $ 112 | ("my test test str" & TL.intillPrevN 2 "te" .~ "_") `shouldBe` "my _" 113 | it "set is null op if no match found" $ 114 | ("my test str" & TL.intillPrevN 1 "xx" .~ "_") `shouldBe` "my test str" 115 | 116 | 117 | describe "tillPrevN" $ do 118 | it "gets text up to but not including prev pattern" $ 119 | "my test str" ^. TL.tillPrevN 1 "test" `shouldBe` " str" 120 | it "gets text up to but not including 2nd pattern" $ 121 | "my test str test end" ^. TL.tillPrevN 2 "test" `shouldBe` " str test end" 122 | it "gets \"\" when pattern is first" $ 123 | "my test" ^. TL.tillPrevN 1 "test" `shouldBe` "" 124 | it "gets \"\" when no match" $ 125 | "my test" ^. TL.tillPrevN 1 "nope" `shouldBe` "" 126 | 127 | 128 | it "sets text up to but not including next pattern" $ 129 | ("my test test str" & TL.tillPrevN 2 "te" .~ "_") `shouldBe` "my te_" 130 | it "set is null op if no match found" $ 131 | ("my test str" & TL.tillPrevN 1 "xx" .~ "_") `shouldBe` "my test str" 132 | 133 | describe "range" $ do 134 | it "gets the proper range" $ 135 | "hi hey hello" ^. TL.range 3 6 `shouldBe` "hey" 136 | it "gets \"\" if invalid range" $ 137 | "hello" ^. TL.range 5 3 `shouldBe` "" 138 | it "gets full string" $ 139 | "hello" ^. TL.range 0 5 `shouldBe` "hello" 140 | 141 | it "sets the range" $ 142 | ("hi hey hello" & TL.range 3 6 .~ "__") `shouldBe` "hi __ hello" 143 | it "sets empty range" $ 144 | ("hi hey hello" & TL.range 3 3 .~ "greetings ") `shouldBe` "hi greetings hey hello" 145 | it "set is null op if invalid range" $ 146 | ("hi hey hello" & TL.range 7 3 .~ "__") `shouldBe` "hi hey hello" 147 | 148 | describe "matching" $ do 149 | it "gets matches" $ 150 | "hi hey hello" ^. TL.matching "he" `shouldBe` "hehe" 151 | it "gets \"\" if no match" $ 152 | "hello" ^. TL.matching "z" `shouldBe` "" 153 | 154 | it "sets matches" $ 155 | ("hi hey hello" & TL.matching "he" .~ "__") `shouldBe` "hi __y __llo" 156 | it "set is null op if no match" $ 157 | ("hi hey hello" & TL.matching "z" .~ "__") `shouldBe` "hi hey hello" 158 | -------------------------------------------------------------------------------- /text-lens/text-lens.cabal: -------------------------------------------------------------------------------- 1 | name: text-lens 2 | version: 0.1.1 3 | synopsis: Lenses for operating over text 4 | description: Lenses for operating over text 5 | homepage: https://github.com/ChrisPenner/rasa 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Chris Penner 9 | maintainer: christopher.penner@gmail.com 10 | copyright: 2016 Chris Penner 11 | category: Lens 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | Control.Lens.Text 20 | 21 | build-depends: base >= 4.8 && < 5 22 | , text 23 | , lens 24 | , extra 25 | default-language: Haskell2010 26 | 27 | ghc-options: -Wall 28 | 29 | test-suite text-lens-test 30 | type: exitcode-stdio-1.0 31 | hs-source-dirs: test 32 | main-is: Spec.hs 33 | build-depends: base 34 | , text-lens 35 | , hspec 36 | , lens 37 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 38 | default-language: Haskell2010 39 | default-extensions: OverloadedStrings 40 | 41 | source-repository head 42 | type: git 43 | location: https://github.com/ChrisPenner/rasa 44 | --------------------------------------------------------------------------------